!   "SLIST" -- SOURCE LISTER PROGRAM
!   PRINTS BIG BANNER HEADLINES, FOLLOWED BY SOURCE LISTING...
!   TO OUTPUT DEVICE (DEFAULT = :LPT) OF ONE'S CHOICE.
!
!   INVOCATION FORMAT:
!       .SLIST file ["title"][options][TO device:][/WIDTH=nnn][/DEPTH=nnn]
!   or
!       .SLIST @file [TO device:][/WIDTH=nnn][/DEPTH=nnn]
!   or
!       .SLIST "title" [/WIDTH=nnn][/DEPTH=nnn]
!   or
!       .SLIST
!
!   If the '@' is not present, the file is presumed to contain the listing.
!   If '@' is present, file contains a LIST of files to be printed this way.
!   If SLIST is invoked all by itself, it will converse with the operator.
!
!   The optional title will be printed instead of the filename, if supplied.
!
!   Options are "switch" format signals specifying that SLIST is to perform
!   some optional processing.  These switches are individually set and
!   reset for each file listed, and can be attached to file names in
!   an "at" file.  Currently defined switches are:
!        /P{aginate}           Causes Pagination of Source file
!                              This means that each printed page is titled
!                              with the name of the file (prefix is dropped),
!                              the creation date of the file, the current
!                              time, and source form and page number info.
!                              Each line from the source file is numbered
!                              and followed by a Bar character to seperate
!                              the numbering from the source text.
!                              The characters ^L, if found in a source line
!                              in columns 2 and 3, or columns 3 and 4,
!                              cause a page throw.  The rest of that source
!                              line is NOT listed. The 1st (two) characters
!                              are ignored to allow a language specific comment
!                              to precede the ^L.
!
!        /O{override}          Supresses automatic processing determined by
!                              the file extension.
!
!   SLIST knows about several kinds of file extensions.  Each extension
!   causes certain automatic processing to take place, as a convenience.
!   The processing is extension-specific. Any file whose name is of
!   the form "xxxxx.LPT" is simply printed as is, as are all files whose
!   extension type is not known to SLIST.
!
!   Files whose name is "xxxxx.BAS", "xxxxx.ASM", "xxxxx.DO"
!   are automatically paginated.
!
!
!   /WIDTH=xxx specifies an over-ride width.
!   /DEPTH=xxx specifies and over-ride depth.
!
!   Revision History:
!       TITLE3.BAS,FLIST.BAS  ~~1981
!            Primitive versions
!       SLIST 1.0  4/26/82
!            Merged TITLE3.BAS,FLIST.BAS together.
!            Modified to match SLIST spec, above.
!            Added defense against banner characters not in ALF$
!            Released with 6809 SDOS
!       SLIST 1.1a 12/1/83 (RCW)
!            Add printer interlock code, like MTPRINT.BAS
!            Add code to handle .DO as paginate case
!            Fixed for uppercasing files to print so extension/paginate
!            works
!

!^L

    DIM Version$/"SLIST 1.1a"/

!   SYSCALL:INTERLOCK = :1B

    DIM INTERLOCKCREATE$/:1B,14,00,00/,INTERLOCKRESET$/:1B,14,00,02/
    DIM INTERLOCKTEST$/:1B,14,00,05/,INTERLOCKRELEASE$/:1B,14,00,4/
    DIM INTERLOCKID$(16),DONTASK$/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/
    DIM PRINTILKFILE$/"PRINT.INTERLOCK"/,PTFILE/4/

    DIM ALF$/"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.$/:-"/
    DIM MESSAGE$[100],MAGNIFICATION/1/
    DIM BANNER$[132]
    DIM FORM$/:C/,OP$[200],OPP
    DIM SPACES$/"                 "/
    DIM LISTFILE$(132),OUTPUTFILE$(50),ATFILE$(50)
    DIM PATHNAMEPREFIX$(50),EXTENSION$(4)
    DIM LINE$[132],LINE1$(16)
    DIM FILEDATE$(8),TEMP$(10)
    DIM OUTFILE/1/,INFILE/2/,ATFILE/3/
    DIM PAGEWIDTH/-1/,PAGEDEPTH/-1/,PAGEGAP/8/
    DIM SCGETTYPE$/:F,14,0,4/,SCGETPARAMS$/:F,14,0,5/
    DIM SCGETFILEDATE$/:F,14,0,:10/
    DIM CHARACTERPICTURES$/...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&...
&       " AAA ",...
&       "A   A",...
&       "A   A",...
&       "AAAAA",...
&       "A   A",...
&       "A   A",...
&       "A   A",...
&...
&       "BBBB ",...
&       "B   B",...
&       "B   B",...
&       "BBBB ",...
&       "B   B",...
&       "B   B",...
&       "BBBB ",...
&...
&       " CCC ",...
&       "C   C",...
&       "C    ",...
&       "C    ",...
&       "C    ",...
&       "C   C",...
&       " CCC ",...
&...
&       "DDDD ",...
&       "D   D",...
&       "D   D",...
&       "D   D",...
&       "D   D",...
&       "D   D",...
&       "DDDD ",...
&...
&       "EEEEE",...
&       "E    ",...
&       "E    ",...
&       "EEEEE",...
&       "E    ",...
&       "E    ",...
&       "EEEEE",...
&...
&       "FFFFF",...
&       "F    ",...
&       "F    ",...
&       "FFFFF",...
&       "F    ",...
&       "F    ",...
&       "F    ",...
&...
&       " GGGG",...
&       "G    ",...
&       "G    ",...
&       "G    ",...
&       "G GGG",...
&       "G   G",...
&       " GGGG",...
&...
&       "H   H",...
&       "H   H",...
&       "H   H",...
&       "HHHHH",...
&       "H   H",...
&       "H   H",...
&       "H   H",...
&...
&       "IIIII",...
&       "  I  ",...
&       "  I  ",...
&       "  I  ",...
&       "  I  ",...
&       "  I  ",...
&       "IIIII",...
&...
&       "    J",...
&       "    J",...
&       "    J",...
&       "    J",...
&       "    J",...
&       "J   J",...
&       " JJJ ",...
&...
&       "K   K",...
&       "K  K ",...
&       "K K  ",...
&       "KK   ",...
&       "K K  ",...
&       "K  K ",...
&       "K   K",...
&...
&       "L    ",...
&       "L    ",...
&       "L    ",...
&       "L    ",...
&       "L    ",...
&       "L    ",...
&       "LLLLL",...
&...
&       "M   M",...
&       "MM MM",...
&       "M M M",...
&       "M M M",...
&       "M   M",...
&       "M   M",...
&       "M   M",...
&...
&       "N   N",...
&       "NN  N",...
&       "N N N",...
&       "N N N",...
&       "N N N",...
&       "N  NN",...
&       "N   N",...
&...
&       " OOO ",...
&       "O   O",...
&       "O   O",...
&       "O   O",...
&       "O   O",...
&       "O   O",...
&       " OOO ",...
&...
&       "PPPP ",...
&       "P   P",...
&       "P   P",...
&       "PPPP ",...
&       "P    ",...
&       "P    ",...
&       "P    ",...
&...
&       " QQQ ",...
&       "Q   Q",...
&       "Q   Q",...
&       "Q   Q",...
&       "Q Q Q",...
&       "Q  Q ",...
&       " QQ Q",...
&...
&       "RRRR ",...
&       "R   R",...
&       "R   R",...
&       "RRRR ",...
&       "R R  ",...
&       "R  R ",...
&       "R   R",...
&...
&       " SSS ",...
&       "S   S",...
&       "S    ",...
&       " SSS ",...
&       "    S",...
&       "S   S",...
&       " SSS ",...
&...
&       "TTTTT",...
&       "  T  ",...
&       "  T  ",...
&       "  T  ",...
&       "  T  ",...
&       "  T  ",...
&       "  T  ",...
&...
&       "U   U",...
&       "U   U",...
&       "U   U",...
&       "U   U",...
&       "U   U",...
&       "U   U",...
&       " UUU ",...
&...
&       "V   V",...
&       "V   V",...
&       "V   V",...
&       "V   V",...
&       "V   V",...
&       " V V ",...
&       "  V  ",...
&...
&       "W   W",...
&       "W   W",...
&       "W   W",...
&       "W W W",...
&       "W W W",...
&       "WW WW",...
&       "W   W",...
&...
&       "X   X",...
&       "X   X",...
&       " X X ",...
&       "  X  ",...
&       " X X ",...
&       "X   X",...
&       "X   X",...
&...
&       "Y   Y",...
&       "Y   Y",...
&       " Y Y ",...
&       "  Y  ",...
&       "  Y  ",...
&       "  Y  ",...
&       "  Y  ",...
&...
&       "ZZZZZ",...
&       "    Z",...
&       "   Z ",...
&       "  Z  ",...
&       " Z   ",...
&       "Z    ",...
&       "ZZZZZ",...
&...
&       "  1  ",...
&       " 11  ",...
&       "  1  ",...
&       "  1  ",...
&       "  1  ",...
&       "  1  ",...
&       "11111",...
&...
&       " 222 ",...
&       "2   2",...
&       "    2",...
&       "  22 ",...
&       " 2   ",...
&       "2    ",...
&       "22222",...
&...
&       "33333",...
&       "    3",...
&       "   3 ",...
&       "  33 ",...
&       "    3",...
&       "3   3",...
&       " 333 ",...
&...
&       "4   4",...
&       "4   4",...
&       "4   4",...
&       "44444",...
&       "    4",...
&       "    4",...
&       "    4",...
&...
&       "55555",...
&       "5    ",...
&       "5555 ",...
&       "    5",...
&       "    5",...
&       "5   5",...
&       " 555 ",...
&...
&       "  666",...
&       " 6   ",...
&       "6    ",...
&       "6666 ",...
&       "6   6",...
&       "6   6",...
&       " 666 ",...
&...
&       "77777",...
&       "    7",...
&       "   7 ",...
&       "  7  ",...
&       " 7   ",...
&       " 7   ",...
&       " 7   ",...
&...
&       " 888 ",...
&       "8   8",...
&       "8   8",...
&       " 888 ",...
&       "8   8",...
&       "8   8",...
&       " 888 ",...
&...
&       " 999 ",...
&       "9   9",...
&       "9   9",...
&       " 9999",...
&       "    9",...
&       "   9 ",...
&       "999  ",...
&...
&       " 000 ",...
&       "0   0",...
&       "0  00",...
&       "0 0 0",...
&       "00  0",...
&       "0   0",...
&       " 000 ",...
&...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&       "     ",...
&       "..   ",...
&       "..   ",...
&...
&       "  $  ",...
&       " $$$$",...
&       "$    ",...
&       " $$$ ",...
&       "    $",...
&       "$$$$ ",...
&       "  $  ",...
&...
&       "     ",...
&       "    /",...
&       "   / ",...
&       "  /  ",...
&       " /   ",...
&       "/    ",...
&       "     ",...
&...
&       "     ",...
&       " ::: ",...
&       " ::: ",...
&       "     ",...
&       " ::: ",...
&       " ::: ",...
&       "     ",...
&...
&       "     ",...
&       "     ",...
&       "     ",...
&       "-----",...
&       "     ",...
&       "     ",...
&       "     "/
! ^L cause SLIST page throw

DEF BCD$(BCDVALUE)=NUMF$("##",(BCDVALUE**(-4))*10+(BCDVALUE&:F))

    REM PROGRAM START
    IF COL(0)<>1
    THEN
        REM SMART USER IS USING PARAMETERIZED INPUT LINE!
        INPUT '' LINE$ \ ! GET THE LINE
        PRINT VERSION$ \ ! TELL HIM WHO WE ARE...
    ELSE
        ! USER IS A DUMMY, ASK FOR EVERYTHING!
        Print Version$ \ ! so dummy knows who we are...
        INPUT "Source file to list: " LINE$ \ ! ASK FOR FILE TO LIST
        ! *** NOTE: USER CAN TYPE IN SINGLE-LINE SLIST COMMAND HERE ***
        INPUT "Message to print: " BANNER$ \ ! GIVE HIM CHANCE AT BANNER
        ! BUILD PARAMETERIZED LINE
        IF BANNER$<>""
        THEN LINE$=LINE$ CAT ' "' CAT BANNER$ CAT '"'
        PRINT "Next time, you can type:"
        PRINT "    .SLIST ";LINE$
    FI
    ! Now rip parameterized command line to shreds
    LET LINE$=UPPERCASE$(LINE$)
    ! LOOK FOR FORCED DEPTH
    LET I=FIND(LINE$,"/DEPTH=")
    IF I>0
    THEN
        ! FORCED DEPTH SUPPLIED
        LET PAGEDEPTH=VAL(RIGHT$(LINE$,I+7))
        LET LINE$=LINE$[1,I-1]
    FI
    ! LOOK FOR FORCED WIDTH
    LET I=FIND(LINE$,"/WIDTH=")
    IF I>0
    THEN
        ! FORCED WIDTH SUPPLIED
        LET PAGEWIDTH=VAL(RIGHT$(LINE$,I+7))
        LET LINE$=LINE$[1,I-1]
    FI
    ! NOW LOOK FOR OUTPUT DEVICE OTHER THAN LPT:
    I=FIND(LINE$," TO ")
    IF I>0
    THEN
        OUTPUTFILE$=RIGHT$(LINE$,I+4)
        LINE$=LEFT$(LINE$,I-1)
    ELSE OUTPUTFILE$="LPT:"
    ! CHECK FOR ATFILE NOTATION
    PROCESSINGATFILE=FIND(LINE$,"@")=1
    IF PROCESSINGATFILE
    THEN
        LET ATFILE$=RIGHT$(LINE$,2)
        OPEN #ATFILE,ATFILE$
    FI
    REM WHEN WE GET HERE, THE FOLLOWING IS TRUE:
    REM PROCESSINGATFILE=TRUE, AND ATFILE$ CONTAINS NAME OF ATFILE
    REM PROCESSINGATFILE=FALSE, AND LINE$ CONTAINS NAME OF FILE TO PRINT

    IF ERROR WHEN OPEN #PTFILE,PRINTILKFILE$
    THEN
        IF ERR=1011
        THEN
        INPUT "NO PRINT.INTERLOCK FILE. CREATE IT? " LINE1$
        IF FIND(UPPERCASE$(LINE1$),"YES")=0
        THEN PRINT "CAN'T RUN WITHOUT INTERLOCK FILE."\EXIT
        CREATE #PTFILE,PRINTILKFILE$
        SYSCALL INTERLOCKCREATE$,DONTASK$,LINE1$
        WRITE #PTFILE,LINE1$ \ ! SAVEINTERLOCK OBJECT ID IN A FILE
        POSITION #PTFILE,0
    ELSE ERROR
    FI
    READ #PTFILE,INTERLOCKID$ \ ! GET INTERLOCK OBJECT ID
    CLOSE #PTFILE

    IF ERROR WHEN SYSCALL INTERLOCKTEST$,INTERLOCKID$
    THEN PRINT "Printer not available now, try again later." \ EXIT

    IF ERROR WHEN CREATE #OUTFILE, OUTPUTFILE$
    THEN SYSCALL INTERLOCKRELEASE$,INTERLOCKID$ \ ERROR

REM ******** RON'S INTERLOCK ********

    IF ERROR WHEN CALL PRINTFILES
    THEN
        IF LINESPRINTED >0 THEN GOSUB PRINTFORM FI
        SYSCALL INTERLOCKRELEASE$,INTERLOCKID$
        ERROR
    ELSE
        SYSCALL INTERLOCKRELEASE$,INTERLOCKID$
        EXIT
    FI

SUBROUTINE PRINTFILES

    Rem Now, ask the printer just how big it is...
    SYSCALL #OUTFILE,SCGETTYPE$,"",TEMP$
    IF TEMP$[1]=4 OR TEMP$[1]=5
    THEN
        SYSCALL #OUTFILE,SCGETPARAMS$,"",TEMP$
        PRINTERWIDTH=TEMP$[1] \ PRINTERDEPTH=TEMP$[2]
    ELSE
        ! NOT PRINTER OR CONSOLE DEVICE, SO USE DEFAULT WIDTH AND DEPTH
        PRINTERWIDTH=132 \ PRINTERDEPTH=66
    FI
    IF PAGEDEPTH<0 THEN PAGEDEPTH=PRINTERDEPTH \ ! SUPPLY DEFAULT DEPTH
    IF PAGEWIDTH<0 THEN PAGEWIDTH=PRINTERWIDTH \ ! SUPPLY DEFAULT WIDTH
! ^L
NEXTFILE: ! PROCESS THE NEXT FILE
    PAGEPARITY=0 \ ! AN EVEN NUMBER OF PAGES HAS BEEN PRINTED
    LINESPRINTED=0
    IF PROCESSINGATFILE
    THEN
        INPUT #ATFILE,LISTFILE$
        IF EOF(ATFILE) THEN GOTO RELEXIT FI
    ELSE LISTFILE$=LINE$
    GOSUB EXTRACTPATHNAME \ ! STRIP DEVICE NAME FROM FILE NAME
    ! CHECK FOR BANNER MESSAGE
    I=FIND(LISTFILE$,'"')
    IF I>0
    THEN
        BANNER$=RIGHT$(LISTFILE$,I+1)
        LET BANNER$=LEFT$(BANNER$,FIND(BANNER$,'"')-1)
        LET LISTFILE$=LEFT$(LISTFILE$,I-1)
        PAGINATE=FIND(LISTFILE$,"/P")
        IF PAGINATE THEN LET LISTFILE$=LISTFILE$[1,PAGINATE-1]
        OVERRIDE=FIND(LISTFILE$,"/O")
        IF OVERRIDE THEN LET LISTFILE$=LISTFILE$[1,OVERRIDE-1] FI
    ELSE
       PAGINATE=FIND(LISTFILE$,"/P")
       IF PAGINATE THEN LET LISTFILE$=LISTFILE$[1,PAGINATE-1]
       OVERRIDE=FIND(LISTFILE$,"/O")
       IF OVERRIDE THEN LET LISTFILE$=LISTFILE$[1,OVERRIDE-1]
       BANNER$=LISTFILE$ \ ! USE FILE NAME MINUS DEVICE NAMES AS BANNER
    FI
    LET LISTFILE$=UPPERCASE$(LISTFILE$)
    ! NOW INSPECT FILE NAME EXTENSION FOR AUTOMATIC FUNNY PROCESSING
    ! FIRST, REMOVE TRAILING BLANKS
    FOR I=LEN(LISTFILE$) TO 1 STEP -1 UNTIL LISTFILE$(I)<>:20 DO ! NADA
    FOR J=I TO 1 STEP -1 UNTIL LISTFILE$(J,1) = "." DO ! NADA

    LET LEN(LISTFILE$)=I
    IF LEN(LISTFILE$) >= 3 AND J > 1
    THEN
        LET EXTENSION$=LISTFILE$(J,I-J+1)
        IF EXTENSION$=".BAS" THEN PAGINATE=TRUE
        IF EXTENSION$=".DO" THEN PAGINATE=TRUE
        IF EXTENSION$=".ASM" THEN PAGINATE=TRUE
    FI

    IF LEN(PATHNAMEPREFIX$)+LEN(LISTFILE$)>0
    THEN
 35       OPEN #INFILE,PATHNAMEPREFIX$ CAT LISTFILE$
        ! GET CREATION DATE OF FILE TO BE PRINTED
        SYSCALL #INFILE,SCGETTYPE$,"",TEMP$
        IF TEMP$[1]=0
        THEN
            ! A DISK FILE IS BEING PRINTED. GRAB ITS DATE...
            IF ERROR WHEN SYSCALL #INFILE,SCGETFILEDATE$,"",TEMP$
            THEN FILEDATE$=DATE$
            ELSE
                LET FILEDATE$="00/00/00"
                LET FILEDATE$[1,2]=BCD$(TEMP$[5])
                LET FILEDATE$[4,2]=BCD$(TEMP$[4])
                LET FILEDATE$[7,2]=BCD$(TEMP$[6])
            FI
        ELSE FILEDATE$=DATE$
    ELSE FILEDATE$=DATE$
 40   GOSUB PRINTTITLEPAGE\GOSUB PRINTTITLEPAGE \ ! PRINT TITLE PAGE TWICE
    IF LEN(PATHNAMEPREFIX$)+LEN(LISTFILE$)=0
    THEN PRINTDONE
!^L
    ! NOW, PRINT THE FILE...
    PAGESPRINTED=0
    SOURCEFORMNUMBER=0 \ ! # OF FORM CHARACTERS ENCOUNTERED IN INPUT STREAM
    SOURCELINENUMBER=0 \ ! # OF SOURCE LINES PRINTED SINCE LAST FORM CHARACTER
PRINTPAGE: ! START PRINTING ANOTHER PAGE
    ! PRINTER IS AT TOP OF FORM HERE
    LET LINESPRINTED=0
    IF NOT OVERRIDE AND PAGINATE
    THEN
        ! PRINT IN PAGINATED FORMAT, WE ARE AT TOP OF FORM HERE
PAGINATEPRINTANOTHER: ! GET ANOTHER LINE FROM FILE AND GO PRINT
        INPUT #INFILE,LINE$
        IF EOF(INFILE)
        THEN
            IF LINESPRINTED>0 THEN GOSUB PRINTFORM
            GOTO PRINTDONE
        FI
        SOURCELINENUMBER=SOURCELINENUMBER+1
PAGINATEPRINTTHISLINE: ! PRINT WHAT IS CONTAINED IN LINE$
        IF FIND(LINE$,FORM$)=0 ...
&          AND ( LEN(LINE$)>=3 AND UPPERCASE$(LINE$[2,2])="^L" ...
&                OR LEN(LINE$)>=4 AND UPPERCASE$(LINE$[3,2])="^L" )
        THEN
            ! PAGE THROW REQUIRED. IGNORE REST OF SOURCE LINE
            IF LINESPRINTED > 0 THEN GOSUB PRINTFORM
            GOTO PAGINATEPRINTANOTHER
        FI
        IF LINESPRINTED=0 AND FIND(LINE$,FORM$)<>1
        THEN
            ! AT TOF AND THERE'S SOMETHING TO PRINT...OUTPUT THE HEADING
            FOR LINESPRINTED=0 TO INT(PAGEGAP/2)-1 DO PRINT #OUTFILE
            PRINT #OUTFILE,LISTFILE$;TAB(20);FILEDATE$;"     ";TIME$;...
&                          TAB(50);"Page";PAGESPRINTED+1;
            IF SOURCEFORMNUMBER>0
            THEN PRINT #OUTFILE,"Form";SOURCEFORMNUMBER+1
            ELSE PRINT #OUTFILE
            LET LINESPRINTED=LINESPRINTED+1 \ ! COUNT HEADER LINE
            PRINT #OUTFILE
            LET LINESPRINTED=LINESPRINTED+1 \ ! COUNT THE BLANK LINE
        FI
        IF FIND(LINE$,FORM$)
        THEN
            ! PROCESS FORM CHARACTER
            LET I=FIND(LINE$,FORM$)
            IF I=1
            THEN
                IF LINESPRINTED=0
                THEN
                    ! COINCIDENCE, AT TOF AND FORM SEEN
                    LINE$=RIGHT$(LINE$,2) \ ! THROW AWAY THE FORM CHARACTER
                    SOURCEFORMNUMBER=SOURCEFORMNUMBER+1 \ ! COUNT THE FORM
                    SOURCELINENUMBER=0 \ ! RESET NUMBER OF LINES PROCESSED
                    GOTO PAGINATEPRINTTHISLINE \ ! PRINT REST OF LINE
                FI
            ELSE
                PRINT #OUTFILE,USING "#####: ",SOURCELINENUMBER;
                PRINT #OUTFILE,LINE$[1,I-1]; \ ! OUTPUT LINE UP TO FORM CHAR
            FI
            LET LINE$=RIGHT$(LINE$,I+1) \ ! EXTRACT REST OF LINE
            GOSUB PRINTFORMFROMFILE \ ! PRINT THE FORM CHARACTER
            GOTO PAGINATEPRINTTHISLINE
        ELSE
            PRINT #OUTFILE,USING "#####: ",SOURCELINENUMBER;
            PRINT #OUTFILE,LINE$
            LET LINESPRINTED=LINESPRINTED+1
            IF LINESPRINTED<PAGEDEPTH-(PAGEGAP-INT(PAGEGAP/2))
            THEN PAGINATEPRINTANOTHER \ ! MORE ROOM LEFT ON THIS PAGE
            GOSUB PRINTFORM \ ! SKIP TO TOF FOR NEXT PAGE
        FI
    ELSE
        ! PRINT IN IMAGE FORMAT, FILE SUPPLIES HEADERS, ETC.
IMAGEPRINTANOTHER: ! GET ANOTHER LINE FROM FILE AND GO PRINT
        INPUT #INFILE,LINE$
        IF EOF(INFILE)
        THEN
            IF LINESPRINTED>0 THEN GOSUB PRINTFORM
            GOTO PRINTDONE
        FI
        SOURCELINENUMBER=SOURCELINENUMBER+1
IMAGEPRINTTHISLINE: ! PRINT WHAT IS CONTAINED IN LINE$
        IF FIND(LINE$,FORM$)
        THEN
            ! PROCESS FORM CHARACTER
            LET I=FIND(LINE$,FORM$)
            PRINT #OUTFILE,LINE$[1,I-1]; \ ! OUTPUT LINE UP TO FORM CHARACTER
            LET LINE$=RIGHT$(LINE$,I+1) \ ! EXTRACT REST OF LINE
            GOSUB PRINTFORMFROMFILE \ ! PRINT THE FORM CHARACTER
            GOTO IMAGEPRINTTHISLINE
        ELSE
            PRINT #OUTFILE,LINE$
            LET LINESPRINTED=LINESPRINTED+1
            IF LINESPRINTED<PAGEDEPTH THEN IMAGEPRINTANOTHER
            GOSUB LOGICALPRINTFORM \ ! KEEP TRACK OF PAGE COUNT
        FI
    FI
    GOTO PRINTPAGE
PRINTDONE: ! PRINTING OF THIS FILE IS COMPLETE
    IF PAGEPARITY THEN GOSUB PRINTFORM \ ! PUT US ON EVEN PAGE BOUNDARY
    IF LEN(PATHNAMEPREFIX$)+LEN(LISTFILE$)>0 THEN CLOSE #INFILE
    IF PROCESSINGATFILE THEN NEXTFILE ELSE GOTO RELEXIT

RELEXIT: !RELEASE PRINTER INTERLOCK AND EXIT
!    SYSCALL INTERLOCKRELEASE$,INTERLOCKID$
    EXIT SUBROUTINE

EXTRACTPATHNAME: ! EXTRACT PATHNAME PREFIX FROM FILE NAME
    I=FIND(LISTFILE$," ")
    IF I=0 THEN I=LEN(LISTFILE$)
    FOR I=I TO 1 STEP -1 UNTIL LISTFILE$(I,1)=":" DO ! NADA
    PATHNAMEPREFIX$=LEFT$(LISTFILE$,I)
    LISTFILE$=RIGHT$(LISTFILE$,I+1) \ ! ACTUAL FILE NAME
    RETURN

PRINTFORMFROMFILE: ! PRINT FORM CHARACTER THAT CAME FROM FILE BEING LISTED
    SOURCEFORMNUMBER=SOURCEFORMNUMBER+1 \ ! BUMP # FORM CHARACTERS SEEN
    SOURCELINENUMBER=0 \ ! # OF SOURCE LINES PRINTED SINCE LAST FORM CHARACTER
PRINTFORM: ! OUTPUT A FORM CHARACTER
    PRINT #OUTFILE,FORM$;
LOGICALPRINTFORM: ! A LOGICAL PAGE HAS BEEN COMPLETED
    LET LINESPRINTED=0 \ ! NUMBER OF LINES PRINTED ON THIS PAGE
    LET PAGEPARITY=PAGEPARITY XOR 1 \ ! TOGGLE "ODDNESS" OF PAGE COUNT
    LET PAGESPRINTED=PAGESPRINTED+1
    RETURN

PRINTTITLEPAGE: ! PRINT PAGE WITH BANNER, TIME AND DATE
    MESSAGE$=" "
    GOSUB PRINTBIG
    MAGNIFICATION=1
    LET MESSAGE$=UPPERCASE$(BANNER$)
    IF LEN(MESSAGE$)>17 THEN MESSAGE$=MESSAGE$[1,17] \ ! SORRY, LIFE'S HARD...
    REM CENTER MESSAGE
    MESSAGE$=SPACES$[1,INT((17-LEN(MESSAGE$))/2)] CAT MESSAGE$
    GOSUB PRINTBIG
    MESSAGE$=" "
    GOSUB PRINTBIG
11  MESSAGE$=TIME$ CAT " " CAT FILEDATE$
    GOSUB PRINTBIG
    GOSUB PRINTFORM
    RETURN

PRINTBIG: ! PRINT MESSAGE IN BIG BLOCK LETTERS
    LET LEN(OP$)=MAXLEN(OP$)
    FOR LINE=0 TO 6
        OPP=1
        FOR H=1 TO MAGNIFICATION
            FOR I=1 TO LEN(MESSAGE$)
                CHARSPICINDEX=FIND(ALF$,MESSAGE$[I,1])*35+5*LINE
                ! Note: chars not in ALF$ are mapped to "blanK"
                FOR J=1 TO 5
                    FOR K=1 TO MAGNIFICATION
                        OP$[OPP]=CHARACTERPICTURES$[CHARSPICINDEX+J]
                        OPP=OPP+1
                    NEXT K
                 NEXT J
                 FOR J=1 TO MAGNIFICATION
                     OP$[OPP]=:20
                     OPP=OPP+1
                 NEXT J
             NEXT I
             PRINT #OUTFILE,OP$[1,OPP-1]
             LINESPRINTED = LINESPRINTED + 1
             LINENUM=LINENUM+1
        NEXT H
    NEXT LINE
    FOR I=1 TO MAGNIFICATION*2
        PRINT #OUTFILE
        LINESPRINTED = LINESPRINTED + 1
        LINENUM=LINENUM+1
    NEXT I
    RETURN

END


END
