Google
 

Trailing-Edge - PDP-10 Archives - BB-K829A-BM_1981 - sources/gc.for
There are no other files named gc.for in the archive.
C gc> Display generation
C RTA 10/23/80 Font-name fixes for Charlie Rose
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  mosalt - function codes
C  mosmap - function codes
C CDMIN - minumum Y distance between character displays
C CDCX  - X distance from point 303 to character
      block data
      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.
      data a3 , cdch ( 1 ) , dinitf , dorow , docol / 0 , 0 , 1 , 1 , 1 
     */
      data edchar , dnrow , dncol , rdmos / 32 , 10 , 9 , . false . /
      end
C cday - returns Y offset from point 303 to display of specified
C 	character in area 3
C  n: subscript of cdch
      integer function cday ( n )
      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.
      cday = 0
      continue
       i = 1
23000 if(.not.(i.lt.n))goto 23002
      cday = cday + max0 ( 80 , cdsiz ( i ) * 25 + 5 )
23001 i=i+1
      goto 23000
23002 continue
      end
C cdisp - generate area 3 display of single characters
C  func: CDFULL clear and redraw entire display
C 	CDEDCH update occurrences of edited-character
C 	CDALLC update all rotated, slanted copies
C 	else character to update
      subroutine cdisp ( func )
      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 offmat	1st subscript is slant: 1 for -45, 2 for 0, 3 for +45
C 	2nd subscript is rotation:  1 for 0, 2 for 45, ... , 8 for 315
C 	values are (xdisp*10+ydisp), where xdisp and ydisp are
C 	subscripts of offmul
C offmul	where to position cursor within character area before writing
C 	character.  0 = top or left; 25 = bottom or right
      integer offmat ( 3 , 8 ) , offmul ( 4 )
      data offmat ( 1 , 1 ) , offmat ( 1 , 2 ) , offmat ( 1 , 3 ) , offm
     *at ( 1 , 4 ) / 31 , 22 , 12 , 23 /
      data offmat ( 1 , 5 ) , offmat ( 1 , 6 ) , offmat ( 1 , 7 ) , offm
     *at ( 1 , 8 ) / 23 , 33 , 33 , 32 /
      data offmat ( 2 , 1 ) , offmat ( 2 , 2 ) , offmat ( 2 , 3 ) , offm
     *at ( 2 , 4 ) / 11 , 12 , 13 , 24 /
      data offmat ( 2 , 5 ) , offmat ( 2 , 6 ) , offmat ( 2 , 7 ) , offm
     *at ( 2 , 8 ) / 33 , 43 , 42 , 31 /
      data offmat ( 3 , 1 ) , offmat ( 3 , 2 ) , offmat ( 3 , 3 ) , offm
     *at ( 3 , 4 ) / 11 , 13 , 14 , 34 /
      data offmat ( 3 , 5 ) , offmat ( 3 , 6 ) , offmat ( 3 , 7 ) , offm
     *at ( 3 , 8 ) / 43 , 42 , 31 , 21 /
      data offmul ( 1 ) , offmul ( 2 ) , offmul ( 3 ) , offmul ( 4 ) / 0
     * , 9 , 15 , 25 /
      if(.not.( a3 .ne. 1 ))goto 23003
      return
C must be showing characters
C redraw area 3
23003 continue
      if(.not.( func .eq. - 1 ))goto 23005
C full display
      call clr ( 3 , 6 )
C clear area 3
      call font0
C standard ascii font
      continue
       i = 1
23007 if(.not.(cdch(i).ne.0))goto 23009
C do ascii text for all chars
      call posgc ( 303 , 0 , cday ( i ) )
C position graphics cursor
      call pr4 ( 77 , 116 , i , qchar ( cdch ( i ) ) , cdrot ( i ) )
C @77 %c'# %d\nChar 't%st'  Rot   %d'
      call pr4 ( 76 , 112 , coord ( 303 , 1 ) , cdsiz ( i ) , cdsln ( i 
     *) )
C @76 %c[%d,+20]t'Size %d  Slant %d'
23008 i=i+1
      goto 23007
23009 continue
C updating edited-character
23005 continue
      if(.not.( func .eq. - 2 ))goto 23010
      call font0
C standard ascii font
      continue
       i = 1
23012 if(.not.(cdch(i).ne.0))goto 23014
C loop thru all displayed chars
      if(.not.( cdcec ( i ) ))goto 23015
C an edited-character?
      cdch ( i ) = edchar
C yes, update memory
      call posgc ( 303 , 5 * 9 , cday ( i ) + 20 )
C move cursor
      call wrtch ( edchar )
C change ascii char on screen
23015 continue
23013 i=i+1
      goto 23012
23014 continue
C now draw the characters from the alternate font
23010 continue
      call fonta
C back to alternate font
      i = 0
C init index
      continue
23017 if(.not.( . true . ))goto 23018
C loop thru all chars
      i = i + 1
C next character
      ch = cdch ( i )
C all done?
      if(.not.( ch .eq. 0 ))goto 23019
      goto 23018
C yes, split
C check if I have to do anything
23019 continue
      if(.not.( func .eq. - 3 .or.  func .eq. - 1 .or.  ( func .eq. - 2 
     *.and. cdcec ( i ) ) .or.  ( func .ge. 32 .and. func .eq. ch ) ))go
     *to 23021
      s = cdsiz ( i )
C get size
C if updating, I have to erase the old character
      if(.not.( func .ne. - 1 ))goto 23023
      call posgc ( 303 , 180 , cday ( i ) )
C move cursor
      call pr2 ( 75 , s * 25 , s * 25 )
C erase old char
C @75 w(s1)p[+0,+%d]v(w(e,i0))[+%d,+0]
C next 2 lines get the appropriate element from offmat
23023 continue
      off = cdsln ( i )
      if(.not.( off .ne. 0 ))goto 23025
      off = off / iabs ( off )
23025 continue
      off = offmat ( off + 2 , cdrot ( i ) / 45 + 1 )
C write character in magnified, slanted, rotated form
      call posgc ( 303 , offmul ( off / 10 ) * s + 180 , offmul ( mod ( 
     *off , 10 ) ) * s + cday ( i ) )
      call pr2 ( 74 , cdrot ( i ) , cdsln ( i ) )
C T command stuff
C @74 t(d%d,i%d,
      call tsm ( s )
C tack on s[...]m[...])
      call pr0 ( qchar ( ch ) )
C write the character
23021 continue
      goto 23017
23018 continue
      call regis ( 47 )
C reset D and I to 0		#@47 t(d0,i0)
      end
C da1 - generate area 1 display
C  func:	if >= LOWC, specific character to update; else...
C 	func & D1TXT - clear area 1 and write static text
C 	func & D1FCH - update all user-defined characters
C 	func & D1FNM - update font name
      subroutine da1 ( func )
      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
      if(.not.( func .ge. 32 ))goto 23027
C update 1 character
      f1 = func - 32
      call posgc ( 102 + f1 / 48 * 2 , mod ( f1 , 48 ) * 13 , 0 )
      call putc ( 116 )
      call putc ( 40 )
C t(
      call tsm ( 1 )
C s[...]m[...])
      call pr0 ( qchar ( func ) )
C finally, the character
      return
23027 continue
      if(.not.( iand ( func , 1 ) .ne. 0 ))goto 23029
      call clr ( 100 , 0 )
C clear area 1
      call font0
C standard ascii font
      call posgc ( 100 , 0 , 0 )
      call wrtstr ( 107 )
C @107 Current font:
      call pr2 ( 3 , 0 , coord ( 103 , 2 ) )
      call wrtstr ( 66 )
C @66 Font name
      call pr0 ( 68 )
C @68 t[13]
      call posgc ( 101 , 0 , 0 )
      call wrtstr ( 108 )
C write ascii row 1
      call posgc ( 103 , 0 , 0 )
      call wrtstr ( 109 )
C write ascii row 2
      call pr2 ( 65 , coord ( 103 , 2 ) - 6 , coord ( 2 , 2 ) )
C box around font name
      call fonta
C back to alternate font
C @65 w(s0)p[0,%d]v[+100][,%d]
C @108  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNO
C @109 PQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
23029 continue
      if(.not.( dinitf .ne. 0 ))goto 23031
      return
23031 continue
C save time on 1st screen write
      if(.not.( iand ( func , 2 ) .ne. 0 ))goto 23033
C user-defined characters
      call dcs ( - 3 )
C VK100 in graphics mode
      call pr0 ( 87 )
C @87 t[13](
      call tsm ( 1 )
C tack on s[...]m[...])
      f1 = coord ( 102 , 1 )
C x coord of start of row
      call pr2 ( 94 , coord ( 102 , 2 ) + 19 , f1 )
C clear alternate row 1
      call wrtstr ( 108 )
C write alternate row 1
      call pr2 ( 94 , coord ( 104 , 2 ) + 19 , f1 )
C clear alternate row 2
      call wrtstr ( 109 )
C write alternate row 2
C @94 p[767,%d]w(s1)p[,-19]v(w(e))[%d]
23033 continue
      if(.not.( iand ( func , 4 ) .ne. 0 ))goto 23035
C font name
C get font-name, 10 characters long, blank-filled, in SNUST
      call cpystr ( 90 , 512 + 256 )
C @90          \b
      call cpystr ( 9 , 512 )
C overlay with font name
      call font0
C use standard ascii font
      call pr2 ( 3 , 0 , coord ( 104 , 2 ) )
      call wrtstr ( 6 )
C write it
      call fonta
C switch back to alternate font
23035 continue
      end
C da2 - generate area 2 display
C  func:	D2FULL = regenerate window
C 	D2SETU = setup ReGIS T command for writing window
C 	D2UPD1 = update 1 character in window,
C 		 uprow: mosaic row # of character to update
C 		 upcol: mosaic col # of character to update
      subroutine da2 ( func )
      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.
      logical suflg
C .false. = setup needed
      if(.not.( func .eq. 1 ))goto 23037
C full display
      call clr ( 2 , 5 )
C clear area 2
      call da2ref
C draw grid
      suflg = . false .
C need to set up T parameters
C write each character in the window
      continue
       ir = dorow
23039 if(.not.(ir.lt.dorow+wrow))goto 23041
      continue
       ic = docol
23042 if(.not.(ic.lt.docol+wcol))goto 23044
      goto 200
C "call" writer, returns to 201
201   continue
C a kludge, I know
23043 ic=ic+1
      goto 23042
23044 continue
23040 ir=ir+1
      goto 23039
23041 continue
      return
C D2SETU exists to save having to send the hairy T command parameters
C for every character in the window.  It's done for the 1st char only.
23037 continue
      if(.not.( func .eq. 2 ))goto 23045
C need to set up T command
      suflg = . false .
      return
C D2UPD1 - update specific mosaic element
23045 continue
      if(.not.( func .eq. 3 ))goto 23047
      ir = uprow
      ic = upcol
      if(.not.( mdchk ( ir , ic ) .ne. 0 ))goto 23049
C make sure it's in the window
200   if(.not.( . not . suflg ))goto 23051
C need setup?
      suflg = . true .
C yes
      call dcs ( - 3 )
C VK100 -> graphics mode
      call pr1 ( 95 , rsize + 1 )
C @95 t[+%d,+0](
      call pr4 ( 96 , rmul , cmul , rsize , csize )
C @96 m[%d,%d],s[%d,%d])
23051 continue
      call posgc ( 200 , ( ic - docol ) * rsize , ( ir - dorow ) * csize
     * )
      ch = mosmat ( ir , ic )
      call wrtch ( ch )
C match data types
      if(.not.( func .eq. 1 ))goto 23053
      goto 201
23053 continue
C "subroutine" return
23049 continue
23047 continue
      end
C da2ref - draw reference grid around window in area 2
      subroutine da2ref
      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.
      call dcs ( - 3 )
C VK100 in graphics mode
      call pr0 ( 115 )
C load special characters into 1 thru 6
C @115 l'1'7F;l'2'78;l'3'0F;l'4'4040404040;l'5'404040;l'6'0000404040;
      call posgc ( 200 , - 14 , 0 )
C left
      call grid1 ( 49 , 51 , 98 , wrow10 + 1 , 10 , 0 , cmul )
C @98 s1
      call posgc ( 200 , wcol8 * rmul + 6 , 0 )
C right
      call grid1 ( 49 , 50 , 98 , wrow10 + 1 , 10 , 0 , cmul )
      call posgc ( 200 , - 2 , - 14 )
C top
      call grid1 ( 52 , 54 , 99 , wcol8 + 1 , 8 , rmul , 0 )
C @99 m[1,2],s[2,10]
      call posgc ( 200 , - 2 , wrow10 * cmul + 6 )
C bottom
      call grid1 ( 52 , 53 , 99 , wcol8 + 1 , 8 , rmul , 0 )
      continue
       i = 49
23055 if(.not.(i.le.54))goto 23057
      call loadc ( i )
23056 i=i+1
      goto 23055
23057 continue
      end
C grid1 - draw side of reference grid (called only by da2ref)
C  ch1,ch2: characters to draw with
C  topt:    string # of options for ReGIS T command
C  n:	   # of marks
C  intvl:   frequency of ch1's
C  xinc,yinc: T[xnc,yinc]
      subroutine grid1 ( ch1 , ch2 , topt , n , intvl , xinc , yinc )
      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.
      call pr4 ( 97 , xinc , yinc , topt , 0 )
C @97 t[+%d,+%d](%s)'
      continue
       i = 0
23058 if(.not.(i.lt.n))goto 23060
C loop to write marks
      ch = ch2
C assume 2nd
      if(.not.( mod ( i , intvl ) .eq. 0 ))goto 23061
      ch = ch1
23061 continue
      call putc ( ch )
C write mark
23059 i=i+1
      goto 23058
23060 continue
      call putc ( 39 )
C terminate T command string
      end
C da3 - generate area 3 display
      subroutine da3
      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.
      a3x = 0
C clear help-wiped-out-area-3 flag
      if(.not.( a3 .eq. 2 ))goto 23063
      call mosmap ( 1 )
23063 continue
C mosaic map
      if(.not.( a3 .eq. 3 ))goto 23065
      call mosalt ( 1 )
23065 continue
C alternate-character mosaic
      if(.not.( a3 .eq. 1 ))goto 23067
      call cdisp ( - 1 )
23067 continue
C characters
      end
C dfull - clear screen and regenerate entire display
      subroutine dfull ( dum )
      implicit integer ( a - z )
      call dcs ( 1 )
      call dcs ( - 3 )
C clear screen
C draw lines on screen
      call pr1 ( 48 , coord ( 2 , 2 ) )
C upper line	#@48 p[0,%d]w(s0,i7)v[+767]
      call pr1 ( 48 , coord ( 4 , 2 ) )
C lower line
      call pr4 ( 49 , coord ( 3 , 1 ) , coord ( 3 , 2 ) , 118 , coord ( 
     *5 , 2 ) )
C @49 p[%d,%d]%c[,%d]
      call da1 ( 31 )
C font at top of screen
      call da2 ( 1 )
C window at left
      call da3 ( 0 )
C selectable stuff at right
      end
C discmd - process "show character CHAR [OPTION-LIST]" command
      subroutine discmd
      implicit integer ( a - z )
      logical cec
C .true. iff "edited-character"
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 complete parsing of command line
      call pskip ( 4 )
C get to next nonblank
      ch = sv ( pptr )
      i = sv ( pptr + 1 )
      if(.not.( ( ch .ne. 63 .and. i .ne. 0 .and. i .ne. 32 ) .or. ( ch 
     *.eq. 63 .and. i .eq. 0 ) ))goto 23069
      ch = pkey ( 86 )
C @86 01edited-character^
C 32space^
C **CHAR
      goto 23070
23069 continue
      ch = pc1 ( 1 )
23070 continue
      if(.not.( ch .lt. 0 ))goto 23071
      return
23071 continue
C return if parse error
      if(.not.( iand ( ctype ( pptr ) , 8 + 4 ) .eq. 0 ))goto 23073
C char terminated ok?
      call pdiag ( 81 )
C @81 Illegal character syntax
      return
23073 continue
      siz = 1
C character size
      rot = 0
C rotation
      sln = 0
C slant
      cec = ch .eq. 1
C want edited-character?
      if(.not.( cec ))goto 23075
      ch = edchar
C yes, get it
C scan options
23075 continue
      continue
23077 if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23078
      i = pkey ( 79 )
C @79 01size SIZE^
C 02rotation ROTATION^
C 03slant SLANT
      if(.not.( i .lt. 0 ))goto 23079
      return
23079 continue
C bad parse
      goto ( 201 , 202 , 203 ) , i
C dispatch
201   siz = pdec ( 1 , 9 )
C size, parse decimal number
      if(.not.( siz .lt. 0 ))goto 23081
      return
23081 continue
C bad parse
      goto 210
202   rot = pkey ( 78 ) * 45
C rotation
C @78 000^0145^0290^03135^04180^05225^06270^07315
      if(.not.( rot .lt. 0 ))goto 23083
      return
23083 continue
C bad parse
      goto 210
203   i = 1
      call pskip ( 4 )
C slant
      delf = sv ( pptr )
C get 1st character of argument
      if(.not.( delf .eq. 63 ))goto 23085
C help
      call pdiag ( 80 )
C @80 Integer between -45 and 45
      return
23085 continue
      if(.not.( delf .eq. 45 ))goto 23087
      i = - 1
      pptr = pptr + 1
23087 continue
      sln = pdec ( 0 , 45 )
C parse number
      if(.not.( sln .lt. 0 ))goto 23089
      return
23089 continue
C blew it
      sln = sln * i
C apply sign
C goto 210
210   continue
C parsing done, check if new character fits in the display
      goto 23077
23078 continue
      cdx = 1
C index into cd tables
      continue
23091 if(.not.( cdch ( cdx ) .ne. 0 ))goto 23092
      cdx = cdx + 1
C find first available slot
C store attributes now; char will be stored later if there's enough room
      goto 23091
23092 continue
      cdsiz ( cdx ) = siz
      cdrot ( cdx ) = rot
      cdsln ( cdx ) = sln
      cdcec ( cdx ) = cec
      cdch ( cdx + 1 ) = 0
C set new end-of-list
      delf = 0
C display flag
C loop to ask user which existing characters must be removed from
C the display in order to make room for the new character
      continue
23093 if(.not.( cday ( cdx + 1 ) .ge. coord ( 5 , 2 ) - coord ( 303 , 2 
     *) ))goto 23094
      if(.not.( delf .ne. 0 ))goto 23095
      call cdisp ( - 1 )
C regen area 3 or
      goto 23096
23095 continue
      call seta3 ( 1 )
23096 continue
C just request the proper display
      delf = 0
      call dcs ( 4 )
      call pr0 ( 73 )
C prompt in area 4
C @73 Give number of character to delete, or hit return to abort
      call prdtty ( 72 )
C @72 Not enough room -\b
      if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23097
C abort?
      cdch ( cdx ) = 0
C yes, tie it off here
      return
23097 continue
      del = pdec ( 1 , cdx )
C get character number
      if(.not.( del .gt. 0 ))goto 23099
C if number parsed ok...
      continue
23101 continue
C move following chars up one
      i = cdch ( del + 1 )
C get char
      cdch ( del ) = i
C move it
      cdsiz ( del ) = cdsiz ( del + 1 )
      cdrot ( del ) = cdrot ( del + 1 )
      cdsln ( del ) = cdsln ( del + 1 )
      cdcec ( del ) = cdcec ( del + 1 )
      del = del + 1
C step to next pair
23102 if(.not.( i .eq. 0 ))goto 23101
23103 continue
      cdx = cdx - 1
C subtract 1 from length of list
      delf = 1
C regenerate area 3 on next loop
23099 continue
      goto 23093
23094 continue
      cdch ( cdx ) = ch
C it fits, store it
      a3 = 1
      a3x = 1
C rewrite area 3
      end
C dupd - update displays (typically called before doing input)
      subroutine dupd
      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 .true. if characters changed since last write
      integer winu ( 3 , 3 )
      data odorow , odocol / 1 , 1 /
      dochng = 0
C assume window hasn't moved
      if(.not.( dorow .ne. odorow .or. docol .ne. odocol ))goto 23104
      dochng = 1
C check if it did
C area 2 - determine what to update, rememeber it in winu
23104 continue
      continue
       wr = 1
23106 if(.not.(wr.le.3))goto 23108
C scan all chars in window
      continue
       wc = 1
23109 if(.not.(wc.le.3))goto 23111
      mr = wr + dorow - 1
      mc = wc + docol - 1
C mosaic
      i = 0
C assume not changed
      ch = mosmat ( mr , mc )
C get character in mosaic
      if(.not.( dochng .ne. 0 .or. fmatc ( ch - 30 ) .ne. 0 .or. ch .ne.
     * omosmt ( mr , mc ) ))goto 23112
      i = 1
23112 continue
      winu ( wr , wc ) = i
C 0 if no change, 1 if change
C area 1 and VK100 font
23110 wc=wc+1
      goto 23109
23111 continue
23107 wr=wr+1
      goto 23106
23108 continue
      i = - 10
C find the more efficient way to update area 1
      continue
       ch = 32 - 30
23114 if(.not.(ch.le.126-30))goto 23116
      if(.not.( fmatc ( ch ) .ne. 0 ))goto 23117
      i = i + 1
23117 continue
23115 ch=ch+4
      goto 23114
23116 continue
      continue
       ch = 32 - 30
23119 if(.not.(ch.le.126-30))goto 23121
      if(.not.( fmatc ( ch ) .ne. 0 ))goto 23122
C definition changed?
      ch1 = ch + 30
C yes, get real character
      call loadc ( ch1 )
C transmit definition to VK100
      if(.not.( i .lt. 0 ))goto 23124
      call da1 ( ch1 )
23124 continue
C one-by-one mode
      if(.not.( a3 .eq. 1 ))goto 23126
      call cdisp ( ch1 )
23126 continue
C update area 3 chars
23122 continue
23120 ch=ch+1
      goto 23119
23121 continue
      if(.not.( i .ge. 0 ))goto 23128
      call da1 ( 2 )
C batch update
C update area 2
23128 continue
      call da2 ( 2 )
C set up for T command
      continue
       wr = 1
23130 if(.not.(wr.le.wrow))goto 23132
C loop thru characters
      continue
       wc = 1
23133 if(.not.(wc.le.wcol))goto 23135
C  in window
      if(.not.( winu ( wr , wc ) .ne. 0 ))goto 23136
C want to update?
      uprow = wr + dorow - 1
      upcol = wc + docol - 1
      call da2 ( 3 )
C update char in window
C area 3
C  Regenerate area 3 completely if any of the following are true:
C   1 - One command has been typed since help display was generated
C   2 - A "read" command has just read a mosaic from a font file
23136 continue
23134 wc=wc+1
      goto 23133
23135 continue
23131 wr=wr+1
      goto 23130
23132 continue
      a3x = a3x - 1
C help stuff
      if(.not.( a3x .lt. 0 .and. rdmos ))goto 23138
      a3x = 0
23138 continue
C mosaic-read
      rdmos = . false .
      if(.not.( a3x .eq. 0 ))goto 23140
      call da3
C regen if necessary
C a3x now has the following implications:
C  > 0	Help present in area 3
C  = 0	Area 3 just redrawn
C  < 0	Neither of the above; may have to update area 3
23140 continue
      call mosalt ( 2 )
C prepare for MAUPD1
      continue
       uprow = 1
23142 if(.not.(uprow.le.10))goto 23144
C all chars in mosaic
      continue
       upcol = 1
23145 if(.not.(upcol.le.10))goto 23147
      ch = mosmat ( uprow , upcol )
C get char from mosaic
      och = omosmt ( uprow , upcol )
C get previous char
C want to update area 3?
      if(.not.( a3x .lt. 0 ))goto 23148
C yes
      if(.not.( a3 .eq. 2 .and. ch .ne. och ))goto 23150
      call mosmap ( 4 )
23150 continue
      if(.not.( a3 .eq. 3 .and. ( ch .ne. och .or. fmatc ( ch - 30 ) .ne
     *. 0 ) ))goto 23152
      call mosalt ( 3 )
23152 continue
23148 continue
      omosmt ( uprow , upcol ) = ch
C update memory
23146 upcol=upcol+1
      goto 23145
23147 continue
23143 uprow=uprow+1
      goto 23142
23144 continue
      if(.not.( dochng .ne. 0 .and. a3x .lt. 0 .and. a3 .eq. 2 ))goto 23
     *154
C window moved
      call posgcc ( 301 , odocol * 3 , odorow )
C position to old box
      call mosmap ( 3 )
C erase box
      call mosmap ( 2 )
C draw new box
23154 continue
      odorow = dorow
      odocol = docol
C update memory
C clear definition-has-changed flags
      continue
       ch = 32 - 30
23156 if(.not.(ch.le.126-30))goto 23158
      fmatc ( ch ) = 0
23157 ch=ch+1
      goto 23156
23158 continue
      end
C mdchk - return 1 iff specified mosaic character appears in window
      integer function mdchk ( row , col )
      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.
      mdchk = 0
      if(.not.( row .ge. dorow .and. col .ge. docol .and.  row .lt. doro
     *w + wrow .and. col .lt. docol + wcol ))goto 23159
      mdchk = 1
23159 continue
      end
C mosalt - draw alternate-character mosaic in area 3
C  func: MAFULL - full display
C 	MASETU - setup ReGIS T command for writing characters
C 	MAUPD1 - update 1 element in mosaic, row & col in uprow & upcol
      subroutine mosalt ( func )
      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.
      logical suflg
      goto ( 101 , 102 , 103 ) , func
C dispatch
C MAFULL
101   call clr ( 3 , 6 )
C clear area 3
      call posgc ( 304 , 0 , 0 )
C position cursor
      call pr0 ( 46 )
C @46 t[16](s[16,30]m[2,3])
C NOTE: String 46 used elsewhere
      call putc ( 34 )
C open quote
      continue
       ir = 1
23161 if(.not.(ir.le.10))goto 23163
C go thru rows of mosaic
      continue
       ic = 1
23164 if(.not.(ic.le.10))goto 23166
C go thru cols of mosaic
      ch = mosmat ( ir , ic )
C get char from mosaic
      omosmt ( ir , ic ) = ch
C copy to updating memory
      call putc ( ch )
C write character
      if(.not.( ch .eq. 34 ))goto 23167
      call putc ( 34 )
23167 continue
23165 ic=ic+1
      goto 23164
23166 continue
      call putc ( 10 )
C start next line
23162 ir=ir+1
      goto 23161
23163 continue
      call putc ( 34 )
C terminate the string
      return
C MASETU	exists to save having to send T command parameters for every
C 	character in the mosaic.  Done for the 1st char only.
102   suflg = . false .
C not set up
      return
C MAUPD1
103   call posgc ( 304 , ( upcol - 1 ) * 16 , ( uprow - 1 ) * 30 )
C position cursor
      if(.not.( . not . suflg ))goto 23169
C set up yet?
      call dcs ( - 3 )
C VK100 in graphics mode
      call pr0 ( 46 )
C set up T command stuff
      suflg = . true .
C remember setup was done
      goto 23170
23169 continue
      call putc ( 116 )
23170 continue
C just type T if set up
      ch = mosmat ( uprow , upcol )
C get char from mosaic
      call pr0 ( qchar ( ch ) )
C send quoted character
      return
      end
C mosmap - display entire mosaic and window location
C  func:	MOFUL - full display
C 	MODRB - draw window box
C 	MOERB - erase window box (caller must position cursor)
C 	MOUP1 - update 1 element of mosaic
C 		uprow: mosaic row # of element to update
C 		upcol: mosaic col # of element to update
      subroutine mosmap ( func )
      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
      if(.not.( a3 .ne. 2 ))goto 23171
      return
23171 continue
C must be showing mosaic map!
      goto ( 201 , 202 , 203 , 204 ) , func
C dispatch to function handler
C MOFUL
201   call clr ( 3 , 6 )
C clear area 3
      call font0
C standard ascii font
C do top line (column coords)
      call posgcc ( 300 , 3 , 0 )
C position cursor
      uptr = iuptr
C init pointer to build area
      continue
       ic = 0
23173 if(.not.(ic.lt.10))goto 23175
C do letters
      call putu ( 97 + ic )
      call putu ( 32 )
      call putu ( 32 )
23174 ic=ic+1
      goto 23173
23175 continue
      sv ( uptr - 2 ) = 0
C tie it off
      call wrtstr ( 6 )
C write top line
C loop thru rows of mosaic
      continue
       ir = 1
23176 if(.not.(ir.le.10))goto 23178
      uptr = iuptr
C pointer to work string
      ch = 32
      if(.not.( ir .gt. 9 ))goto 23179
      ch = 49
23179 continue
C 0-suppress
      call putu ( ch )
      call putu ( mod ( ir , 10 ) + 48 )
      continue
       ic = 1
23181 if(.not.(ic.le.10))goto 23183
      call putu ( 32 )
C space before character
      ch = mosmat ( ir , ic )
C get character
      omosmt ( ir , ic ) = ch
C copy to updating memory
      call putu ( ch )
      call putu ( 32 )
C write to screen
C remove trailing blanks
23182 ic=ic+1
      goto 23181
23183 continue
      continue
23184 if(.not.( sv ( uptr - 1 ) .eq. 32 ))goto 23185
      uptr = uptr - 1
      goto 23184
23185 continue
      sv ( uptr ) = 0
C tie it off
      call posgcc ( 300 , 0 , ir + 1 )
C cursor at start of line
      call wrtstr ( 6 )
C write row
23177 ir=ir+1
      goto 23176
23178 continue
      call fonta
C switch back to alternate font
C goto 202				#draw box and split
C MODRB/MOERB
202   call posgcc ( 301 , docol * 3 , dorow )
C position cursor
      goto 210
203   call pr0 ( 56 )
C @56 w(e)
210   ir = 20 * wrow
      ic = 27 * wcol
C dimensions of box
      call pr4 ( 150 , ic , ir , ic , ir )
C @150 w(s0)v[+%d][,+%d][-%d][,-%d]
      if(.not.( func .eq. 3 ))goto 23186
      call pr0 ( 55 )
23186 continue
C @55 w(r)
      return
C MOUP1
204   ch = mosmat ( uprow , upcol )
C get character
      call posgcc ( 300 , upcol * 3 , uprow + 1 )
C position cursor in map
      call font0
C standard ascii font
      call pr0 ( qchar ( ch ) )
C write character
      call fonta
C switch back to alternate font
C if character wiped out bottom of box, redraw the box
      if(.not.( uprow .eq. dorow + wrow - 1 ))goto 23188
      goto 202
23188 continue
      end
C seta3 - specify what to show in area 3
C  new: A3xxx (see gdef)
      subroutine seta3 ( new )
      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.
      old = a3
      a3 = new
C set new, remember old
      if(.not.( old .ne. new ))goto 23190
      call da3
23190 continue
C if different, regenerate area 3
      end
C windim - set window dimensions
C  rows: from 1 to WROW
C  cols: from 1 to WCOL
C  rm,cm: rmul and cmul values for ReGIS T command
      subroutine windim ( rows , cols , rm , cm )
      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 gtcom>
      integer p0def ( 8 , 2 ) , p1def ( 5 , 2 ) , p2def ( 1 , 2 ) , p3de
     *f ( 6 , 2 )
      common / gtcom /  p0def , p1def , p2def , p3def , nogrph
C x,y coordinates of points in area 0
C x,y coordinates of points in area 1
C x,y coordinates of points in area 2
C x,y coordinates of points in area 3
C if nonzero, don't send <esc>Pp sequence
      if(.not.( rmul .eq. rm .and. cmul .eq. cm .and. rows .eq. wrow .an
     *d. cols .eq. wcol ))goto 23192
      return
23192 continue
      if(.not.( dinitf .eq. 0 ))goto 23194
C initializing?
      call posgcc ( 301 , dorow * 3 , docol )
C no
      call mosmap ( 3 )
C erase box in area 3
23194 continue
      rmul = rm
      cmul = cm
C install new values
      rsize = rmul * 8
      csize = cmul * 10
      wrow = rows
      wrow10 = wrow * 10
      wcol = cols
      wcol8 = wcol * 8
      call stcwcn ( 0 )
C wcn redefined
C compute new position of point 200
      p2def ( 1 , 1 ) = 24 + ( 3 - wcol ) * rmul * 4
      p2def ( 1 , 2 ) = 24 + ( 3 - wrow ) * cmul * 5
      if(.not.( dinitf .eq. 0 ))goto 23196
C initializing?
      call da2 ( 1 )
C no, regenerate area 2
      call mosmap ( 2 )
C draw box in area 3
23196 continue
      end