00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 subroutine getinput
00021 save
00022 c
00023 c General means of getting input from stdin, the graphics cursor,
00024 c or the repeat stack, depending on mode. This is fairly wasteful
00025 c of space, but...
00026 c
00027 common /replay/ ireplay
00028 common /prompt/ iprompt
00029 common /x input/ interact
00030 logical gfxin,first_xuse
00031 c
00032 character*80 device
00033 common /plot device/ device,aspect,idev
00034 c
00035 common/draw params/roff,soff,aspect1,xlen,ylen,hs,hn,hp,
00036 & idevset,jbox,iorig
00037 parameter (NSAVEMAX = 500)
00038 c
00039 common /instack1/ nsave,isave,rsave(NSAVEMAX),ssave(NSAVEMAX)
00040 character*200 strsave(NSAVEMAX)
00041 common /instack2/ strsave
00042 c
00043 save /instack1/,/instack2/
00044 c
00045 character*(*) input,string
00046 data first_xuse/.true./
00047 c
00048 entry getnsave(i)
00049 i = nsave
00050 return
00051 c
00052 entry setisave(i)
00053 isave = i
00054 return
00055 c
00056 entry getgfx(r,s)
00057 c
00058 c Graphics input.
00059 c
00060 xl = xlen
00061 if (xl.le.0.) xl = 1.
00062 yl = ylen
00063 if (yl.le.0.) yl = 1.
00064 c
00065 if (ireplay.eq.0) then
00066 if (gfxin()) then
00067 c
00068 if (idev.eq.17.and.first_xuse.and.iprompt.eq.1)
00069 & write(6,'(a)')
00070 & 'Use right-hand mouse button to indicate position.'
00071 c
00072 call graphin(r,s)
00073 c
00074 if (idev.eq.17) first_xuse = .false.
00075 else
00076 if (iprompt.eq.0) return
00077 call devoff
00078 write(6,'(''No graphics input. Enter r, s: ''$)')
00079 read(5,*,end=99,err=99)r,s
00080 end if
00081 c
00082 if (nsave.lt.NSAVEMAX) then
00083 nsave = nsave + 1
00084 rsave(nsave) = r/xl
00085 ssave(nsave) = s/yl
00086 end if
00087 else
00088 if (isave.lt.nsave) then
00089 isave = isave + 1
00090 r = xl*rsave(isave)
00091 s = yl*ssave(isave)
00092 end if
00093 end if
00094 c
00095 99 return
00096 c
00097 entry getstring(input,istart,nin,string)
00098 c
00099 c General keyboard input, with optional prompt.
00100 c
00101 if (ireplay.eq.0) then
00102 c
00103 call devoff
00104 if (istart.le.nin) then
00105 write(6,'(a,'' '',$)')input(istart:nin)
00106 else
00107 write(6,'(''Input string: ''$)')
00108 end if
00109 string = ' '
00110 if (interact.eq.1.and.num_win(17).gt.0) then
00111 c
00112 c Get input via X, keeping screen up to date.
00113 c
00114 call myflush(6)
00115 string = '\0'
00116 c
00117 call win_read_line(string)
00118 c
00119 else
00120 read(5,'(a)',err=999,end=999)string
00121 end if
00122 c
00123 if (nsave.lt.NSAVEMAX) then
00124 nsave = nsave + 1
00125 strsave(nsave) = string(1:min(200,len(string)))
00126 end if
00127 else
00128 if (isave.lt.nsave) then
00129 isave = isave + 1
00130 string = strsave(isave)
00131 end if
00132 end if
00133 c
00134 999 return
00135 c
00136 end
