Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/sm.for
There are no other files named sm.for in the archive.
C sm> Slide Projector ::: Main Program #
C RTA 10/22/80 Add "help" command
C ################################################
C GIGI Slide Projector #
C Rick Ace #
C New York Institiute of Technology #
C April, 1980 #
C ################################################
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
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
call fillsa
C hack to fill string arrays
C initialize ipptr and iuptr (they never change after this)
ipptr = sx ( 2 )
iuptr = sx ( 6 )
C determine if VT52 or ANSI
call lmode ( 1 )
C put VK100 into SC1 mode, no echoing
call dcs ( - 2 )
call pr0 ( 100 )
C who are you? #@100 \033Z
call read1 ( 0 )
if(.not.( sv ( pptr + 1 ) .eq. 91 ))goto 23000
call dcs ( - 4 )
23000 continue
C if [, it's TM1 (ANSI)
call lmode ( 1 )
C init special strings
sv ( sx ( 5 ) ) = 0
C no tray filespec yet
call utty ( 2 )
C no gratuitous crlf's
call dcs ( 5 )
C set VK100 to ANSI (TM1)
call dcs ( - 3 )
call pr2 ( 104 , 767 , 479 )
C @104 w(i7)s(i0,e,a[0,0][%d,%d])
C loop to read and process next command
continue
23002 if(.not.( . true . ))goto 23003
call regis ( 15 )
C restore various ReGIS defaults in VK100
C clear any temporary "show" options
continue
i = 1
23004 if(.not.(i.le.4))goto 23006
dparn ( i ) = 0
C prompt for command and parse it
23005 i=i+1
goto 23004
23006 continue
call prdtty ( 56 )
C @56 Command:\b
cmd = pkey ( 8 )
C @8 00quit^
C 01regis [STRING]^
C 03tray FILESPEC^
C 04display-settings^
C 05edit-tray [FILESPEC]^
C 06print-slides [OPTION]^
C 07show-slides [OPTION]^
C 08clear-screen [COLOR]^
C 09ignore-embedded-commands^
C 10wait-after-showing SECONDS^
C 11identify-slides [LINE#]^
C 12dont OPTION^
C 13help
goto ( 99 , 100 , 1 , 99 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 , 11 , 1
*2 , 13 ) , cmd + 2
C dispatch
99 if(.not.( sv ( pptr ) .ne. 63 ))goto 23007
call pr0 ( 54 )
23007 continue
C parse error
goto 23002
C @54 - type ? for list of commands
100 if(.not.( peol ( 0 ) .eq. 0 ))goto 23009
goto 23003
C quit - check for trash at end
23009 continue
goto 23002
1 call regcmd
C regis [STRING]
goto 23002
C 2 call testfn #test
C next
3 call pskip ( 4 )
C tray FILESPEC
i = pptr
C remember where filespec begins
if(.not.( pflnm ( pptr , 0 , 0 ) .ge. 0 ))goto 23011
C filespec parse ok?
if(.not.( peol ( 0 ) .eq. 0 ))goto 23013
C yes, parse end-of-line
call pflnm ( i , 5 , 13 )
23013 continue
23011 continue
C tray name in SNTFL
goto 23002
4 call dispcm
C display-settings
goto 23002
5 call editcm
C edit-tray [FILESPEC]
goto 23002
6 call showpr ( 1 )
C print-slides [OPTION]
goto 23002
7 call showpr ( 0 )
C show-slides [OPTION]
goto 23002
8 i = 0
C clear-screen [COLOR]
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23015
C color specified?
i = pkey ( 55 )
C yes,parse it
C NOTE: string 55 is used elsewhere!
C @55 00black^01blue^02red^03magenta^04green^05cyan^06yellow^07white
if(.not.( i .lt. 0 ))goto 23017
goto 23002
C skip town if parse failed
23017 continue
23015 continue
if(.not.( peol ( 0 ) .eq. 0 ))goto 23019
C parse ok?
dpar0 ( 1 ) = i
C yup, remember new color
call dcs ( - 3 )
C put VK100 in graphics mode
call pr1 ( 52 , i )
C 52 s(e,i%d) [in sd module]
23019 continue
goto 23002
9 if(.not.( peol ( 0 ) .eq. 0 ))goto 23021
C ignore-embedded-commands
dpar0 ( 2 ) = 1
23021 continue
goto 23002
10 i = pdec ( 0 , 1000 )
C wait-after-showing SECONDS
if(.not.( i .ge. 0 ))goto 23023
if(.not.( peol ( 0 ) .eq. 0 ))goto 23025
C complete parsing
dpar0 ( 3 ) = i
23025 continue
23023 continue
goto 23002
11 i = 24
C identify-slides [LINE#]
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23027
C line# present?
i = pdec ( 1 , 24 )
C yes, parse it
if(.not.( i .lt. 0 ))goto 23029
goto 23002
C check for parse failure
23029 continue
23027 continue
if(.not.( peol ( 0 ) .eq. 0 ))goto 23031
dpar0 ( 4 ) = i
23031 continue
C if eol, install value
goto 23002
12 i = pkey ( 53 )
C dont OPTION
C @53 00clear-screen^
C 01ignore-embedded-commands^
C 02identify-slides
if(.not.( i .ge. 0 ))goto 23033
if(.not.( peol ( 0 ) .eq. 0 ))goto 23035
C complete parsing
if(.not.( i .eq. 0 ))goto 23037
dpar0 ( 1 ) = - 1
23037 continue
23035 continue
23033 continue
C dont clear
if(.not.( i .eq. 1 ))goto 23039
dpar0 ( 2 ) = 0
23039 continue
C dont ignore
if(.not.( i .eq. 2 ))goto 23041
dpar0 ( 4 ) = 0
23041 continue
C dont identify
goto 23002
13 sv ( pptr ) = 63
C help
i = pkey ( 8 )
C fudge a ? to get the menu
goto 23002
goto 23002
23003 continue
call dcs ( - 2 )
call dcs ( 6 )
C restore TMn
call utty ( 1 )
C restore tty modes
end