Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/sd.for
There are no other files named sd.for in the archive.
C sd> Slide display
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches from RATLIB
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 number of string indices
C important string indices (see ss module)
C coord - axis codes
C cpystr - option codes
C dcs - function codes
C ffopen - modes
C ffopen - logical file numbers
C utty - function codes
C codes returned by keypad function
C parameter codes
C screen areas
C column number of text in aea 2
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C legal filename characters are defined in pflnm (sp module)
C colors
C maximum time between slides
C screen dimensions (pixels)
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
block data
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sdcom>
common / sdcom / dpar0 ( 4 ) , dpar1 ( 4 ) , dparn ( 4 )
C permanent parameters
C temporary paramsters
C duration of temporary parameters
data dpar0 ( 1 ) , dpar0 ( 2 ) , dpar0 ( 3 ) / 0 , 0 , 5 /
data dparn ( 1 ) , dparn ( 2 ) , dparn ( 3 ) / 0 , 0 , 0 /
end
C dispcm - process display-settings command
subroutine dispcm
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sdcom>
common / sdcom / dpar0 ( 4 ) , dpar1 ( 4 ) , dparn ( 4 )
C permanent parameters
C temporary paramsters
C duration of temporary parameters
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
if(.not.( peol ( 0 ) .ne. 0 ))goto 23000
return
23000 continue
C check for eol
v = sx ( 58 ) + ( dpar0 ( 1 ) + 1 ) * 7
C get sv index to color
C @58 none black blue red magentagreen cyan yellow white \b
continue
i = 0
23002 if(.not.(i.lt.7))goto 23004
sv ( iuptr + i ) = sv ( v + i )
23003 i=i+1
goto 23002
23004 continue
C copy color to SNUST
sv ( iuptr + 7 ) = 0
C tie it off
call clr ( 1 , - 2 )
call postc ( 0 )
C clear and home cursor
call pr4 ( 59 , 5 , 6 , 50 + dpar0 ( 2 ) , dpar0 ( 3 ) )
C write display
if(.not.( dpar0 ( 4 ) .eq. 0 ))goto 23005
call pr0 ( 119 )
C @119 Don't identify slides
goto 23006
23005 continue
call pr1 ( 130 , dpar0 ( 4 ) )
C @130 Identify slides on line %d
C @59 Tray file: %s\nClear-screen: %s\n%s embedded commands\nWait %d seconds\n
C @50 Process
C @51 Ignore
23006 continue
end
C dpar - returns permanent or temporary requested display parameter
C par: parameter code (DPxxx)
integer function dpar ( par )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sdcom>
common / sdcom / dpar0 ( 4 ) , dpar1 ( 4 ) , dparn ( 4 )
C permanent parameters
C temporary paramsters
C duration of temporary parameters
n = dparn ( par )
C get duration
dpar = dpar0 ( par )
C assume permanent
if(.not.( n .gt. 0 ))goto 23007
dpar = dpar1 ( par )
23007 continue
C wrong, want temporary
dparn ( par ) = n - 1
C count down temp duration
end
C embcmd - process embedded commands in tray file
C embedded command in SNUST, form is: +COMMAND
C returns 0: success; -1: failed, diagnostic typed
C -2: same as -1, but tray file is not open
integer function embcmd ( dum )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sdcom>
common / sdcom / dpar0 ( 4 ) , dpar1 ( 4 ) , dparn ( 4 )
C permanent parameters
C temporary paramsters
C duration of temporary parameters
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
embcmd = 0
C assume success
if(.not.( dpar ( 2 ) .ne. 0 ))goto 23009
return
23009 continue
C ignore if requested
call ustpar
C copy comamnd to SNINP
pptr = pptr + 1
C skip past "+"
goto ( 99 , 100 , 101 , 102 , 103 , 104 ) , pkey ( 91 ) + 2
C parse command
C @91 00chain^
C 01goto^
C 02next^
C 03pause^
C 04stop
C chain FILESPEC [SLIDE]
100 call pskip ( 4 )
C skip blanks
i = pptr
C remember where filespec begins
if(.not.( pflnm ( pptr , 0 , 0 ) .lt. 0 ))goto 23011
goto 99
23011 continue
C parse filespec
tag = 1
C assume no SLIDE
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23013
C SLIDE present?
tag = ptagob ( 0 , 11 )
C yes, parse it
if(.not.( tag .lt. 0 ))goto 23015
goto 99
23015 continue
C check for error
if(.not.( peol ( 0 ) .ne. 0 ))goto 23017
goto 99
23017 continue
C parse eol
23013 continue
call ffcls ( 1 )
C close current tray
call pflnm ( i , 5 , 13 )
C get new tray filespec in SNTFL
if(.not.( ffopen ( 1 , 5 , 0 ) .ne. 0 ))goto 23019
C can I open it?
call pdiag1 ( 86 , 5 )
C no, tell user
embcmd = - 2
C error code, tray not open
return
23019 continue
goto 1011
C now seek to specified place
C goto SLIDE
101 tag = ptagob ( 0 , 11 )
C parse tag/line#
if(.not.( tag .lt. 0 ))goto 23021
goto 99
23021 continue
C failed
if(.not.( peol ( 0 ) .ne. 0 ))goto 23023
goto 99
23023 continue
C parse eol
1011 if(.not.( tag .gt. 0 ))goto 23025
C record number or tag?
tag = tag - 1
C record number
if(.not.( tag .eq. 0 ))goto 23027
call ffrew ( 1 )
goto 23028
23027 continue
i = ffread ( 1 , tag )
23028 continue
goto 23026
23025 continue
if(.not.( tagluk ( 11 ) .lt. 0 ))goto 23029
goto 99
23029 continue
C tag
23026 continue
return
C next N SETTING [SETTING ... ]
102 n = pdec ( 0 , 1000 )
C parse N
if(.not.( n .lt. 0 ))goto 23031
goto 99
23031 continue
C check for failure
nnclr = - 2
nnwat = - 1
C unspecified so far
continue
23033 if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23034
C scan SETTINGs
i = pkey ( 109 )
C @109 00clear-screen COLOR^
C 01dont-clear-screen^
C 02wait-after-showing SECONDS
goto ( 99 , 1020 , 1021 , 1022 ) , i + 2
C clear-screen COLOR
1020 nnclr = pkey ( 55 )
C parse COLOR
if(.not.( nnclr .lt. 0 ))goto 23035
goto 99
23035 continue
goto 23033
C dont-clear-screen
1021 nnclr = - 1
goto 23033
1022 nnwat = pdec ( 0 , 1000 )
C parse SECONDS
if(.not.( nnwat .lt. 0 ))goto 23037
goto 99
23037 continue
goto 23033
C command line parsed ok, now install values in dpar tables
goto 23033
23034 continue
if(.not.( nnclr .ne. - 2 ))goto 23039
dparn ( 1 ) = n
dpar1 ( 1 ) = nnclr
23039 continue
if(.not.( nnwat .ge. 0 ))goto 23041
dparn ( 3 ) = n
dpar1 ( 3 ) = nnwat
23041 continue
return
C pause [SECONDS]
103 if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23043
C arg present?
call postc ( 80 * 22 )
C no, display cursor
call read1 ( 0 )
C read CR
return
23043 continue
i = pdec ( 1 , 1000 )
C parse # of seconds to wait
if(.not.( i .lt. 0 ))goto 23045
goto 99
23045 continue
C check for error
if(.not.( peol ( 0 ) .ne. 0 ))goto 23047
goto 99
23047 continue
C parse eol
call waitx ( i )
C wait specified # of seconds
return
C stop
104 i = peol ( 0 )
C give diagnostic if not eol
goto 99
C PARSE ERROR
99 embcmd = - 1
C return failure
end
C optray - open tray file, getting its name if I don't know it yet
C nonly: if non-zero, just get name
C returns: 0 successful, lfn = LFTRAY
C -1 failed
integer function optray ( nonly )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
optray = - 1
C assume failure
if(.not.( sv ( sx ( 5 ) ) .eq. 0 ))goto 23049
C have name?
continue
23051 if(.not.( . true . ))goto 23052
C no
call prdtty ( 72 )
C @72 Tray file name:\b
if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23053
return
23053 continue
C not talking, huh?
i = pptr
C remember where filespec begins
C parse filespec and eol, and break if successful
if(.not.( pflnm ( pptr , 0 , 0 ) .ge. 0 ))goto 23055
if(.not.( peol ( 0 ) .eq. 0 ))goto 23057
goto 23052
23057 continue
23055 continue
C bad parse, ask again
goto 23051
23052 continue
call pflnm ( i , 5 , 13 )
C get tray filespec in SNTFL
C check for name-only
23049 continue
if(.not.( nonly .ne. 0 ))goto 23059
optray = 0
C name-only, done
return
C open the file
23059 continue
if(.not.( ffopen ( 1 , 5 , 0 ) .eq. 0 ))goto 23061
optray = 0
goto 23062
23061 continue
call pdiag1 ( 116 , 5 )
23062 continue
C @116 Cannot read file: %s
end
C rectyp - classify record in tray file by its first character
C svp: index into sv of first character of record
C returns: first character of record if it is one of the special
C record types, else 0 (meaning slide file name)
integer function rectyp ( svp )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
integer ch
rectyp = 0
C assume slide-file record
ch = sv ( svp )
C get 1st character of record
if(.not.( ch .eq. 43 .or. ch .eq. 58 .or. ch .eq. 42 ))goto 2306
*3
C check embedded command
C check tag
rectyp = ch
23063 continue
C check comment
end
C shoman - show current tray in manual mode
C resumf: if non-zero, resume from where user last left off
subroutine shoman ( resumf )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C spcom>
logical diagf , filcmd
common / spcom / diagf , filcmd , hline , lcx , lcy
C true iff diagnostic has been given already
C command came from tty (.false.) or file (.true.)
C current line # for help message (0-23)
C locator-mode coordinates returned by VK100
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
data rec / 0 /
if(.not.( optray ( 0 ) .ne. 0 ))goto 23065
return
23065 continue
C open tray file
if(.not.( resumf .eq. 0 ))goto 23067
rec = 0
23067 continue
C current tray file record #
call lmode ( 74 )
C @74 Manual mode - use keypad
continue
23069 if(.not.( . true . ))goto 23070
C get commands
call dcs ( 9 )
C show text-mode cursor
call read1 ( 0 )
C read command (echoes off)
if(.not.( diagf ))goto 23071
call dcs ( 4 )
diagf = . false .
C erase diag
23071 continue
n = 1
C set up n for arrow keys
cmd = keypad ( 0 )
C check it out
goto ( 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 , 9 ,
* 14 , 15 , 15 , 17 , 9 , 9 , 20 , 21 , 20 ) , cmd + 2
9 call pdiag ( 76 )
C @76 Unrecognized comamnd
goto 23069
C GOTO
14 call lmode ( 1 )
C echoes on, etc.
continue
23073 if(.not.( . true . ))goto 23074
C loop until legal response
call prdtty ( 78 )
C @78 Tag or slide number:\b
if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23075
C empty line?
n = 0
C yes, user gave up
goto 23074
C exit loop
23075 continue
i = ptagob ( 0 , 11 )
C parse tag or rec#
if(.not.( i .lt. 0 ))goto 23077
goto 23073
23077 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23079
goto 23073
23079 continue
if(.not.( i .ne. 0 ))goto 23081
C it's a record #
i1 = ffread ( 1 , i )
C get record
if(.not.( i1 .eq. 0 ))goto 23083
C eof
call pdiag1 ( 79 , i )
C @79 Slide %d beyond end of tray
goto 23073
C try it again
23083 continue
goto 23082
23081 continue
i = tagluk ( 11 )
C it's a tag
if(.not.( i .le. 0 ))goto 23085
goto 23073
C can't find that tag
23085 continue
23082 continue
rec = i - 1
C set record #
goto 23074
C whoopee
goto 23073
23074 continue
call lmode ( 1 )
C echoes off again
call dcs ( 3 )
C erase prompt
if(.not.( n .ne. 0 ))goto 23087
goto 20
23087 continue
C show line
goto 23069
C or user gave up
C ADVANCE, BACK-UP
15 call lmode ( 1 )
C echoes on, etc.
continue
23089 if(.not.( . true . ))goto 23090
C loop until legal response
call prdtty ( 81 + cmd - 15 )
C prompt
C @81 How many slides to advance?\b
C @82 How many slides to back up?\b
if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23091
C empty line?
n = 0
C yes, user gave up
goto 23090
C exit loop
23091 continue
n = pdec ( 1 , 1000 )
C parse number
if(.not.( n .gt. 0 ))goto 23093
if(.not.( peol ( 0 ) .eq. 0 ))goto 23095
goto 23090
23095 continue
23093 continue
goto 23089
23090 continue
call lmode ( 1 )
C echoes off again
call dcs ( 3 )
C erase prompt
if(.not.( n .gt. 0 ))goto 23097
goto ( 20 , 21 ) , cmd - 15 + 1
23097 continue
C go do the work
goto 23069
C or user gave up
C RIGHT ARROW
20 continue
23099 continue
C skip forward n slides
i = ffread ( 1 , rec + 1 )
C next tray record
if(.not.( i .eq. 0 ))goto 23102
C oops, end of file
call pdiag ( 77 )
C @77 End of tray reached
goto 23101
C get out of loop
23102 continue
rec = i
C remember current record
c = rectyp ( iuptr )
C get 1st char of record
C don't count non-slides
if(.not.( c .eq. 0 ))goto 23104
n = n - 1
23104 continue
23100 if(.not.( n .le. 0 ))goto 23099
23101 continue
if(.not.( i .ne. 0 ))goto 23106
call tray1 ( 0 )
23106 continue
C show slide if not @ eof
goto 23069
C LEFT ARROW
21 continue
23108 continue
C loop spec # of times
rec = rec - 1
C previous record
if(.not.( rec .le. 0 ))goto 23111
C hit bof?
call pdiag ( 80 )
C @80 Beginning of tray reached
goto 23110
C yup
23111 continue
i = ffread ( 1 , rec )
C read record
c = rectyp ( iuptr )
C get 1st char of record
C don't count non-slides
if(.not.( c .eq. 0 ))goto 23113
n = n - 1
23113 continue
23109 if(.not.( n .le. 0 ))goto 23108
23110 continue
C loop if more to go
if(.not.( rec .gt. 0 ))goto 23115
call tray1 ( 0 )
23115 continue
C display if not at bof
goto 23069
goto 23069
23070 continue
17 call lmode ( 1 )
C restore normal tty stuff
call ffcls ( 1 )
C close the tray file
end
C show1 - show 1 slide
C fil: string containing slide file name
C obj: string # of string containing object name, or 0 for entire file
C returns 0 if successful
C -1 if slide file can't be opened
C -2 if object can't be found
C in the failing cases, a diagnostic message is typed
integer function show1 ( fil , obj )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
integer nest , s
logical ofound
C string 112 accumulates an object name from the slide file
C @112 xxxxxxxxxxx
if(.not.( ffopen ( 2 , fil , 1 ) .ne. 0 ))goto 23117
C open slide file
call pdiag1 ( 70 , fil )
C @70 Cannot access slide file: %s
show1 = - 1
C failure code
return
23117 continue
call dcs ( - 3 )
C VK100 in graphics mode
i = dpar ( 1 )
C have to clear screen?
if(.not.( i .ge. 0 ))goto 23119
call pr1 ( 52 , i )
C yes #@52 s(e,i%d)
C NOTE: string 52 used elsewhere
C Welcome to the Machine
C The following "while" loop scans the slide file looking for
C object boundaries and sending the requested parts of the
C slide file to the terminal.
C nest is nesting level of objects
C if nest > 0, characters are output to the terminal
23119 continue
nest = 0
if(.not.( obj .eq. 0 ))goto 23121
nest = 1
23121 continue
ofound = . false .
C object not found yet
s = 1
C set initial state
c = 0
C stuff to catch altmodes
continue
23123 if(.not.( . true . ))goto 23124
C loop once per char
c0 = c
C remember previous char
c = ffgc ( 2 )
C get char from file
if(.not.( c .lt. 0 ))goto 23125
goto 23124
C if eof, exit loop
23125 continue
if(.not.( c .eq. 27 ))goto 23127
goto 23123
C discard altmodes
23127 continue
if(.not.( c0 .eq. 27 ))goto 23129
C prev char = Altmode?
if(.not.( c .eq. 80 ))goto 23131
C yes, $Px ?
c = ffgc ( 2 )
C yes, get x
if(.not.( c .lt. 0 ))goto 23133
goto 23124
C eof chk
23133 continue
23131 continue
goto 23123
C discard $Px or $x
23129 continue
if(.not.( nest .gt. 0 ))goto 23135
call putc ( c )
23135 continue
C write char to tty
goto ( 401 , 402 , 403 , 404 , 405 , 406 ) , s
C dispatch from state
C normal state
401 if(.not.( obj .ne. 0 .and. c .eq. 59 ))goto 23137
s = 2
23137 continue
C check for ;
goto 23123
C last character was ;
402 if(.not.( c .eq. 34 ))goto 23139
s = 3
C check for ;"
goto 23140
23139 continue
s = 1
23140 continue
goto 23123
C have seen ;"
403 if(.not.( c .eq. 58 ))goto 23141
C is it ;": ?
s = 4
C yes, set new state
fop = sx ( 112 )
C build object name here
fol = 0
C init length of object
goto 23142
23141 continue
if(.not.( c .eq. 125 ))goto 23143
s = 6
C check for ;"}
goto 23144
23143 continue
s = 1
23144 continue
C not ;": or ;"}
23142 continue
goto 23123
C accumulating object name
404 sv ( fop ) = c
C copy char to object str
i = ctype ( fop )
C classify character
s = 1
C assume some badness
if(.not.( fol .eq. 0 .and. i .ne. 1 ))goto 23145
goto 23123
C must begin w/ alpha
23145 continue
if(.not.( iand ( i , 1 + 2 ) .ne. 0 ))goto 23147
C object character?
fop = fop + 1
C yes, bump string ptr
fol = fol + 1
C count it
if(.not.( fol .le. 10 ))goto 23149
s = 4
23149 continue
C chk if too long
goto 23123
23147 continue
sv ( fop ) = 0
C end of objname, tie off
if(.not.( c .eq. 123 ))goto 23151
s = 5
23151 continue
C check for {
goto 23123
C have seen ;":objectname{
405 s = 1
if(.not.( c .ne. 34 ))goto 23153
goto 23123
C check for "
C check if this is the object I'm looking for
23153 continue
i = cmpstr ( obj , 112 )
C match caller's object?
if(.not.( i .eq. 0 ))goto 23155
ofound = . true .
23155 continue
C if yes, remember it
if(.not.( nest .gt. 0 .or. i .eq. 0 ))goto 23157
nest = nest + 1
23157 continue
goto 23123
C have seen ;"}
406 s = 1
C new state
if(.not.( c .eq. 34 .and. nest .gt. 0 ))goto 23159
nest = nest - 1
23159 continue
C unnest
goto 23123
goto 23123
23124 continue
call ffcls ( 2 )
C close slide file
show1 = 0
C success
if(.not.( obj .ne. 0 .and. . not . ofound ))goto 23161
C object seen?
call pdiag1 ( 111 , obj )
C @111 Object "%s" not found in slide file\b
call pr0 ( fil )
C no, tell user
show1 = - 2
C return error
goto 23162
23161 continue
C show the slide name if the user requested it
i = dpar ( 4 )
C get identify control
if(.not.( i .gt. 0 ))goto 23163
C want slide names?
call dcs ( - 2 )
C VK100 in text mode
call pr2 ( 117 , i , fil )
C yes #@117 \033[%d;1HFile: %s
if(.not.( obj .ne. 0 ))goto 23165
call pr1 ( 118 , obj )
23165 continue
C @118 Object: %s
call dcs ( - 3 )
C discard cursor
23163 continue
23162 continue
end
C showpr - process "print-slides" and "show-slides" commands
C pr: 0 for show, 1 for print
subroutine showpr ( pr )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
from = 1
to = 32767
C set up defaults
opt = - 1
C assume no options
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23167
C option present?
opt = pkey ( 67 )
C @67 00manual [resume]^
C 01range [FROM] [-TO]^
C 02slide FILESPEC [OBJECT]
goto ( 99 , 100 , 101 , 102 ) , opt + 2
C dispatch
99 return
C bad parse
100 resumf = 0
C manual [resume]
if(.not.( pskip ( 4 ) .eq. 1 ))goto 23169
resumf = 1
call pskip ( 1 )
C skip past "resume"
23169 continue
goto 199
101 if(.not.( pskip ( 4 ) .ne. 16 ))goto 23171
C "from" present?
from = ptagob ( 0 , 11 )
C yes, parse it
if(.not.( from .lt. 0 ))goto 23173
return
23173 continue
23171 continue
if(.not.( pskip ( 4 ) .eq. 16 ))goto 23175
C "to" present?
pptr = pptr + 1
C yes, skip hyphen
to = ptagob ( 0 , 12 )
C parse "to"
if(.not.( to .lt. 0 ))goto 23177
return
23177 continue
23175 continue
goto 199
102 call pskip ( 4 )
C skip blanks
if(.not.( pflnm ( pptr , 9 , 14 ) .lt. 0 ))goto 23179
return
23179 continue
C parse filespec
obj = 0
C assume no object
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23181
C ahh, but there is!
if(.not.( ptagob ( 1 , 10 ) .lt. 0 ))goto 23183
return
23183 continue
C parse object
obj = 10
C remember obj exists
23181 continue
goto 199
199 continue
23167 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23185
return
C check for trash at end
C parsing complete
23185 continue
if(.not.( opt .eq. 2 ))goto 23187
C slide FILESPEC [OBJECT]
if(.not.( show1 ( 9 , obj ) .eq. 0 ))goto 23189
C show requested slide
if(.not.( pr .ne. 0 ))goto 23191
call dcs ( 10 )
C hard-copy if requested
goto 23192
23191 continue
call dcs ( 9 )
call read1 ( 0 )
C else wait
23192 continue
23189 continue
return
C manual mode
23187 continue
if(.not.( opt .eq. 0 ))goto 23193
call shoman ( resumf )
return
C automatic mode
23193 continue
if(.not.( optray ( 0 ) .ne. 0 ))goto 23195
return
C open tray file
C look up "from" and "to" tags if necessary
23195 continue
if(.not.( from .eq. 0 ))goto 23197
from = tagluk ( 11 )
23197 continue
C look up "from" tag
if(.not.( from .lt. 0 ))goto 23199
goto 800
23199 continue
C not found
if(.not.( to .eq. 0 ))goto 23201
to = tagluk ( 12 )
23201 continue
C look up "to" tag
if(.not.( to .lt. 0 ))goto 23203
goto 800
23203 continue
C not found
if(.not.( from .gt. to ))goto 23205
C from after to?
call pdiag ( 71 )
C yes #@71 "TO" comes before "FROM"
goto 800
C show the slides, looping once per tray file record
23205 continue
continue
23207 continue
i = ffread ( 1 , from )
C get next record from tray
if(.not.( i .eq. 0 .or. i .gt. to ))goto 23210
goto 23209
C exit if at eof or past "to"
23210 continue
from = 0
C read the rest sequentially
c = rectyp ( iuptr )
C get type of record
C i will be set to 0 to continue showing, or non-0 to stop
i = 0
C assume successful processing
if(.not.( c .eq. 43 ))goto 23212
C embedded command?
i = embcmd ( 0 )
C yes, process it
if(.not.( i .eq. - 2 ))goto 23214
return
23214 continue
C exit if chain error
23212 continue
if(.not.( c .eq. 0 ))goto 23216
C is it FILESPEC [OBJECT] ?
i = tray1 ( 1 - pr )
C yes
if(.not.( i .eq. 0 .and. pr .ne. 0 ))goto 23218
call dcs ( 10 )
23218 continue
C get hard copy if wanted
23216 continue
23208 if(.not.( i .ne. 0 ))goto 23207
23209 continue
800 call ffcls ( 1 )
C done, close tray file
end
C tagluk - look up tag in tray file
C sno: string # of string containing tag to be looked for
C returns: -1 tag not found, else record # of tag
integer function tagluk ( sno )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
sp = sx ( sno ) - 1
C sv index to caller's tag
call ffrew ( 1 )
C rewind tray file
continue
23220 if(.not.( . true . ))goto 23221
i = ffread ( 1 , 0 )
C get record in SNUST
if(.not.( i .eq. 0 ))goto 23222
C eof, failed
call pdiag1 ( 73 , sno )
C @73 Tag not found: %s
tagluk = - 1
C error return
return
23222 continue
if(.not.( sv ( iuptr ) .eq. 58 ))goto 23224
C is it a tag?
tagluk = i
C yes, set value in case I win
i = 1
continue
23226 if(.not.( sv ( iuptr + i ) .eq. sv ( sp + i ) ))goto 23227
C compare
if(.not.( sv ( iuptr + i ) .eq. 0 ))goto 23228
return
23228 continue
C found a match
i = i + 1
C compare next 2 characters
goto 23226
23227 continue
C not tag or no match
23224 continue
C go get next record
goto 23220
23221 continue
end
C tray1 - process tray record to show filespec
C record in SNUST, form is: FILESPEC [OBJECT]
C delay: nonzero to wait after showing
C returns 0: success; -1: failed, diagnostic typed
integer function tray1 ( delay )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
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 subscript is string #, contains index into sv
tray1 = - 1
C assume failed
call ustpar
C prepare for parsing
call pskip ( 4 )
C skip blanks
if(.not.( pflnm ( pptr , 9 , 14 ) .lt. 0 ))goto 23230
return
23230 continue
C parse filespec
obj = 0
C assume no object
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23232
C object there?
i = ptagob ( 1 , 10 )
C yes, parse it
if(.not.( i .lt. 0 ))goto 23234
return
23234 continue
C parse failed
obj = 10
C ok, remember object present
23232 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23236
return
23236 continue
C check for trash at eol
if(.not.( show1 ( 9 , obj ) .eq. 0 ))goto 23238
C show the slide
tray1 = 0
if(.not.( delay .ne. 0 ))goto 23240
call waitx ( dpar ( 3 ) )
23240 continue
C wait after showing
23238 continue
end