Google
 

Trailing-Edge - PDP-10 Archives - BB-K829A-BM_1981 - sources/ge.for
There is 1 other file named ge.for in the archive. Click here to see a list.
C ge> Editing-command functions
C RTA 12/12/80 Don't clobber mosaic when editing single character
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 anlz - analyze wcn
C  wcn:  window cell number (input)
C output...
C  mrow,mcol: mosaic row,col of character that contains wcn
C  crow,ccol: row,col of cell within character
      subroutine anlz ( wcn , mrow , crow , mcol , ccol )
      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.
      w = wcn
C make private copy
      ccol = mod ( w , 8 ) + 1
      w = w / 8
      mcol = mod ( w , wcol ) + docol
      w = w / wcol
      crow = mod ( w , 10 ) + 1
      mrow = w / 10 + dorow
      end
C anlzm - like anlz, except gives only mrow and mcol
      subroutine anlzm ( wcn , mrow , mcol )
      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.
      mcol = mod ( wcn / 8 , wcol ) + docol
      mrow = wcn / ( wcol8 * 10 ) + dorow
      end
C edit - process edit command
      subroutine edit
      implicit integer ( a - z )
      logical moved
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 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 states
      siz = 3
C assume editing mosaic
      if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23000
C editing a character?
      ch = pc1 ( 1 )
C yes, parse it
      if(.not.( ch .lt. 0 ))goto 23002
      return
23002 continue
C badness
      siz = 1
C doing 1 X 1
23000 continue
      if(.not.( peol ( 0 ) .ne. 0 ))goto 23004
      return
23004 continue
C check for eol
      if(.not.( siz .eq. 1 ))goto 23006
C editing a character?
C Temporarily substitute the edited-character for one of the
C characters in the mosaic (because all the editing routines
C reference the mosaic).  If the mosaic is showing in Area 3,
C blank it so user doesn't think I changed the mosaic.  Upon
C exit, restore the character and redisplay the mosaic.
      savch = mosmat ( dorow , docol )
C yes, remember what's there now
      sava3 = 0
C assume no mosaic in area 3
      if(.not.( a3 .eq. 2 .or. a3 .eq. 3 ))goto 23008
C showing mosaic in area 3?
      sava3 = a3
C yes, remember what's there now
      call seta3 ( 0 )
C request no display in area 3
      call clr ( 3 , 6 )
C clear area 3
23008 continue
      mosmat ( dorow , docol ) = ch
C install edited-character in mosaic
      edchar = ch
C save for area 3 display
      call cdisp ( - 2 )
C update area 3 display
23006 continue
      call windim ( siz , siz , rmul , cmul )
C set up window
      call dcs ( 3 )
C clear area 4 line 1
      call pr0 ( 64 )
C @64 Mode: NO-CHANGE
      msg = 0
C no message in area 1
      call undo ( 1 , 0 )
C clear undo memory
      call lmode ( 1 )
C VK100 into SC1 mode
C modes:  0 no-change, 1 flip, 2 erase, 3 draw
C nmode = normal mode,  fmode = figure mode
      nmode = 0
      fmode = 3
C initial modes
      state = 1
C initial state
      continue
23010 if(.not.( . true . ))goto 23011
C loop once per keystroke
      if(.not.( msg .ne. 0 ))goto 23012
C message to display?
      call dcs ( - 2 )
C yes
      call pr1 ( 61 , msg )
C @61 \033[23;41H\033[K%s
      msg = 0
C clear message
23012 continue
      call dupd
C update displays
      call posgcw ( cwcn , 1 )
C position graphics cursor
      call read1 ( 0 )
C read 1 keystroke
      if(.not.( diagf .ne. 0 ))goto 23014
      call dcs ( 4 )
      diagf = 0
C erase diag
23014 continue
      cmd = keypad ( 0 )
C get function code
      goto ( 1001 , 1002 , 1003 ) , state
C MOVE
1001  goto ( 99 , 99 , 1 , 1 , 1 , 1 , 5 , 1 , 1 , 1 , 1 , 10 , 99 , 99 
     *, 13 , 14 , 14 , 14 , 14 , 18 , 19 , 20 , 21 , 22 ) , cmd + 2
1     nw = cwcn
      moved = . true .
C moving cursor
      if(.not.( cmd .ge. 7 ))goto 23016
C up
      nw = nw - wcol8
      if(.not.( nw .lt. 0 ))goto 23018
      moved = . false .
23018 continue
23016 continue
      if(.not.( cmd .le. 3 ))goto 23020
C down
      nw = nw + wcol8
      if(.not.( nw .ge. wcol8 * wrow10 ))goto 23022
      moved = . false .
23022 continue
23020 continue
      if(.not.( mod ( cmd , 3 ) .eq. 1 ))goto 23024
C left
      if(.not.( mod ( nw , wcol8 ) .eq. 0 ))goto 23026
      moved = . false .
23026 continue
      nw = nw - 1
23024 continue
      if(.not.( mod ( cmd , 3 ) .eq. 0 ))goto 23028
C right
      nw = nw + 1
      if(.not.( mod ( nw , wcol8 ) .eq. 0 ))goto 23030
      moved = . false .
23030 continue
23028 continue
      if(.not.( moved ))goto 23032
C move legal?
      call stcwcn ( nw )
C yes, set new cwcn
      if(.not.( state .eq. 1 ))goto 23034
      call wcnz ( nw , nmode )
23034 continue
C make change
23032 continue
      goto 23010
5     call wcnz ( cwcn , 1 )
C reverse current cell
      goto 23010
10    state = 2
C figure
      msg = 60
C @60 Specify type of figure
      xmode = fmode
C want to show figure mode
      goto 141
C go update mode display
13    if(.not.( undo ( 3 , 0 ) .eq. 0 ))goto 23036
      call pdiag ( 88 )
23036 continue
C @88 Nothing to undo
      goto 23010
14    xmode = cmd - 14
C no-change flip erase draw
      if(.not.( state .eq. 1 ))goto 23038
      nmode = xmode
      call wcnz ( cwcn , nmode )
      goto 23039
23038 continue
      if(.not.( xmode .ne. 0 ))goto 23040
      fmode = xmode
      goto 23041
23040 continue
      goto 23010
23041 continue
23039 continue
141   call dcs ( - 2 )
      call pr1 ( 62 , 50 + xmode )
C @62 \033[23;7H%s
C @50 NO-CHANGE
C @51 FLIP    \b
C @52 ERASE   \b
C @53 DRAW    \b
      goto 23010
18    cmd = 8
      goto 1
C up arrow
19    cmd = 2
      goto 1
C down arrow
20    cmd = 6
      goto 1
C right arrow
21    cmd = 4
      goto 1
C left arrow
C FIG1
1002  goto ( 99 , 99 , 201 , 202 , 203 , 204 , 99 , 206 , 99 , 99 , 99 ,
     * 99 , 99 , 99 , 250 , 14 , 14 , 14 , 14 , 99 , 99 , 99 , 99 , 22 )
     * , cmd + 2
201   call undo ( 1 , 0 )
C row
      ir = cwcn / wcol8 * wcol8
C get 1st wcn in row
      continue
       ic = 0
23042 if(.not.(ic.lt.wcol8))goto 23044
C loop over all cols in row
      call wcnz ( ir + ic , fmode )
23043 ic=ic+1
      goto 23042
23044 continue
      goto 252
202   call undo ( 1 , 0 )
C column
      ic = mod ( cwcn , wcol8 )
C get column #
      continue
       ir = 0
23045 if(.not.(ir.lt.wrow10))goto 23047
C loop over all rows
      call wcnz ( ir * wcol8 + ic , fmode )
23046 ir=ir+1
      goto 23045
23047 continue
      goto 252
203   fig = 1
      msg = 58
      goto 251
C @58 Other endpoint of line
204   fig = 2
      msg = 59
      goto 251
C @59 Other corner of box
206   fig = 3
      msg = 59
C  goto 251
251   state = 3
C enter FIG2 state
      point1 = cwcn
C remember first point
      goto 23010
252   call undo ( 2 , 0 )
C clear at next modification
250   state = 1
C figure processing complete
      msg = 1
C clear message
      xmode = nmode
C want to show move mode
      goto 141
C go update mode display
C FIG2
1003  goto ( 99 , 99 , 1 , 1 , 1 , 1 , 5 , 1 , 1 , 1 , 1 , 310 , 99 , 99
     * , 250 , 14 , 14 , 14 , 14 , 18 , 19 , 20 , 21 , 22 ) , cmd + 2
310   call undo ( 1 , 0 )
C have 2nd point ot line/box/sbox
      goto ( 3001 , 3002 , 3003 ) , fig
C dispatch according to fig type
3001  call zline ( point1 , cwcn , fmode )
      goto 252
3002  call zbox ( point1 , cwcn , fmode )
      goto 252
3003  call zsbox ( point1 , cwcn , fmode )
      goto 252
99    if(.not.( sv ( sx ( 2 ) ) .eq. 63 ))goto 23048
      call emenu
23048 continue
C give menu if "?" typed
C end of editing session:  clean up and return to command level
      goto 23010
23011 continue
22    call lmode ( 1 )
C back to SC0
      if(.not.( siz .eq. 1 ))goto 23050
C single-character edit?
      mosmat ( dorow , docol ) = savch
C yes, restore borrowed character
      if(.not.( sava3 .ne. 0 ))goto 23052
      call seta3 ( sava3 )
23052 continue
C restore mosaic display in area 3
      call windim ( 3 , 3 , rmul , cmul )
C put window back in 3 X 3 mode
23050 continue
      end
C emenu - draw edit-mode keypad menu in area 3
      subroutine emenu
      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 NKPV is the number of vectors in keypad grid
      integer k ( 19 )
C elements of "k": (direction * 10) + (magnitude / (60 vert or 99 horiz))
C directions: 1 right, 2 up, 3 left, 4 down
      data k ( 1 ) , k ( 2 ) , k ( 3 ) , k ( 4 ) , k ( 5 ) , k ( 6 ) , k
     * ( 7 ) , k ( 8 ) / 35 , 04 , 15 , 21 , 35 , 21 , 15 , 21 /
      data k ( 9 ) , k ( 10 ) , k ( 11 ) , k ( 12 ) , k ( 13 ) , k ( 14 
     *) , k ( 15 ) / 34 , 02 , 23 , 11 , 04 , 11 , 24 /
      data k ( 16 ) , k ( 17 ) , k ( 18 ) , k ( 19 ) / 11 , 04 , 11 , 24
     * /
      a3x = 2
C arrange to have area 3 regenerated on next command
      call clr ( 3 , 6 )
C clear area 3
      call posgc ( 305 , 8 + 37 * 9 , 8 + 180 )
      call pr0 ( 30 )
C @30 w(s0)t[+0,+17](a0,s1)'FIGURE'
      call posgc ( 305 , 4 , 8 )
      call pr0 ( 31 )
C @31 t[+9,+0]'NO-CHANGE     FLIP      ERASE       DRAW'
      call posgc ( 305 , 4 + 12 * 9 , 8 + 120 )
      call wrtstr ( 32 )
C @32 FLIP 1
      call posgc ( 305 , 4 + 3 * 9 , 32 + 120 )
      call wrtstr ( 33 )
C @33 BOX       CELL      SOLID-BOX
      call posgc ( 305 , 4 + 3 * 9 , 32 + 180 )
      call wrtstr ( 34 )
C @34 ROW       COLUMN     LINE
      call posgc ( 305 , 4 + 24 * 9 , 8 + 240 )
      call wrtstr ( 35 )
C @35 UNDO/
      call posgc ( 305 , 4 + 24 * 9 , 32 + 240 )
      call wrtstr ( 36 )
C @36 CANCEL
C draw the grid (a series of vectors)
      call posgc ( 305 , 0 , 0 )
      call putc ( 118 )
C v is for vector
      continue
       i = 1
23054 if(.not.(i.le.19))goto 23056
      call putc ( 91 )
      dir = k ( i ) / 10
C direction
      mag = k ( i )
      mag = mod ( mag , 10 )
C magnitude
      if(.not.( dir .eq. 1 .or. dir .eq. 3 ))goto 23057
C which axis?
      call putc ( 44 )
C Y
      mag = mag * 60
C vertical multiplier
      goto 23058
23057 continue
      mag = mag * 99
23058 continue
C X
      if(.not.( dir .eq. 1 .or. dir .eq. 2 ))goto 23059
      call putc ( 45 )
      goto 23060
23059 continue
      call putc ( 43 )
23060 continue
      call putdec ( mag , 0 , 0 )
C write vector length
      call putc ( 93 )
C draw arrows on keys 7,8,9,4,6,1,2,3 (in that order)
23055 i=i+1
      goto 23054
23056 continue
      call posgc ( 305 , 5 * 9 , 8 + 60 + 10 )
      call pr0 ( 38 )
C @38 v[,-10][+10][-10][+14,+14]
      call posgc ( 305 , 16 * 9 - 3 , 8 + 60 + 7 )
      call pr0 ( 39 )
C @39 v[+7,-7][,+14][,-14][+7,+7]
      call posgc ( 305 , 27 * 9 , 8 + 60 )
      call pr0 ( 40 )
C @40 v[+10][,+10][,-10][-14,+14]
      call posgc ( 305 , 5 * 9 + 7 , 8 + 120 )
      call pr0 ( 41 )
C @41 v[-7,+7][+14][-14][+7,+7]
      call posgc ( 305 , 27 * 9 , 8 + 120 )
      call pr0 ( 42 )
C @42 v[+7,+7][-14][+14][-7,+7]
      call posgc ( 305 , 5 * 9 , 8 + 180 + 4 )
      call pr0 ( 43 )
C @43 v[,+10][+10][-10][+14,-14]
      call posgc ( 305 , 16 * 9 - 3 , 8 + 180 + 4 )
      call pr0 ( 44 )
C @44 v[+7,+7][,-14][,+14][+7,-7]
      call posgc ( 305 , 27 * 9 , 8 + 180 )
      call pr0 ( 45 )
C @45 v[+14,+14][-10][+10][,-10]
      call fonta
C switch back to alternate font
      end
C stcwcn - set current wcn (for positioning graphics cursor)
C  new: new wcn
      subroutine stcwcn ( new )
      implicit integer ( a - z )
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
      if(.not.( new .ge. 0 ))goto 23061
C must be valid
      cwcn = new
C set current wcn
      call anlz ( cwcn , cmrow , ccrow , cmcol , cccol )
C split it up
23061 continue
      end
C undo - support undo command
C  func:	UNCLR  - clear memory
C 	UNCLRD - same as UNCLR, but deferred until next UNSVFM call
C 	UNUNDO - restore saved values and clear memory
C 	UNSVFM - save definition of character from fmat
C  arg: if func = UNSVFM, arg is character to save
C  for func = UNUNDO, returns 1 if something undone, else 0
      integer function undo ( func , arg )
      implicit integer ( a - z )
C size of saved character stacks
C should be WROW * WCOL + 1
      integer ufch ( 10 )
C characters that were changed
      integer udef ( 10 , 10 )
C definitions of characters, parallel to ufch
      integer tmp
      logical defer
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.
      undo = 0
C assume nothing to undo
      goto ( 201 , 202 , 203 , 204 ) , func
C dispatch according to function
C UNCLRD
202   defer = . true .
C request deferred undoing
      goto 300
C UNUNDO
203   continue
       i = 1
23063 if(.not.(ufch(i).ne.0))goto 23065
C loop once per saved char
      ch = ufch ( i ) - 30
C get subscript for fmat, fmatc
C swap fmat entry with udef entry, so if the user says
C "undo" again, the last "undo" will be undone
      continue
       i1 = 1
23066 if(.not.(i1.le.10))goto 23068
      tmp = fmat ( ch , i1 )
      fmat ( ch , i1 ) = udef ( i , i1 )
      udef ( i , i1 ) = tmp
23067 i1=i1+1
      goto 23066
23068 continue
      fmatc ( ch ) = 1
C mark character as changed
      undo = 1
C something restored
23064 i=i+1
      goto 23063
23065 continue
      goto 300
C UNCLR
201   ufch ( 1 ) = 0
C no saved definitions
      defer = . false .
      goto 300
C UNSVFM
204   if(.not.( defer ))goto 23069
      ufch ( 1 ) = 0
      defer = . false .
C clear if deferred
23069 continue
      continue
       i = 1
23071 if(.not.(ufch(i).ne.0))goto 23073
C char already stacked?
      if(.not.( ufch ( i ) .eq. arg ))goto 23074
      goto 300
23074 continue
23072 i=i+1
      goto 23071
23073 continue
C yes, return
      ufch ( i ) = arg
C no, add to stack
      ufch ( i + 1 ) = 0
C tie off stack again
      continue
       i1 = 1
23076 if(.not.(i1.le.10))goto 23078
C make a copy of the definition
      udef ( i , i1 ) = fmat ( arg - 30 , i1 )
23077 i1=i1+1
      goto 23076
23078 continue
300   continue
      end
C wcnz - examine or change window cell
C  wcn: window cell #
C  func: 0 examine (function returns current setting, 0 or 1),
C 	1 complement, 2 clear, 3 set
      integer function wcnz ( wcn , 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 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
      call anlz ( wcn , tmrow , tcrow , tmcol , tccol )
C get rows and columns
      ch = mosmat ( tmrow , tmcol ) - 30
C get character from mosaic
      fme = fmat ( ch , tcrow )
C get char row containing wcn
      bit = 2 * * ( 8 - tccol )
C get bit in row
      if(.not.( func .eq. 0 ))goto 23079
C func 0... return setting
      wcnz = 0
C assume off
      if(.not.( iand ( fme , bit ) .ne. 0 ))goto 23081
      wcnz = 1
23081 continue
C wrong, it's on
      goto 23080
23079 continue
      call undo ( 4 , ch + 30 )
C save old definition for undo
      fme1 = fme
C remember original value
      goto ( 201 , 202 , 203 ) , func
C dispatch
201   fme = ieor ( fme , bit )
C  complement
      goto 210
202   fme = iand ( fme , ieor ( bit , 255 ) )
C  clear
      goto 210
203   fme = ior ( fme , bit )
C  set
C goto 210
210   if(.not.( fme1 .ne. fme ))goto 23083
C has it changed?
      fmat ( ch , tcrow ) = fme
C yes, update fmat
      fmatc ( ch ) = 1
C this char changed
      quitf = . true .
C some char has changed
23083 continue
23080 continue
      end
C zbox - draw box given opposite corners
C  w1,w2: wcn's of corners
C  mode: 1 change, 2 erase, 3 draw
      subroutine zbox ( w1 , w2 , mode )
      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.
      ir = w2 / wcol8 - w1 / wcol8
C get row difference
      ic = mod ( w2 , wcol8 ) - mod ( w1 , wcol8 )
C get column difference
      if(.not.( ir .ne. 0 .and. ic .ne. 0 ))goto 23085
C a real box?
      ir1 = 1
      if(.not.( ir .gt. 0 ))goto 23087
      ir1 = - 1
23087 continue
C yes
      ir1 = ( ir + ir1 ) * wcol8
      ir = ir * wcol8
      ic1 = ic + 1
      if(.not.( ic .gt. 0 ))goto 23089
      ic1 = ic - 1
23089 continue
      call zline ( w1 , w1 + ic1 , mode )
      call zline ( w1 + ic , w1 + ic + ir1 , mode )
      call zline ( w2 , w2 - ic1 , mode )
      call zline ( w2 - ic , w2 - ic - ir1 , mode )
      goto 23086
23085 continue
      call zline ( w1 , w2 , mode )
23086 continue
C degenerate case
      end
C zline - draw line between 2 wcns
      subroutine zline ( w1 , w2 , mode )
      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.
      ir = w2 / wcol8 - w1 / wcol8
C row distance
      ic = mod ( w2 , wcol8 ) - mod ( w1 , wcol8 )
C column distance
      ns = max0 ( iabs ( ir ) , iabs ( ic ) )
C compute # of points in line
      continue
       i = 0
23091 if(.not.(i.le.ns))goto 23093
C loop once per point
      wx = w1 + ir * i / ns * wcol8 + ic * i / ns
      call wcnz ( wx , mode )
23092 i=i+1
      goto 23091
23093 continue
      end
C zsbox - draw solid box given opposite corners
      subroutine zsbox ( wcn1 , wcn2 , mode )
      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.
      w1 = wcn1
      w2 = wcn2
C private copies
      continue
23094 continue
C get w1 and w2 in proper order
      ir = w1
      w1 = w2
      w2 = ir
C swap
      ir = w2 / wcol8 - w1 / wcol8
C row distance
      ic = mod ( w2 , wcol8 ) - mod ( w1 , wcol8 )
C column distance
23095 if(.not.( ir .ge. 0 ))goto 23094
23096 continue
      continue
23097 if(.not.( ir .ge. 0 ))goto 23098
C draw box 1 line at a time
      ir = ir - 1
C count 'em down
      call zline ( w1 , w1 + ic , mode )
      w1 = w1 + wcol8
C step to next row
      goto 23097
23098 continue
      end