Trailing-Edge
-
PDP-10 Archives
-
BB-K818A-BM_1981
-
sources/geiop.for
There are no other files named geiop.for in the archive.
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C geiop -- graphics editor I/O primitives
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 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 ========== Ratfor character definitions ==========
C 9-FEB-79
C 12-MAY-80
C ampersand
C exclamation mark
C ASCIZ strings as used by SYSLIB
C max element count in packed char array
C input record size
C must be 2 more than MAXRECORD
C alternative to YES, NO
C a linefeed
C for OPENF calls
C "
C "
C "
C char i/o format: "r1" for TOPS-20; "a1" otherwise
C quoted string version of above
C first char for single space with LIST carriagecontrol:
C ' ' for RSTS, nothing for VMS
C ascii numeric value corresponding to LISTSS, above
C if "#", omit packed string code for this machine
C 5 for TOPS-20, 1 otherwise
C if "#", omit TOPS20 code
C include logdef
C ttsout -- send a line to the terminal -- added by RJF for VMS & RSTS
C first arg is string to send,
C second arg is int that if non-zero means add a CRLF at end
C subroutine ttsout (string, crlff)
C character string(ARB)
C integer crlff
C DEBUG include logcom
C integer len
C character crlf(3)
C integer strt
C data crlf /CR,LF,0/
C len = length (string)
C DEBUG LOGSTAR 'ttsout>', crlff, len
C # DEBUG call putarg (string)
C strt = 1
C while (strt <= len)
C { for (i=strt ; i <= len & (string(i)&\177) != LF ; i=i+1)
C ;
C call putln (string(strt), i-strt)
C DEBUG LOGIF call putxxx (string(strt), i-strt)
C if (i <= len)
C { call putln(CR, 1)
C call putln(LF, 1)
C DEBUG LOGIF call putxxx(CR, 1)
C DEBUG LOGIF call putxxx(LF,1)
C }
C strt = i + 1
C }
C if (crlff != 0)
C { call putln (crlf, 2)
C DEBUG LOGIF call putxxx (crlf, 2)
C }
C return
C end
C utty -- set terminal modes, for VMS & RSTS only
C subroutine utty(arg)
C integer arg
C include ttecho
C DEBUG include logcom
C DEBUG call logini
C DEBUG LOGSTAR 'utty>', arg
C DEBUG LOGSTAR
C echosw = (arg != 4)
C call putln (0,0) #force completion of i/o (VMS)
C DEBUG LOGIF call putxxx (0,0)
C end
C putarg - dump a string argument in several ways
C subroutine putarg (str)
C character str(ARB)
C include logcom
C call logini
C LOGIF
C {
C ln = min (length(str), 500)
C for (i=1; i<=ln; i=i+1)
C if (str(i) < 0 | str(i) > \777) break
C if (i <= ln)
C write (LOGTTOUT,110) (str(i), i=1, ln+1)
C else
C write (LOGTTOUT,100) (str(i), i=1, ln+1)
C 100 format (' ', 20 o4)
C 110 format (' ', 8 o8)
C write (LOGTTOUT,200) (str(i), i=1, ln)
C write (LOGTTOUT,200)
C 200 format (' ', 80 CHARFORMAT)
C }
C end
C getlin -- get a line from the terminal -- for VMS & RSTS
C integer function getlin (prompt,inbuf,maxc)
C implicit integer (a-z)
C character prompt(ARB), inbuf(ARB)
C integer maxc
C integer max, strt, len, scopy
C include ttecho
C DEBUG include logcom
C DEBUG call logini
C call flusho
C i = length(prompt)
C DEBUG LOGSTAR 'getlin>', i, maxc
C if (i > 0)
C {DEBUG call putarg(prompt)
C call putln (prompt, i)
C DEBUG LOGIF call putxxx (prompt, i)
C }
C max = maxc - 1
C strt = 1
C repeat
C { if (echosw)
C len = getlnec (inbuf(strt), max)
C else
C len = getlnne (inbuf(strt), max)
C max = max - len
C strt = strt + len
C }
C until (max < 1 | inbuf(strt-1) == CR)
C inbuf(strt) = EOS
C getlin = strt - 1
C DEBUG call putarg (inbuf)
C if (inbuf(1) == LF) # remove leading LF
C getlin = scopy (inbuf(2), inbuf(1))
C do i=1, getlin
C { if (inbuf(i) == CR)
C inbuf(i) = LF
C }
C DEBUG call putarg (inbuf)
C return
C end
C logini -- initialize logging output
C subroutine logini
C logical openf
C include logcom
C stringdcl logctl GELOG.CTL
C stringdcl logfil GE.LOG
C logical first
C data first /.true./
C stringdata logctl GELOG.CTL
C stringdata logfil GE.LOG
C if (first)
C { logsw = .false.
C if (openf (LOGTTOUT, logctl, READONLYFILE))
C { read (LOGTTOUT, *) logsw
C close (unit=LOGTTOUT)
C }
C first = .false.
C LOGIF if (!openf (LOGTTOUT, logfil, NEWFILE+FORTRANCC))
C stop 'GE -- cannot open log file'
C DEBUG LOGIF if (!openf (REPLAYLUN, 'GEREPLAY.LOG', NEWFILE))
C DEBUG stop 'GE -- cannot open replay file'
C }
C return
C end
C DEBUG # putxxx - put terminal output to "instant replay" file
C DEBUG subroutine putxxx (str, len) # same arguments as "putln"
C DEBUG character str(ARB)
C DEBUG integer len
C DEBUG character buf(REPLAYBUFMAX)
C DEBUG integer bufptr, strptr
C DEBUG data bufptr /1/
C DEBUG strptr = 1
C DEBUG repeat
C DEBUG {
C DEBUG for (; bufptr < REPLAYBUFMAX & strptr <= len
C DEBUG & str(strptr) != CR; strptr=strptr+1)
C DEBUG { if (str(strptr) != LF)
C DEBUG { buf(bufptr) = str(strptr)
C DEBUG bufptr = bufptr + 1
C DEBUG }
C DEBUG }
C DEBUG if (bufptr >= REPLAYBUFMAX | str(strptr) == CR | (len == 0 & bufptr > 1))
C DEBUG { buf(bufptr) = EOS
C DEBUG call putstr (REPLAYLUN, buf, LISTSSV)
C DEBUG bufptr = 1
C DEBUG strptr = strptr + 1
C DEBUG }
C DEBUG }
C DEBUG until (strptr >= len)
C DEBUG return
C DEBUG end
C block data
block data
C include logcom
C include ttecho
C data logsw /.true./
C data echosw /.true./
end