Trailing-Edge
-
PDP-10 Archives
-
BB-K829A-BM_1981
-
sources/gp.for
There are no other files named gp.for in the archive.
C gp> Command prompting and parsing
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C copyright notice
C
C
C C O P Y R I G H T
C
C
C Copyright (C) 1980 by
C Digital Equipment Corporation, Maynard, Mass.
C
C
C This software is furnished under a license and may be used and
C copied only in accordance with the terms of such license and
C with the inclusion of the above copyright notice. This
C software or any other copies thereof may not be provided or
C otherwise made available to any other person. No title to and
C ownership of the software is hereby transferred.
C
C The information in this software is subject to change without
C notice and should not be construed as a commitment by Digital
C Equipment Corporation.
C
C DIGITAL assumes no responsibility for the use or reliability
C of its software on equipment that is not supplied by DIGITAL.
C
C ** Symbolic definitions **
C data types
C define character byte
C max string storage
C max string index storage
C important string indices (see gs module)
C cdisp - function codes
C coord - axis codes
C cpystr - option codes
C da1 - function codes
C da2 - function codes
C dcs - function codes
C ffopen - modes
C frtyp - record types
C (careful - used in computed goto's)
C ftran - function codes
C undo - function codes
C utty - function codes
C codes returned by keypad function
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C CTFILE = CTALPHA + CTNUM + CTDOT + CTSLASH + CTCOLON
C colors - temporarily all white
C screen dimensions (pixels)
C displays in area 3
C must match showtab in gm
C maximum mosaic dimensions
C dimensions of mosaic display window
C quan to subtract from char to get fmat/fmatc subscript
C lowest, highest, number of characters in VK100 font
C number of loadable fonts in VK100
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
C chkeol - skip blanks and return 1 iff end-of-line
integer function chkeol ( dum )
implicit integer ( a - z )
chkeol = 0
if(.not.( pskip ( 4 ) .eq. 8 ))goto 23000
chkeol = 1
23000 continue
end
C ctype - classify character
C svp: subscript of sv where character lives
integer function ctype ( svp )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
ctype = 0
ch = sv ( svp )
C get character
if(.not.( ch .ge. 48 .and. ch .le. 57 ))goto 23002
ctype = 2
23002 continue
if(.not.( ( ch .ge. 97 .and. ch .le. 122 ) .or. ( ch .ge. 65 .and.
* ch .le. 90 ) ))goto 23004
ctype = 1
23004 continue
if(.not.( ch .eq. 32 ))goto 23006
ctype = 4
23006 continue
if(.not.( ch .eq. 45 ))goto 23008
ctype = 16
23008 continue
if(.not.( ch .eq. 47 ))goto 23010
ctype = 32
23010 continue
if(.not.( ch .eq. 46 ))goto 23012
ctype = 64
23012 continue
if(.not.( ch .eq. 58 ))goto 23014
ctype = 256
23014 continue
if(.not.( ch .eq. 0 ))goto 23016
ctype = 8
23016 continue
end
C helpcr - restore carriage for help
C nlf is # of line feeds
subroutine helpcr ( nlf )
implicit integer ( a - z )
call pr2 ( 132 , coord ( 302 , 1 ) , nlf * 20 )
C @132 p[%d,+%d]
end
C helpx - preparation for giving help
C sno is help message
subroutine helpx ( sno )
implicit integer ( a - z )
C gccom>
integer mosmat ( 10 , 10 ) , omosmt ( 10 , 10 )
integer fmat ( 96 , 10 ) , fmatc ( 96 )
logical cdcec , rdmos
common / gccom / a3 , a3x , cdch ( 7 ) , cdcec ( 7 ) , cdrot ( 7
*) , cdsiz ( 7 ) , cdsln ( 7 ) , dinitf , dnrow , dncol , dorow , d
*ocol , edchar , fmat , fmatc , mosmat , omosmt , rdmos , rmul , cm
*ul , rsize , csize , sfont , uprow , upcol , wcol , wcol8 , wrow ,
* wrow10
C handle of display currently in area 3
C >0 no action, =0 regenerate area 3, <0 update area 3
C characters being displayed in area 3
C .true. = always shows currently-edited character
C height of window in characters, cells
C sfont may be changed ONLY by calling setfnt(new-font-#)
C fmat: contains the bit definitions for all characters in the font.
C The row is given by <character>-FMOFF, such that Space is
C defined in fmat(2,*), ! in fmat(3,*), etc. The row fmat(1,*)
C always contains all zeros (used by ffcreate). Each column of
C fmat contains 8 bits that define 1 row of the character.
C fmatc: fmatc(x) is parallel to fmat(x,*). A non-zero fmatc entry
C indicates that the definition of the respective character
C has changed, and that the dupd routine must update the
C screen accordingly. fmatc(1) is unused.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gpcom>
common / gpcom / diagf , lcx , lcy
C prevents multiple diagnostic messages
C locator-mode coordinates returned by VK100
a3x = 2
C arrange to have area 3 regenerated on next command
call clr ( 3 , 6 )
C clear area 3
call posgc ( 302 , 0 , 0 )
call font0
call wrtstr ( sno )
end
C keypad - check input for one of the keypad or arrow characters
C pptr must be pointing to start of SNINP
C returns -1 if no match, else KPxxx (see gdef)
integer function keypad ( dum )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
integer ch , kpc ( 23 )
C should be character
data kpc ( 1 ) , kpc ( 2 ) , kpc ( 3 ) , kpc ( 4 ) , kpc ( 5 ) / 1
*12 , 113 , 114 , 115 , 116 /
data kpc ( 6 ) , kpc ( 7 ) , kpc ( 8 ) , kpc ( 9 ) , kpc ( 10 ) /
*117 , 118 , 119 , 120 , 121 /
data kpc ( 11 ) , kpc ( 12 ) , kpc ( 13 ) , kpc ( 14 ) , kpc ( 15
*) / 77 , 109 , 108 , 110 , 80 /
data kpc ( 16 ) , kpc ( 17 ) , kpc ( 18 ) , kpc ( 19 ) , kpc ( 20
*) / 81 , 82 , 83 , 65 , 66 /
data kpc ( 21 ) , kpc ( 22 ) / 67 , 68 /
keypad = - 1
if(.not.( sv ( pptr ) .eq. 0 ))goto 23018
C RETURN ?
call read1 ( 0 )
C yes, eat the extra CR
C the VK100 sends in SC1 mode
keypad = 22
C tell caller what I got
return
23018 continue
if(.not.( sv ( pptr ) .eq. 27 .and. sv ( pptr + 1 ) .ne. 0 ))goto
*23020
ch = sv ( pptr + 2 )
C get identifying character
continue
keypad = 23 - 1
23022 if(.not.(keypad.ge.0))goto 23024
if(.not.( ch .eq. kpc ( keypad + 1 ) ))goto 23025
return
23025 continue
23023 keypad=keypad-1
goto 23022
23024 continue
23020 continue
end
C #lmread - read cursor coordinates and character in locator mode
C # returns character, and
C # lcx,lcy/ cursor coordinates
C # lwcn/ window cell #, or -1 if cursor not in window
C #
C # correspondence between what user types and what VK100 sends:
C # delete - CR
C # return - [x,y]CR
C # other - charCR[x,y]CR
C integer function lmread(dum)
C implicit integer (a-z)
C include gccom
C include gecom
C include gscom
C if (lcy == 0) { #reset if cursor at top of screen
C lcx = coord(200,X) + rmul / 2 - 1
C lcy = coord(200,Y) + cmul / 2 - 1
C }
C call dupd #update displays
C call dcs(DCGRPH)
C call pr4(111,lcx,lcy,rmul,cmul) #@111 p[%d,%d]r(p(i[%d,%d]))
C ch = Return
C while (.true.) {
C call read1(0)
C diagf = 0 #ok to print diagnostics
C if (sv(pptr) == Lbracket) break;
C ch = sv(pptr) #no coords yet, keep looking
C }
C call dcs(DCCMD2) #erase diagnostic
C pptr = pptr + 1
C lcx = pdec(0,XMAX) #get x coord
C if (lcx < 0) lcx = 0
C pptr = pptr + 1 #skip comma
C lcy = pdec(0,YMAX) #get y coord
C if (lcy < 0) lcy = 0
C #compute window cell #
C lwcn = -1 #assume bad
C ic = lcx - coord(200,X); ir = lcy - coord(200,Y)
C if (ic >= 0 & ir >= 0) {
C ic = ic / rmul; ir = ir / cmul
C if (ic < wcol8 & ic < wrow10) lwcn = ir * wcol8 + ic
C }
C lmread = ch
C end
C
C #lmspw - let user specify cell in window using locator mode
C # sno: prompt string
C # returns wcn if cursor in window and user hit return
C # -1 if cursor not in window and user hit return
C # -2 if user typed x
C integer function lmspw(sno)
C implicit integer (a-z)
C include gecom
C call dcs(DCCMD2)
C call pr0(112)
C #@112 Position with arrow keys, use return to confirm, x to abort
C call lmode(sno)
C cmd = lower(lmread(0))
C call lmode(SNNUL) #out of locator mode
C lmspw = -2
C if (cmd < LOWC) lmspw = lwcn
C end
C lower - convert uppercase to lowercase
integer function lower ( ch )
implicit integer ( a - z )
lower = ch
if(.not.( ch .ge. 65 .and. ch .le. 90 ))goto 23027
lower = ch + 97 - 65
23027 continue
end
C pc1 - parse a character specification, which may be either one
C character, or one of: dl qu sp
C diag: if non-zero, print diagnostic upon failure
C returns character if successful, else -1
integer function pc1 ( diag )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
call pskip ( 4 )
pc1 = - 1
if(.not.( pword ( 113 ) .eq. 0 ))goto 23029
pc1 = 32
C @113 sp
goto 23030
23029 continue
if(.not.( pword ( 114 ) .eq. 0 ))goto 23031
pc1 = 34
C @114 qu
goto 23032
23031 continue
if(.not.( sv ( pptr ) .ge. 32 ))goto 23033
pc1 = sv ( pptr )
pptr = pptr + 1
23033 continue
23032 continue
23030 continue
if(.not.( pc1 .lt. 0 .and. diag .ne. 0 ))goto 23035
call pr0 ( 116 )
23035 continue
C @116 Character illegal or not specified
end
C pclist - parse list of single characters enclosed by ' or " and
C separated by spaces, allowing "sp", "qu", and "dl"
C sno: string where character list will be stored
C returns -1 bad, or 0 OK
integer function pclist ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
pclist = - 1
C assume error return
nch = 0
C number of chars parsed
i = sx ( sno )
C set up pointer to destination string
call pskip ( 4 )
quote = sv ( pptr )
pptr = pptr + 1
if(.not.( quote .ne. 39 .and. quote .ne. 34 ))goto 23037
if(.not.( quote .eq. 63 ))goto 23039
C wants help
call helpx ( 117 )
C @117 Character list enclosed by ' or " marks\n\n
call helpcr ( 0 )
call wrtstr ( 118 )
C @118 Separate characters with spaces.\nTo specify space and quote,\nuse sp and qu.
call fonta
C switch back to alternate font
return
23039 continue
100 call pdiag ( 119 )
C @119 Character list missing
return
23037 continue
continue
23041 if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23042
ch = sv ( pptr )
if(.not.( ch .eq. quote ))goto 23043
if(.not.( nch .ne. 0 ))goto 23045
pptr = pptr + 1
pclist = 0
sv ( i ) = 0
return
23045 continue
goto 100
C vacuous string
23043 continue
ch = pc1 ( 0 )
C parse character
if(.not.( ch .lt. 0 ))goto 23047
goto 23042
23047 continue
C bad
if(.not.( sv ( pptr ) .ne. 32 .and. sv ( pptr ) .ne. quote ))goto
*23049
goto 23042
23049 continue
sv ( i ) = ch
i = i + 1
nch = nch + 1
goto 23041
23042 continue
call pdiag ( 120 )
C @120 Illegal syntax in character list
end
C pdec - parse decimal number
C low,high: limits for number
integer function pdec ( low , high )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
pdec = - 1
C assume failure
if(.not.( pskip ( 4 ) .ne. 2 ))goto 23051
if(.not.( sv ( pptr ) .eq. 63 ))goto 23053
call pdiag ( 121 )
C @121 Decimal number between
call pr2 ( 122 , low , high )
C @122 %d and %d
goto 23054
23053 continue
call pdiag ( 123 )
23054 continue
C @123 Number missing
return
23051 continue
continue
ac = 0
23055 if(.not.(ctype(pptr).eq.2))goto 23057
if(.not.( ac .gt. 1000 ))goto 23058
ac = 32767
C defend against overflow
goto 23059
23058 continue
ac = ac * 10 + sv ( pptr ) - 48
23059 continue
23056 pptr=pptr+1
goto 23055
23057 continue
if(.not.( ac .ge. low .and. ac .le. high ))goto 23060
pdec = ac
return
23060 continue
call pdiag ( 124 )
C @124 Number not between
call pr2 ( 122 , low , high )
end
C pdiag - type diagnostic message, substituting current filename
C for any occurrences of %f in the string
C sno: string to be typed
C returns -1
integer function pdiag ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gpcom>
common / gpcom / diagf , lcx , lcy
C prevents multiple diagnostic messages
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
if(.not.( diagf .eq. 0 ))goto 23062
call dcs ( 4 )
i = sx ( sno )
C pointer to scan message string
ch = sv ( i )
continue
23064 if(.not.( ch .ne. 0 ))goto 23065
if(.not.( ch .ne. 37 ))goto 23066
call putc ( ch )
goto 23067
23066 continue
i = i + 1
if(.not.( sv ( i ) .eq. 102 ))goto 23068
call pr0 ( 5 )
23068 continue
23067 continue
i = i + 1
ch = sv ( i )
goto 23064
23065 continue
23062 continue
diagf = 1
C remember diagnostic given
pdiag = - 1
end
C peol - parse end-of-line
C returns 0 OK, -1 bad
integer function peol ( dum )
implicit integer ( a - z )
peol = 0
if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23070
return
23070 continue
C OK if at eol
call pdiag ( 125 )
C @125 Garbage at end of command
peol = - 1
end
C pkey - parse a keyword using table
C sno: table string, of the form
C <entry>^<entry>^...^<entry>
C where <entry> is of the form: nnxxxxx
C nn is a two-digit decimal number associated with the entry
C if nn = **, the entry is ignored except when giving help
C xxxxx is a string beginning with (and possibly containing
C only) a keyword composed of CTKEY characters (gdef).
C Text beyond the keyword is ignored; it is
C used only for display when the user wants help.
C The user need type only enough characters of the keyword to
C identify it uniquely.
C returns keyword number upon successful parse, otherwise -1
C (getting this routine to work was a nontrivial exercise)
integer function pkey ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gpcom>
common / gpcom / diagf , lcx , lcy
C prevents multiple diagnostic messages
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
pkey = - 1
C assume failure
ki = sx ( sno )
C pointer to scan keyword table
if(.not.( iand ( pskip ( 4 ) , 19 ) .eq. 0 ))goto 23072
C non-keyword
if(.not.( sv ( pptr ) .eq. 63 ))goto 23074
goto 100
23074 continue
C wants help
call pdiag ( 128 )
C @128 Keyword expected
return
C loop: one iteration per table entry
23072 continue
continue
23076 continue
p = pptr
C copy pointer to input
if(.not.( sv ( ki ) .lt. 48 ))goto 23079
goto 101
23079 continue
C check for help-only kwd
kin = ( sv ( ki ) - 48 ) * 10 + sv ( ki + 1 ) - 48
C keyword #
ki = ki + 2
C move past keyword #
C loop: compare this keyword against input
continue
23081 continue
if(.not.( iand ( ctype ( p ) , 19 ) .eq. 0 ))goto 23084
C end of input
if(.not.( pkey .ge. 0 ))goto 23086
C check for ambiguity
call pdiag ( 129 )
C @129 Ambiguous
pkey = - 1
return
23086 continue
pkey = kin
C found a match
goto 23083
C still scanning user's input
23084 continue
if(.not.( iand ( ctype ( ki ) , 19 ) .eq. 0 ))goto 23088
goto 23083
C input > keywd
23088 continue
uch = sv ( p )
C convert to integer data type
diff = sv ( ki ) - lower ( uch )
C check if still matching
ki = ki + 1
p = p + 1
23082 if(.not.( diff .ne. 0 ))goto 23081
23083 continue
C if different, abort comparison
C find next keyword in table (or end of table)
101 continue
23090 continue
ch = sv ( ki )
ki = ki + 1
23091 if(.not.( ch .eq. 94 .or. ch .eq. 0 ))goto 23090
23092 continue
23077 if(.not.( ch .eq. 0 ))goto 23076
23078 continue
if(.not.( pkey .eq. - 1 ))goto 23093
call pdiag ( 130 )
C @130 Unrecognized keyword
goto 23094
23093 continue
call pskip ( 19 )
23094 continue
C get scanner past the input keyword
return
C give user help
100 call helpx ( 131 )
C @131 One of the following: (V1.00)\n
continue
23095 continue
C one iteration per kwyword
uptr = iuptr
C init pointer to copy of keyword
ki = ki + 2
C skip nn at beginning of entry
ch = sv ( ki )
C get 1st char of keyword
continue
23098 if(.not.( ch .ne. 0 .and. ch .ne. 94 ))goto 23099
sv ( uptr ) = ch
C copy char to ustr
uptr = uptr + 1
ki = ki + 1
ch = sv ( ki )
C get next char
goto 23098
23099 continue
sv ( uptr ) = 0
C tie off ustr
call helpcr ( 1 )
C get to next line
call wrtstr ( 6 )
C write it out
ki = ki + 1
C move past uparrow
23096 if(.not.( ch .eq. 0 ))goto 23095
23097 continue
call fonta
C switch back to alternate font
call pdiag ( 1 )
C set diagf
end
C prdtty - prompt, read tty string into SNINP, initialize pptr for scan
C sno: prompt string
subroutine prdtty ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gpcom>
common / gpcom / diagf , lcx , lcy
C prevents multiple diagnostic messages
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
call dupd
C update screen
call dcs ( 3 )
C position cursor
call dcs ( 6 )
C restore original TM
call read1 ( sno )
C read until CR
diagf = 0
C enable printing of diagnostics
call dcs ( 5 )
C put VK100 in ANSI mode
call dcs ( 4 )
C clear diagnostic area
end
C pskip - skip to the next character not of the specified type(s)
C and return its type
C typ: logical OR of types to skip
C returns type of following character
integer function pskip ( typ )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
continue
23100 if(.not.( . true . ))goto 23101
i = ctype ( pptr )
C get character type
pskip = i
if(.not.( iand ( i , typ ) .eq. 0 ))goto 23102
goto 23101
23102 continue
pptr = pptr + 1
C next char
goto 23100
23101 continue
end
C pword - check for word at current point in input
C sno: word (alphabetic string) to be checked for
C returns -1 no (pptr unchanged), 0 yes (pptr advanced)
integer function pword ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gscom>
integer sv ( 4000 )
integer sx ( 150 )
common / gscom / iuptr , pptr , uptr , sv , sx
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C string vector - ALL strings live here
C subscript is string #, contains index into sv
pword = - 1
C assume failure (pessimistic)
p = pptr
C get private copy of pptr
i = sx ( sno )
C index to word
continue
23104 if(.not.( sv ( i ) .ne. 0 ))goto 23105
uch = sv ( p )
C convert to integer data type
if(.not.( lower ( uch ) .ne. sv ( i ) ))goto 23106
return
23106 continue
C mismatch
p = p + 1
i = i + 1
goto 23104
23105 continue
if(.not.( ctype ( p ) .eq. 1 ))goto 23108
return
23108 continue
C input thing too long
pptr = p
C ok, set pptr
pword = 0
C success
end
C yn - ask question, get yes or no answer
C sno: question string
C returns 0 for no, 1 for yes
integer function yn ( sno )
implicit integer ( a - z )
continue
23110 if(.not.( . true . ))goto 23111
call prdtty ( sno )
C ask question
yn = pkey ( 146 )
C @146 00no^01yes
if(.not.( yn .ge. 0 ))goto 23112
if(.not.( peol ( 0 ) .eq. 0 ))goto 23114
goto 23111
C good parse, return
C else ask again
23114 continue
23112 continue
goto 23110
23111 continue
end