Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/imain.for
There are no other files named imain.for in the archive.
C imain> ReGIS input -- Main control
C ################################################
C Graphics Editor - Input Module #
C Rick Ace #
C New York Institute of Technology #
C July, 1980 #
C ################################################
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
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 define char byte
C 27+128
C w(riting) opt(ion)s come groups of 8:
C (1) replace(0)/erase(1)/complement(2)/overlay(3)
C (2) negative image 0/1
C (3) pattern < 256 bit mask (e.g. 192 = P11000000)
C >= 256 canned pattern * 256 (e.g. 512 = P2)
C if value >= 256, low 8 bits are ignored
C (4) pattern multiplier, different from 6(?)
C (5) shading flag, sim pattern+ >= 10 use char
C (6) if shading != 0 this is y reference val
C (7) pixel multiplier, 1 <= value <= 10
C (8) alternating 0/1
C (9) foreground intensity, 0 <= value <= 7
C (10) background intensity, 0 <= value <= 7
C
C offsets from gwopsp...
C Inktypes...
C Inkolors...
C Text options
C RSTSONLY define Maxgels 1000 # due to limited RAM on RSTS
C drawing primitive gels...
C attribute/marker/other gels...
C writing attribute gels : Woptbase + wopindex
C similarly topts...
C maximum # of characters in a filespec
C maximum # of characters in a command line
C max length of prompt buffer
C max number of characters in file record
C size of record buffers (Fbufsz + 1)
C include logdef
C ========================================================================
C ========================================================================
C inrgis - this is the main control subroutine for reading a
C ReGIS file; it is called from the getgel routine.
C It gets the name of the next ReGIS command and then
C invokes the appropriate processing routine.
subroutine inrgis ( loc )
integer loc
C ## currently unused
integer dollar , dotgel , gel ( 3000 ) , goflo
common / cgelly / dotgel , dollar , gel , goflo
C cram> GIGI "RAM" common
C size of coordinate stack (P,V,C commands)
integer prmtop ( 10 )
C permanent text options
integer wrkwop ( 10 )
C filled in by rdwopt
integer prmwop ( 10 )
C permanent writing options
integer tmpwop ( 10 )
C temporary writing options
integer xpos , ypos
C coordinates of current cursor position
integer xystak ( 10 , 2 )
C coordinate stack (P,V commands)
integer xysp
C coordinate stack pointer
integer cdum
C garbage argument for rdpos
common / cram / prmtop , wrkwop , prmwop , tmpwop , xpos , ypos ,
*xystak , xysp , cdum
C tram> COMMON parameters set by T (text) command
C Note: rmul and cmul conform to the VK100 microcode definitions
C thus the M option is parsed as M[cmul,rmul]
C size of tram vector
logical tspflg
C .true. if [+-xspac,+-yspac] seen
integer tramsv ( 9 )
C tram copied here by T(B); copied back by T(E)
integer tram ( 9 )
C vector that contains all the T-ram stuff
integer rmul , cmul
C row, column multiplier
integer rsize , csize
C row, column size
integer xtchg , ytchg
C xspac and yspac
integer alphab
C alphabet (0 to 3)
integer slant
C italic slant (-45 to +45)
integer trdir
C rotation angle / 45 (0 to 7)
equivalence ( tram ( 1 ) , rmul )
equivalence ( tram ( 2 ) , cmul )
equivalence ( tram ( 3 ) , rsize )
equivalence ( tram ( 4 ) , csize )
equivalence ( tram ( 5 ) , xtchg )
equivalence ( tram ( 6 ) , ytchg )
equivalence ( tram ( 7 ) , alphab )
equivalence ( tram ( 8 ) , slant )
equivalence ( tram ( 9 ) , trdir )
common / trcom / tspflg , tramsv , tram
common / glopts / wrtopt , wrtcrv , wrtlin , wrtbox , wrtcir , wrt
*txt , txtopt , gwopsp , gwop , ttytop
integer wrtopt ( 10 ) , wrtcrv ( 10 ) , wrtlin ( 10 ) , wrtbox ( 1
*0 )
integer wrtcir ( 10 ) , wrttxt ( 10 ) , txtopt ( 6 ) , ttytop ( 6
*)
integer gwop ( 36 ) , gwopsp
C ^ should be Woplen*Maxwops
integer ch , i , ksync , obnest , orgdol , skpbal
integer itop ( 6 )
C initial text options
integer iwop ( 10 )
C initial writing options
data itop ( 1 ) , itop ( 2 ) , itop ( 3 ) , itop ( 4 ) / 0 , 1 , 2
* , 0 /
data itop ( 5 ) , itop ( 6 ) / 0 , 0 /
data iwop ( 1 ) , iwop ( 2 ) , iwop ( 3 ) / 3 , 0 , 255 /
data iwop ( 4 ) , iwop ( 5 ) , iwop ( 6 ) / 2 , 0 , 0 /
data iwop ( 7 ) , iwop ( 8 ) , iwop ( 9 ) / 1 , 0 , 7 /
data iwop ( 10 ) / 0 /
C --- Initialization --- #
orgdol = dollar
C save initial $ for mv2loc
xpos = 0
ypos = 0
C home the cursor
xysp = 0
C clear the XY stack
do 23000 i = 1 , 6
C set dummy values so mrgopt can work
prmtop ( i ) = - 1
23000 continue
23001 continue
do 23002 i = 1 , 10
prmwop ( i ) = - 1
C call copywo(itop,prmtop,Toplen) #copy initial values to perm
C call copywo(iwop,prmwop,Woplen)
23002 continue
23003 continue
call mrgopt ( itop , prmtop , 6 , 255 )
C copy initial values & make gelly
call mrgopt ( iwop , prmwop , 10 , 127 )
call sumopt ( dollar , prmwop , prmtop )
call topram
C convert toptions to T-ram
call copywo ( tram , tramsv , 9 )
C copy T-ram to saved T-ram
call copywo ( prmwop , tmpwop , 10 )
C copy perm wops to temp
goflo = 0
C no gel vector overflow (yet)
call chinit
C init character-handler data
call mgclr
C initialize macrograph storage
C --- Loop to process ReGIS commands --- #
continue
23004 continue
C beginning a new ReGIS command
call mrgopt ( prmwop , tmpwop , 10 , 127 )
C restore permanent wops
C parse command; if the command is unrecognizable, I ignore it
if(.not.( ksync ( 1 ) .eq. ( - 1 ) ))goto 23007
goto 23006
C clear sync-wait, break on Eof
23007 continue
call gnbc ( ch )
C get next non-blank character
if(.not.( ch .eq. 115 ))goto 23009
call cmds
goto 23010
23009 continue
if(.not.( ch .eq. 119 ))goto 23011
call cmdw
goto 23012
23011 continue
if(.not.( ch .eq. 112 ))goto 23013
call cmdp
goto 23014
23013 continue
if(.not.( ch .eq. 118 ))goto 23015
call cmdv
goto 23016
23015 continue
if(.not.( ch .eq. 99 ))goto 23017
call cmdc
goto 23018
23017 continue
if(.not.( ch .eq. 116 ))goto 23019
call cmdt
goto 23020
23019 continue
if(.not.( ch .eq. 108 ))goto 23021
call cmdl
goto 23022
23021 continue
if(.not.( ch .eq. 114 ))goto 23023
call cmdr
C ' " or [ Want to skip this construct like VK100 does
C If skpbal == 1, then quoted string was skipped, so
C call cstrg to process things of the form ;"..."
goto 23024
23023 continue
if(.not.( skpbal ( ch ) .eq. 1 ))goto 23025
call cstrg
23025 continue
23024 continue
23022 continue
23020 continue
23018 continue
23016 continue
23014 continue
23012 continue
23010 continue
C end of ReGIS file encountered; wrap up any open objects
23005 goto 23004
23006 continue
continue
i = obnest ( 3 )
23027 if(.not.(i.gt.0))goto 23029
call gel1 ( 13 )
C the following is not correct if the gelly is not at the end
23028 i=i-1
goto 23027
23029 continue
call copywo ( prmwop , wrtopt , 10 )
call regis
call glowop
C set all these things to resultant modes
call unrgis
C (also sets terminal)
if(.not.( goflo .eq. 0 ))goto 23030
call mv2loc ( loc , orgdol )
C relocate the new gelly
goto 23031
23030 continue
dollar = orgdol
C overflow, delete all new gelly
gel ( dollar ) = 0
23031 continue
end