Google
 

Trailing-Edge - PDP-10 Archives - BB-K829A-BM_1981 - sources/gn.for
There are no other files named gn.for in the archive.
C gn> More command drivers
C RTA 10/24/80 Call loadf to load font name into terminal
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 logical file number (lfn) definitions
C  SNRL1 = characters  SNRL2 = into-characters  SNRL3 = mapping
C  all are 97 characters long
C @142 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C @143 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C @144 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
C fcscan - perform scanning for file-access commands
C  sno: string # of option table
C  returns -1 if error detected, else 0
      integer function fcscan ( sno )
      implicit integer ( a - z )
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gncom>
      logical allc , fnp
      common / gncom /  allc , fnp , transf , x1 , x2 , x3
C .false. iff "characters" or "into-characters" present
C .true. iff filename present in command line
C transformation code
C xn = sx(SNRLn)
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
      fcscan = - 1
C assume failed
      allc = . true .
C assume reading all characters
      transf = 0
C 0 normal, 1 reverse, 2 set, 3 clear, 4 complement
      mno = 0
C  # of transformations in cmd line (for warning user)
      fnp = . false .
C flag for filespec present in comamnd line
      x1 = sx ( 142 )
      x2 = sx ( 143 )
      x3 = sx ( 144 ) - 32
C handy values
      sv ( x1 ) = 0
C characters
      sv ( x2 ) = 0
C into-characters
      continue
23000 if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23001
C parse until eol hit
      kno = pkey ( sno )
C get keyword
      if(.not.( kno .eq. - 1 ))goto 23002
      return
23002 continue
C bad parse
      if(.not.( kno .eq. 0 .or. kno .eq. 1 ))goto 23004
      allc = . false .
23004 continue
C not all chars
      if(.not.( kno .eq. 0 ))goto 23006
      if(.not.( pclist ( 142 ) .ne. 0 ))goto 23008
      return
23008 continue
23006 continue
C characters
      if(.not.( kno .eq. 1 ))goto 23010
      if(.not.( pclist ( 143 ) .ne. 0 ))goto 23012
      return
23012 continue
23010 continue
C into-characters
      if(.not.( kno .eq. 2 ))goto 23014
C file
      call pskip ( 4 )
C skip blanks before filespec
      forg = pptr
C remember where filespec starts
      if(.not.( pflnm ( pptr , 0 , 0 ) .lt. 0 ))goto 23016
      return
23016 continue
C parse filespec
      fnp = . true .
C remember filespec present
23014 continue
      if(.not.( kno .ge. 11 .and. kno .le. 14 ))goto 23018
C reverse,set,clear,complement
      mno = mno + 1
C count # of transformations
      transf = kno - 10
C remember transformation
23018 continue
      goto 23000
23001 continue
      if(.not.( mno .gt. 1 ))goto 23020
      call pdiag ( 134 )
C @134 More than one transformation specified - using last one
23020 continue
      if(.not.( fnp ))goto 23022
      call pflnm ( forg , 5 , 57 )
C copy filespec into SNFIL
C parsing done, now work out character lists
23022 continue
      i = 0
      if(.not.( sv ( x1 ) .eq. 0 ))goto 23024
      if(.not.( sv ( x2 ) .eq. 0 ))goto 23026
C neither specified,
      continue
23028 if(.not.( i .lt. 95 ))goto 23029
C  so set both to all
      sv ( x1 + i ) = i + 32
      sv ( x2 + i ) = i + 32
      i = i + 1
      goto 23028
23029 continue
      sv ( x1 + 95 ) = 0
      sv ( x2 + 95 ) = 0
C tie 'em off
      goto 23027
23026 continue
      continue
23030 continue
C only into-characters
      ch = sv ( x2 + i )
      sv ( x1 + i ) = ch
C copy into-chars to chars
      i = i + 1
23031 if(.not.( ch .eq. 0 ))goto 23030
23032 continue
23027 continue
      goto 23025
23024 continue
      if(.not.( sv ( x2 ) .eq. 0 ))goto 23033
      continue
23035 continue
C only characters
      ch = sv ( x1 + i )
      sv ( x2 + i ) = ch
C copy chars to into-chars
      i = i + 1
23036 if(.not.( ch .eq. 0 ))goto 23035
23037 continue
23033 continue
23025 continue
C if both specified, no action
C SNRL3 indexed by char gives you the corresponding into-char
      continue
       i = 126
23038 if(.not.(i.ge.32))goto 23040
      sv ( x3 + i ) = 0
23039 i=i-1
      goto 23038
23040 continue
C clear SNRL3
      i = 0
      continue
23041 if(.not.( . true . ))goto 23042
      ch1 = sv ( x1 + i )
      ch2 = sv ( x2 + i )
C get char, into-char
      if(.not.( ch1 .eq. 0 .or. ch2 .eq. 0 ))goto 23043
      goto 23042
C exit at end of either list
23043 continue
      sv ( x3 + ch1 ) = ch2
C create mapping
      i = i + 1
      goto 23041
23042 continue
      fcscan = 0
C success
      end
C frtyp - determine type of record read from file; record in SNUST
C  returns:
C 	RTUNR	unidentified
C 	RTDEF	character definition
C 	RTFNM	font-name
C 	RTMOS	mosaic-row
      integer function frtyp ( 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
      integer sp
      integer c1 , c2 , c3
      frtyp = 1
C assume unidentified record
      c1 = sv ( iuptr )
      c2 = sv ( iuptr + 1 )
      c3 = sv ( iuptr + 2 )
      if(.not.( c1 .eq. 108 ))goto 23045
      if(.not.( c2 .eq. 40 .and. c3 .eq. 97 ))goto 23047
      frtyp = 3
      goto 23048
23047 continue
      if(.not.( c2 .eq. 34 .or. c2 .eq. 39 ))goto 23049
      frtyp = 2
23049 continue
23048 continue
      goto 23046
23045 continue
      if(.not.( c1 .eq. 59 .and. c2 .eq. 34 ))goto 23051
      frtyp = 4
23051 continue
23046 continue
      end
C ftran - transfer stuff between file and program memory
C  func:	1) FTMOS - write mosaic
C 	2) FTFNM - write font name
C 	3) else func specifies a character definition in fmat
C  arg:	for case 3 above, destination character in file
      subroutine ftran ( func , arg )
      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 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
      uptr = iuptr
C point at beginning of SNUST
      if(.not.( func .lt. 10 ))goto 23053
      goto ( 201 , 202 ) , func
C writing a character's definition
23053 continue
      i = 34
      if(.not.( arg .eq. 34 ))goto 23055
      i = 39
23055 continue
C select quote
      call putu ( 108 )
      call putu ( i )
      call putu ( arg )
      call putu ( i )
      call defhex ( func , uptr )
C get hex definition of character
      call putu ( 0 )
C tie it off
      call ffwrt ( 2 )
C write record to file
      return
C writing mosaic
201   continue
       ir = 1
23057 if(.not.(ir.le.10))goto 23059
      uptr = iuptr
C point to start of SNUST
      call putu ( 59 )
      call putu ( 34 )
      continue
       ic = 1
23060 if(.not.(ic.le.10))goto 23062
      ch = mosmat ( ir , ic )
      call putuq ( ch )
C tack on this character
23061 ic=ic+1
      goto 23060
23062 continue
      call putu ( 34 )
      call putu ( 0 )
      call ffwrt ( 2 )
C write record to file
23058 ir=ir+1
      goto 23057
23059 continue
      return
C writing font file name
202   call cpystr ( 70 , 0 )
C @70 l(a"
      pfn = sx ( 9 )
C get index to font name string
      continue
23063 if(.not.( . true . ))goto 23064
      ch = sv ( pfn )
      pfn = pfn + 1
C get char
      if(.not.( ch .eq. 0 ))goto 23065
      goto 23064
C end of string
23065 continue
      call putuq ( ch )
      goto 23063
23064 continue
      call putu ( 34 )
      call putu ( 41 )
      call putu ( 0 )
      call ffwrt ( 2 )
C write record
      return
      end
C mospec - process "mosaic" command - lets the user specify the
C 	  position of the window or the contents of the mosaic
      subroutine mospec
      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 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
      data msrow , mscol / 1 , 1 /
C cursor row,col in mosaic
      if(.not.( peol ( 0 ) .ne. 0 ))goto 23067
      return
23067 continue
C check for trash after command
      call seta3 ( 2 )
C show mosaic map in area 3
      call lmode ( 1 )
C set VK100 SC1
      continue
23069 continue
C loop until user hits CR
      call dupd
C update display
      call postcm ( msrow , mscol )
C position text-mode cursor on mosaic
      call read1 ( 0 )
C read character from VK100
      ch = sv ( pptr )
C get character
      cmd = keypad ( 0 )
C keypad character typed?
      if(.not.( cmd .lt. 0 ))goto 23072
C no, must be changing mosaic
      if(.not.( ch .ge. 32 ))goto 23074
      mosmat ( msrow , mscol ) = ch
23074 continue
23072 continue
      if(.not.( cmd .ge. 1 .and. cmd .le. 9 ))goto 23076
      if(.not.( cmd .eq. 5 ))goto 23078
C set window position
      docol = max0 ( mscol - 1 , 1 )
      docol = min0 ( docol , 10 - 3 + 1 )
      dorow = max0 ( msrow - 1 , 1 )
      dorow = min0 ( dorow , 10 - 3 + 1 )
      call stcwcn ( cwcn )
C update cmrow, etc.
      goto 23079
23078 continue
C move cursor
      msrow = mod ( msrow + 10 - ( cmd - 1 ) / 3 , 10 ) + 1
      mscol = mod ( mscol + 10 - 2 + mod ( cmd - 1 , 3 ) , 10 ) + 1
23079 continue
23076 continue
23070 if(.not.( cmd .eq. 22 ))goto 23069
23071 continue
      call lmode ( 1 )
C restore SC0
      end
C rdcmd - process read command
      subroutine rdcmd
      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 gncom>
      logical allc , fnp
      common / gncom /  allc , fnp , transf , x1 , x2 , x3
C .false. iff "characters" or "into-characters" present
C .true. iff filename present in command line
C transformation code
C xn = sx(SNRLn)
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
      logical indef
      if(.not.( fcscan ( 141 ) .ne. 0 ))goto 23080
      return
C scan keyword list and other stuff
C @141 00characters "CHAR CHAR ..."^
C 01into-characters "CHAR CHAR ..."^
C 02file FILESPEC^
C 11reverse (reads complement of file into font)^
C 12set (font bits from 1-bits in file)^
C 13clear (font bits from 1-bits in file)^
C 14complement (font bits from 1-bits in file)
C get the font file name if I don't have one already
23080 continue
      if(.not.( sv ( sx ( 5 ) ) .eq. 0 ))goto 23082
C have a filename?
      continue
23084 if(.not.( . true . ))goto 23085
C nope
      call prdtty ( 137 )
C @137 Name of font file: \b
      if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23086
      return
23086 continue
C no name given
      forg = pptr
C remember start of filespec
      if(.not.( pflnm ( pptr , 0 , 0 ) .ge. 0 ))goto 23088
C filename parsed ok?
      if(.not.( peol ( 0 ) .eq. 0 ))goto 23090
      goto 23085
C yes, break on eol
23090 continue
23088 continue
C bad parse, repeat query
      goto 23084
23085 continue
      call pflnm ( forg , 5 , 57 )
C @57 .fnt
C NOTE: 57 is used elsewhere!
C get the file open
23082 continue
      if(.not.( ffopen ( 1 , 5 , 0 ) .ne. 0 ))goto 23092
C open file for read
      call pdiag ( 145 )
C @145 Cannot open file %f
      return
C scan file extracting requested characters
23092 continue
      mosrow = 0
C init mosaic row #
      continue
23094 if(.not.( ffread ( 1 , 0 ) .ne. 0 ))goto 23095
C loop until eof
      goto ( 201 , 202 , 203 , 204 ) , frtyp ( 0 )
C identify record and dispatch
C font name
203   if(.not.( . not . allc ))goto 23096
      goto 23094
C do only if loading entire font
23096 continue
      i = 0
C index to SNFNM
      uptr = iuptr + 4
C l(a"xxxxxx")
      continue
23098 continue
C loop once per character in name
      ch = gscq ( uptr )
C get char
      sv ( sx ( 9 ) + i ) = ch
C move to SNFNM
      i = i + 1
23099 if(.not.( ch .eq. 0 .or. i .eq. 10 ))goto 23098
23100 continue
      call loadf
C load font name into VK100
      call da1 ( 4 )
C update font name in area 1
      goto 23094
C done with this record
C mosaic row
204   if(.not.( . not . allc ))goto 23101
      goto 23094
C do only if loading entire font
23101 continue
      rdmos = . true .
C remember mosaic-read for dupd
      mosrow = mosrow + 1
C next row
      if(.not.( mosrow .gt. 10 ))goto 23103
      goto 23094
C discard extra rows
23103 continue
      uptr = iuptr + 2
C ;"xxxxxxxxxx"
      continue
       i = 1
23105 if(.not.(i.le.10))goto 23107
C loop thru chars in row
      ch = gscq ( uptr )
C get character
      if(.not.( ch .ge. 32 ))goto 23108
      mosmat ( mosrow , i ) = ch
23108 continue
23106 i=i+1
      goto 23105
23107 continue
      goto 23094
C done with this record
C character-definition record
202   filen = sv ( iuptr + 2 )
C get character from record
      fontn = sv ( x3 + filen ) - 30
C get corresponding into-character
      if(.not.( fontn .lt. 0 ))goto 23110
      goto 23094
C skip it if the user doesn't want it
23110 continue
      indef = . true .
C end-of-definition not seen yet
      continue
       i = 1
23112 if(.not.(i.le.10))goto 23114
C loop once per row
      ni = sv ( iuptr + i * 2 + 2 ) - 48
C get 1st hex digit
      if(.not.( ni .eq. 59 - 48 ))goto 23115
      indef = . false .
23115 continue
      filech = 0
C assume end-of-def
      if(.not.( indef ))goto 23117
C do processing if ";" not seen yet
      if(.not.( ni .gt. 9 ))goto 23119
      ni = ni + 48 - 65 + 10
23119 continue
      filech = sv ( iuptr + i * 2 + 3 ) - 48
C get 2nd hex dig
      if(.not.( filech .gt. 9 ))goto 23121
      filech = filech + 48 - 65 + 10
23121 continue
      filech = ni * 16 + filech
C merge them
23117 continue
      fontch = fmat ( fontn , i )
      goto ( 300 , 301 , 302 , 303 , 304 ) , transf + 1
300   fontch = filech
C no transformation (normal)
      goto 399
301   fontch = ieor ( filech , 255 )
C reverse
      goto 399
302   fontch = ior ( fontch , filech )
C set
      goto 399
303   fontch = iand ( fontch , ieor ( filech , 255 ) )
C clear
      goto 399
304   fontch = ieor ( fontch , filech )
C complement
C goto 399
399   fmat ( fontn , i ) = fontch
C store into font
23113 i=i+1
      goto 23112
23114 continue
      fmatc ( fontn ) = 1
C set definition-changed
201   continue
      goto 23094
23095 continue
      call ffcls ( 1 )
C close the file
      end
C regcmd - process ReGIS command
C  forms of command:
C 	ReGIS string		-> stores string in memory
C 	ReGIS ?			-> types string from memory
C 	ReGIS			-> puts VK100 in graphics mode
C 				   and then writes the string
C  If any % characters appear in the string, the program will
C  prompt the user for text to replace them.
      subroutine regcmd
      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
      if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23123
C something after command name
      if(.not.( sv ( pptr ) .eq. 63 ))goto 23125
      call dcs ( 4 )
      call pr0 ( 7 )
C wants to see string
      goto 23126
23125 continue
      rp1 = sx ( 7 )
C wants to specify string
      continue
23127 continue
      sv ( rp1 ) = sv ( pptr )
C copy string to SNREG
      rp1 = rp1 + 1
      pptr = pptr + 1
23128 if(.not.( sv ( pptr - 1 ) .eq. 0 ))goto 23127
23129 continue
23126 continue
      goto 23124
23123 continue
C nothing after command name
      rp1 = sx ( 7 ) - 1
      rp2 = iuptr
      sv ( rp2 ) = 0
      continue
23130 continue
C loop to xfer SNREG to SNUST
      rp1 = rp1 + 1
      if(.not.( sv ( rp1 ) .eq. 37 ))goto 23133
C  % hit, do substitution
      call prdtty ( 6 )
C prompt
      continue
23135 if(.not.( . true . ))goto 23136
C append input to SNUST
      if(.not.( sv ( pptr ) .eq. 0 ))goto 23137
      goto 23136
C end of input
23137 continue
      sv ( rp2 ) = sv ( pptr )
      rp2 = rp2 + 1
      pptr = pptr + 1
      goto 23135
23136 continue
      goto 23134
23133 continue
      sv ( rp2 ) = sv ( rp1 )
C not %, just copy it
      rp2 = rp2 + 1
C bump destination ptr
23134 continue
      sv ( rp2 ) = 0
C keep a null at the end
23131 if(.not.( sv ( rp1 ) .eq. 0 ))goto 23130
23132 continue
      call pdiag ( 6 )
C display final product in area 4
      call regis ( 6 )
C send it in graphics mode
23124 continue
      end
C wrtcmd - process write command
      subroutine wrtcmd
      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 gecom>
      logical quitf
      common / gecom /  ccrow , cccol , cmrow , cmcol , cwcn , lmrow , l
     *mcol , lwcn , quitf
C character row,col of cwcn
C mosaic row,col of cwcn
C wcn of current position in window
C mosaic row,col of lwcn
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C gncom>
      logical allc , fnp
      common / gncom /  allc , fnp , transf , x1 , x2 , x3
C .false. iff "characters" or "into-characters" present
C .true. iff filename present in command line
C transformation code
C xn = sx(SNRLn)
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
      logical wrtfnm , wrtmos
C name of temp file	#@91 cse.tmp
      if(.not.( fcscan ( 148 ) .ne. 0 ))goto 23139
      return
C parse command line
C note reversal of characters and into-characters; this causes RL3
C to contain fmat characters indexed by file character
C @148 01characters "CHAR CHAR ..."^
C 00into-characters "CHAR CHAR ..."^
C 02file FILESPEC
23139 continue
      if(.not.( . not . fnp ))goto 23141
      sv ( sx ( 5 ) ) = 0
C force user to give filespec
C command parsing done, open the input file
23141 continue
      i = ffopen ( 1 , 5 , 0 )
C open file
      if(.not.( i .eq. - 1 ))goto 23143
      return
C can't get name
C if file already exists, request confirmation
23143 continue
      if(.not.( i .eq. 0 ))goto 23145
C does file exist?
      if(.not.( yn ( 63 ) .eq. 0 ))goto 23147
C yes, want to proceed?
C @63 The file exists - do you want to proceed?\b
      call ffcls ( 1 )
C no, close input file
      return
C open temp file for output
23147 continue
23145 continue
      if(.not.( ffopen ( 2 , 91 , 2 ) .gt. 0 ))goto 23149
      call pdiag ( 149 )
C @149 Cannot open temp file
      call ffcls ( 1 )
C close input file
      return
23149 continue
      wrtfnm = . true .
      wrtmos = . true .
C assume I want to write these
      if(.not.( i .eq. 0 ))goto 23151
C have input file?
      continue
23153 if(.not.( ffread ( 1 , 0 ) .ne. 0 ))goto 23154
C loop thru records of input file
      goto ( 401 , 402 , 403 , 404 ) , frtyp ( 0 )
C identify record type
C character-definition record
402   filec = sv ( iuptr + 2 )
C get character being defined
      i = sv ( x3 + filec )
C get RL3 entry for that char
      if(.not.( i .eq. 0 ))goto 23155
      goto 401
23155 continue
C not spec by user, just copy it
      if(.not.( i .eq. 1 ))goto 23157
      goto 23153
C duplicate, pitch it
23157 continue
      call ftran ( i , filec )
C replace with char from fmat
      sv ( x3 + filec ) = 1
C remember I wrote this one
      goto 23153
C font-name record
403   wrtfnm = . false .
C don't write font-name later
      if(.not.( . not . allc ))goto 23159
      goto 401
23159 continue
C just copy it
      call ftran ( 2 , 0 )
C replace it with current name
      goto 23153
C mosaic-row
404   if(.not.( allc ))goto 23161
      goto 23153
C replacing mosaic (done later)
23161 continue
      wrtmos = . false .
C remember file has a mosaic
      goto 401
C just copy record
C unidentified record
401   call ffwrt ( 2 )
C preserve it
      goto 23153
23154 continue
      call ffcls ( 1 )
C close input file
C end if-have-input-file
23151 continue
      if(.not.( wrtfnm ))goto 23163
      call ftran ( 2 , 0 )
23163 continue
C write font name if needed
      if(.not.( wrtmos ))goto 23165
      call ftran ( 1 , 0 )
C write mosaic if needed
C scan RL3 for any characters that the user wanted to write and
C didn't appear in the font file
23165 continue
      continue
       filec = 32
23167 if(.not.(filec.le.126))goto 23169
      i = sv ( x3 + filec )
C get corresp fmat character
      if(.not.( i .ge. 32 ))goto 23170
C char written yet?
      if(.not.( allc .and. i .ne. 32 ))goto 23172
C no
      i1 = i - 30
C convert for fmat access
      continue
       j = 1
23174 if(.not.(j.lt.10))goto 23176
      if(.not.( fmat ( i1 , j ) .ne. 0 ))goto 23177
      goto 500
23177 continue
23175 j=j+1
      goto 23174
23176 continue
      goto 23168
C no bits set in char, skip it
23172 continue
500   call ftran ( i , filec )
C write definition to file
23170 continue
23168 filec=filec+1
      goto 23167
23169 continue
      call ffcls ( 2 )
C close output file
      if(.not.( ffrenm ( 91 , 5 ) .ne. 0 ))goto 23179
      call pdiag ( 92 )
23179 continue
C @92 Cannot create file %f
      quitf = . false .
C ok to quit now
      end