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