
 1000  *SAVE S.DP18 PRINT
 1010  *-------------------------------
 1020  *    APPLESOFT SUBROUTINES
 1030  *-------------------------------
 1040  AS.CROUT     .EQ $DAFB    PRINT CARRIAGE RETURN
 1050  AS.COUT      .EQ $DB5C    PRINT A CHARACTER
 1060  AS.FRMEVL    .EQ $DD7B    EVAL FP FORM. OR STRING
 1070  AS.CHKCOM    .EQ $DEBE    CHECK FOR COMMA
 1080  AS.SYNERR    .EQ $DEC9    SYNTAX ERROR
 1090  AS.ILLERR    .EQ $E199    ILLEGAL QUANTITY ERROR
 1100  AS.FRESTR    .EQ $E5FD   ERR IF NOT STRING,  FREE UP A TEMP STRING
 1110  AS.GTBYTC    .EQ $E6F5    CHRGET, THEN GETBYT
 1120  AS.GETBYT    .EQ $E6F8    GET EXPR AS BYTE IN X
 1130  *--------------------------------
 1140  *   MONITOR SUBROUTINES
 1150  *--------------------------------
 1160  MON.VTABZ    .EQ $FC24
 1170  MON.CLREOS   .EQ $FC42
 1180  MON.CLREOL   .EQ $FC9C
 1190  *--------------------------------
 1200  *      DP SUBROUTINES PRINTED ELSEWHERE
 1210  *--------------------------------
 1220  DP.NEXT.CMD         .EQ $FFFF
 1230  DP.EVALUATE         .EQ $FFFF
 1240  FOUT                .EQ $FFFF
 1250  QUICK.PRINT         .EQ $FFFF
 1260  FORMAT.PRINT        .EQ $FFFF
 1270  INPUT.NUM           .EQ $FFFF
 1280  INPUT.STR           .EQ $FFFF
 1290  *-------------------------------
 1300  *      PAGE ZERO USAGE
 1310  *-------------------------------
 1320  MON.CH       .EQ $24
 1330  MON.CV       .EQ $25
 1340  AS.CHRGET    .EQ $B1
 1350  AS.CHRGOT    .EQ $B7
 1360  P2           .EQ $F9
 1370  P1           .EQ $FD      GP POINTER
 1380  TEMP2        .EQ $FB
 1390  *--------------------------------
 1400  WBUF         .EQ $0200
 1410  *-------------------------------
 1420  *      WORK AREAS FOR DPFP
 1430  *-------------------------------
 1440  DECFLG              .BS 1
 1450  DAC.EXPONENT        .BS 1
 1460  DAC.SIGN            .BS 1
 1470  FOUT.BUF            .BS 41
 1480  STACK.PNTR          .BS 1
 1490  W                   .BS 1
 1500  D                   .BS 1
 1510  SIGN.CHAR1          .BS 1
 1520  INPUT.TYPE          .BS 1
 1530  FOUND.NUM           .BS 1
 1540  FOUND.STR           .BS 1
 1550  STR.LEN             .BS 1
 1560  REPEAT.CNT          .BS 1
 1570  FOUND.LEN           .BS 1
 1580  FOUND.CHAR          .BS 1
 1590  FILL.CHAR           .BS 1
 1600  CHAR                .BS 1
 1610  INPUT.FLAG          .BS 1
 1620  ZERO.CHAR           .BS 1
 1630  FLD.FLAG            .BS 1
 1640  FLD.START           .BS 1
 1650  TEMP3               .BS 2
 1660  INDEX               .BS 1
 1670  PICTURE.BUF         .BS 256
 1680  *-------------------------------
 1690  DP.PRINT
 1700         JSR AS.CHRGET
 1710         JSR PRINT.END
 1720         JMP DP.NEXT.CMD
 1730  *--------------------------------
 1740  DP.UNFORMAT
 1750         JSR DP.EVALUATE   GET EXPRESSION
 1760         LDA DAC.EXPONENT  GET EXPONENT
 1770         CMP #$40+19       MORE THAN 18 DIGITS BEFORE DECPT?
 1780         BCS .5            YES, USE SCIENTIFIC
 1790         CMP #$40-1        LESS THAN .01?
 1800         BCC .5            YES, USE SCIENTIFIC
 1810         LDA #'0
 1820         STA ZERO.CHAR
 1830         LDA #40           ALLOW PLENTY OF WIDTH
 1840         LDY #19           AND DECIMAL PLACES
 1850         JSR FOUT
 1860  *---TRIM TRAILING ZEROES---------
 1870         LDY INDEX         FIND END OF BUFFER
 1880  .1     DEY
 1890         LDA FOUT.BUF-1,Y  TRUNCATE TRAILING ZEROES
 1900         CMP #'0           IS THIS ONE ZERO?
 1910         BEQ .1            ...YES, KEEP TRIMMING
 1920         CMP #'.           OMIT DECIMAL POINT ON INTEGERS
 1930         BEQ .2            ...GOT A DECPT
 1940         INY               TRIM NO MORE...
 1950  .2     LDA #0            MARK END OF MEANINGFUL CHARS
 1960         STA FOUT.BUF-1,Y
 1970         STY INDEX
 1980  *---PRINT WITHOUT LEADING BLANKS-
 1990         TAY               Y=0
 2000  .3     LDA FOUT.BUF,Y
 2010         BEQ PRINT.END
 2020         CMP #$20          BLANK?
 2030         BEQ .4            ...YES, DON'T PRINT
 2040         JSR AS.COUT       ...NO, PRINT IT
 2050  .4     INY
 2060         BNE .3            ...ALWAYS
 2070  *---PRINT WITH EXPONENT----------
 2080  .5     JSR QUICK.PRINT
 2090  *--------------------------------
 2100  PRINT.END
 2110         JSR AS.CHRGOT
 2120         BNE .1            NOT ":" OR EOL
 2130         JMP AS.CROUT
 2140  .1     CMP #';'
 2150         BEQ .3
 2160         CMP #','
 2170         BEQ .2
 2180         CMP #'$      PRINT USING?
 2190         BEQ DP.PRINT.USING
 2200         CMP #'#      PRINT W,D?
 2210         BNE DP.UNFORMAT NO,UNFORMATTED PRINT
 2220  *---PRINT #W,D,VALUE-------------
 2230         JSR AS.GTBYTC     GET W IN X-REG
 2240         TXA
 2250         PHA
 2260         JSR AS.CHKCOM     MUST HAVE COMMA
 2270         JSR AS.GETBYT     GET D IN X-REG
 2280         TXA
 2290         PHA
 2300         JSR AS.CHKCOM     ANOTHER COMMA
 2310         JSR DP.EVALUATE   GET EXPR
 2320         PLA               GET D
 2330         TAY
 2340         PLA               GET W
 2350         JSR FORMAT.PRINT
 2360         JMP PRINT.END
 2370  *---COMMA AFTER ITEM-------------
 2380  .2     JSR AS.CROUT      DP18'S KIND OF TABBING
 2390  *---"," OR ";" AFTER ITEM--------
 2400  .3     JSR AS.CHRGET     NEXT CHAR
 2410         BNE .1            NEXT PRINT ITEM
 2420         RTS
 2430  *--------------------------------
 2440  DP.PRINT.USING
 2450         LDA #1       PRINT,NOT INPUT
 2460  *--------------------------------
 2470  PRINT.INPUT
 2480         STA INPUT.FLAG    0=INPUT, 1=PRINT
 2490         JSR AS.CHRGET     EAT THE $
 2500         JSR AS.FRMEVL     GET PICTURE
 2510         JSR AS.FRESTR     ERR IF NOT STRING, FREE TEMP
 2520         STX P1              ADDR IN Y,X, LEN IN A
 2530         STY P1+1
 2540         STA STR.LEN
 2550         INC STR.LEN       WE'RE GOING TO ADD ONE
 2560         TAY               LENGTH TO Y
 2570         LDA #0            PUT 0 AT END OF PICTURE
 2580         STA PICTURE.BUF,Y
 2590         STA STACK.PNTR
 2600         STA FLD.FLAG
 2610  .1     DEY
 2620         LDA (P1),Y        MOVE PICTURE TO BUFFER
 2630         STA PICTURE.BUF,Y
 2640         TYA               TEST FOR END
 2650         BNE .1            ...MORE 
 2660         STY REPEAT.CNT    Y IS 0
 2670         DEY               Y = $FF
 2680         JSR PRUS.CLEAR    CLEAR VARIABLES
 2690  *--------------------------------
 2700  *   PARSE THE PICTURE
 2710  *--------------------------------
 2720  PRUS.NEXT
 2730         INY               NEXT CHAR
 2740         CPY STR.LEN     DONE?
 2750         BEQ .1            ...YES
 2760         LDA PICTURE.BUF,Y GET A CHAR
 2770         STY TEMP2         SAVE PICTURE PNTR
 2780         JSR LOOKUP
 2790         LDY TEMP2         RESTORE PICTURE PNTR
 2800         JMP PRUS.NEXT
 2810  .1     LDA INPUT.FLAG
 2820         BNE .2
 2830         JMP AS.CROUT
 2840  .2     JMP PRINT.END     HANDLE ; AT END OF STATEMENT
 2850  *--------------------------------
 2860  * LOOKUP LOOKS UP THE ENTRY CORRESPONDING TO (A)
 2870  *--------------------------------
 2880  LOOKUP STA CHAR     SAVE KEY
 2890         LDY #-3
 2900  .1     INY
 2910         INY
 2920         INY          NEXT ENTRY
 2930         LDA TBL.BASE,Y
 2940         BEQ .7       END OF TABLE
 2950         CMP CHAR     ONE WE WANT?
 2960         BNE .1       NO,NEXT ENTRY
 2970  *---FOUND CHAR IN TABLE----------
 2980         CPY #L.BOTH       NEW FIELD?
 2990         BCC .2            ...MAYBE NOT
 3000         LDA #0            START A NEW FIELD
 3010         STA FLD.FLAG
 3020         BEQ .3            ...ALWAYS
 3030  .2     LDA FLD.FLAG      BEGINNING OF FIELD?
 3040         BNE .3            ...NO, NOT A NEW FIELD
 3045         JSR PRUS.CLEAR    ...YES, NEW FIELD
 3050         LDA TEMP2
 3060         STA FLD.START
 3070         INC FLD.FLAG
 3080  *---PRINT WHATEVER'S NEEDED------
 3090  .3     CPY #L.EITHER
 3100         BCC .4       ...ONLY TRY PRT.STR.IF.NEEDED
 3110         JSR PRT.NUM.IF.NEEDED
 3120         CPY #L.BOTH
 3130         BCC .5       ...ONLY TRY PRT.NUM.IF.NEEDED
 3140  .4     JSR PRT.STR.IF.NEEDED
 3150  *---GET ROUTINE ADDRESS----------
 3160  .5     LDA TBL.BASE+2,Y
 3170         PHA          PUT ADDRESS ON STACK
 3180         LDA TBL.BASE+1,Y
 3190         PHA
 3200         LDY REPEAT.CNT    GET THE COUNT
 3210         BNE .6       COUNT IS NON-0
 3220         INY          COUNT IS 0, SO MAKE IT 1
 3230  .6     LDA #0       CLEAR REPEAT.CNT
 3240         STA REPEAT.CNT
 3250         LDA CHAR     GET THE ORIGINAL CHARACTER
 3260         RTS          JUMP TO ROUTINE
 3270  *---CHAR NOT IN TABLE------------
 3280  .7     LDA CHAR     GET CHAR AGAIN
 3290         EOR #'0      CHECK FOR DIGIT 0-9
 3300         CMP #10
 3310         BCS .9       ...NOT A NUMBER
 3320         STA TEMP3
 3330         LDA REPEAT.CNT    PREVIOUS * 10
 3340         ASL               *2
 3350         ASL               *4
 3360         ADC REPEAT.CNT    *5
 3370         ASL               *10
 3380         ADC TEMP3         + DIGIT
 3390         STA REPEAT.CNT
 3400         LDA FLD.FLAG      BEGINNING OF FIELD?
 3410         BNE .8            ...NO
 3420         LDA TEMP2         YES, SAVE STARTING POSN
 3430         STA FLD.START
 3440         INC FLD.FLAG
 3450  .8     RTS
 3460  *---NOT IN TABLE, NOT A DIGIT----
 3470  .9     JSR PRT.STR.IF.NEEDED
 3480         JSR PRT.NUM.IF.NEEDED
 3490  *--------------------------------
 3500  PRUS.CLEAR
 3510         LDX #1
 3520         STX W        W = 1
 3530         DEX          REST = 0
 3540         STX D
 3550         STX DECFLG   NO DECIMAL
 3560         STX SIGN.CHAR1
 3570         STX FOUND.NUM    FLAG IF # HAS BEEN FOUND
 3580         STX FOUND.STR
 3590         STX FOUND.LEN
 3600         STX FOUND.CHAR
 3610         RTS
 3620  *--------------------------------
 3630  *   TABLE IS IN THREE SECTIONS:
 3640  *      1ST SECTION (BEFORE L.EITHER) ARE FOR
 3650  *      FOR DESCRIBING NUMERIC FIELDS, AND CAN
 3660  *      TERMINATE A STRING FIELD.
 3670  *
 3680  *      2ND SECTION (BTWN L.EITHER & L.BOTH) IS
 3690  *      FOR DESCRIBING STRING FIELDS, AND CAN
 3700  *      TERMINATE A NUMERIC FIELD
 3710  *
 3720  *      3RD SECTION (AFTER L.BOTH) CAN TERMINATE
 3730  *       BOTH KINDS OF FIELDS.
 3740  *
 3750  *      TABLE FORMAT = #CHAR,ADDRESS-1
 3760  *      END OF TABLE MARKED WITH $00
 3770  *--------------------------------
 3780         .MA TBL
 3790         .DA #']1',]2-1
 3800         .EM
 3810  *--------------------------------
 3820  TBL.BASE
 3830         >TBL "+",IP.PLUS.MINUS   -#-
 3840         >TBL "-",IP.PLUS.MINUS   -#-
 3850         >TBL "#",IP.NUMBER       -#-
 3860         >TBL "*",IP.ASTERISK     -#-
 3870         >TBL "Z",IP.ZERO         -#-
 3880         >TBL ".",IP.POINT        -#-
 3890         >TBL ",",IP.COMMA        -#-
 3900  L.EITHER .EQ *-TBL.BASE
 3910         >TBL "A",IP.ACR          -$-
 3920         >TBL "C",IP.ACR          -$-
 3930         >TBL "R",IP.ACR          -$-
 3940  L.BOTH   .EQ *-TBL.BASE
 3950         >TBL "'",IP.QT           -#$-
 3960         >TBL "/",IP.SLASH        -#$-
 3970         >TBL "X",IP.X            -#$-
 3980         >TBL "H",IP.HTAB         -#$-
 3990         >TBL "V",IP.VTAB         -#$-
 4000         >TBL ">",IP.GREATER      -#$-
 4010         .HS 00       END OF TABLE
 4020  *--------------------------------
 4030  *   Z -- Digit position marker, zero fill
 4040  *   # -- Digit position marker, blank fill
 4050  *   * -- Digit position marker, star fill
 4060  *--------------------------------
 4070  IP.ZERO
 4080         LDA #'0      USE 0 FOR FILL CHAR
 4090         .HS 2C
 4100  IP.NUMBER
 4110         LDA #' '     USE BLANK FOR FILL CHAR
 4120  IP.ASTERISK
 4130         STA FILL.CHAR  SAVE AS FILL CHAR
 4140  .1     JSR STA.WBUFX.INX
 4150         INC FOUND.NUM  FOUND A DIGIT
 4160         INC W        LENGTH
 4170         PHA
 4180         LDA DECFLG   HAD DECIMAL PT?
 4190         BEQ .2       NO
 4200         INC D        YES
 4210  .2     PLA
 4220         DEY
 4230         BNE .1       NEXT ONE
 4240         RTS
 4250  *--------------------------------
 4260  *   + -- Sign position marker (prints + or -)
 4270  *   - -- Sign position marker (prints space or -)
 4280  *--------------------------------
 4290  IP.PLUS.MINUS
 4300         STA SIGN.CHAR1 SAVE SIGN CHAR
 4310         JMP STA.WBUFX.INX
 4320  *--------------------------------
 4330  *   . -- Decimal position marker
 4340  *--------------------------------
 4350  IP.POINT
 4360         INC DECFLG   FOUND A DECIMAL POINT
 4370  *--------------------------------
 4380  *   , -- Puts a comma in a number
 4390  *--------------------------------
 4400  IP.COMMA
 4410  STA.WBUFX.INX
 4420         STA WBUF,X   SAVE CHAR
 4430         INX
 4440         RTS
 4450  *--------------------------------
 4460  *   A -- String field, left justified
 4470  *   C -- String field, centered
 4480  *   R -- String field, right justified
 4490  *--------------------------------
 4500  IP.ACR INC FOUND.STR     FOUND A STRING
 4510         STA FOUND.CHAR    SAVE THE CHAR
 4520         TYA
 4530         CLC
 4540         ADC FOUND.LEN  ADD LENGTH TO REPEAT COUNT
 4550         STA FOUND.LEN
 4560         RTS
 4570  *--------------------------------
 4580  *   ' -- Start of embedded string
 4590  *--------------------------------
 4600  IP.QT
 4610  .1     LDX TEMP2         X = PICTURE PNTR
 4620  .2     INX
 4630         LDA PICTURE.BUF,X GET CHAR
 4640         CMP #''           APOSTROPHE?
 4650         BNE .3            ...NO, PRINT IT
 4660         LDA PICTURE.BUF+1,X
 4670         CMP #''           TWO APOSTROPHE'S IN A ROW?
 4680         BNE .4            ...NO, MEANS END OF LITERAL
 4690         INX               ...YES, PRINT APOSTROPHE
 4700  .3     JSR AS.COUT
 4710         JMP .2
 4720  .4     DEY          REPEAT COUNT
 4730         BNE .1       ...REPEAT THE STRING
 4740         STX TEMP2    NEW PICTURE PNTR
 4750         RTS
 4760  .5     JMP AS.SYNERR
 4770  *--------------------------------
 4780  *   / -- Print n carriage returns
 4790  *   X -- print n spaces
 4800  *--------------------------------
 4810  IP.SLASH
 4820         LDA #$0D     CR'S
 4830         .HS 2C       (SKIP NEXT 2 BYTES)
 4840  IP.X   LDA #$20     BLANKS'
 4850  .1     JSR AS.COUT  PRINT THE CHAR
 4860         DEY
 4870         BNE .1
 4880         RTS
 4890  *--------------------------------
 4900  *   H -- HTAB to column n
 4910  *   V -- VTAB to line n
 4920  *--------------------------------
 4930  IP.HTAB
 4940         DEY
 4950         STY MON.CH   HTAB
 4960         RTS
 4970  *--------------------------------
 4980  IP.VTAB
 4990         DEY
 5000         CPY #24
 5010         BCS .1       OUT OF RANGE
 5020         TYA
 5030         JMP DP.VTAB
 5040  .1     JMP AS.ILLERR  ILLEGAL QUANTITY ERROR
 5050  *--------------------------------
 5060  *   > -- CLEAR TO END OF LINE
 5070  *  >> -- CLEAR TO END OF SCREEN
 5080  *--------------------------------
 5090  IP.GREATER
 5100         LDY TEMP2
 5110         LDA PICTURE.BUF+1,Y
 5120         CMP #'>'
 5130         BEQ .1       ...CLEAR TO END OF SCREEN
 5140  *---CLEAR TO END OF LINE---------
 5150         JMP MON.CLREOL
 5160  *---CLEAR TO END OF SCREEN-------
 5170  .1     INC TEMP2
 5180         JMP MON.CLREOS
 5190  *--------------------------------
 5200  PRT.NUM.IF.NEEDED
 5210         LDA FOUND.NUM  HAS # BEEN FOUND?
 5220         BEQ .1       NO
 5230         TYA
 5240         PHA          SAVE Y
 5250         LDA INPUT.FLAG
 5260         BEQ .2       INPUT
 5270         JSR PRINT.NUM     PRINT
 5280         JMP .3
 5290  .2     JSR INPUT.NUM
 5300  .3     PLA          RESTORE Y
 5310         TAY
 5320         JSR PRUS.CLEAR
 5330  .1     RTS
 5340  *--------------------------------
 5350  PRINT.NUM
 5360         LDA #0       PUT $00
 5370         STA WBUF,X   AT END OF STRING
 5380         JSR AS.CHKCOM  MUST HAVE COMMA
 5390         JSR DP.EVALUATE   GET EXPRESSION
 5400         LDA #'0
 5410         STA ZERO.CHAR
 5420  *
 5430  *--------------------------------
 5440  PRT.NUM.1
 5450         LDA DAC.SIGN
 5460         BPL .1
 5470         LDA SIGN.CHAR1  SIGN IS -
 5480         BEQ .1       NO SIGN CHAR
 5490         INC W        RESERVE PLACE FOR SIGN
 5500  *---CONVERT VALUE INTO FOUT.BUF--
 5510  .1     LDA W
 5520         LDY D
 5530         JSR FOUT
 5540  *---FILL IN THE PICTURE----------
 5550         LDX #0       INDEX INTO WBUF
 5560         LDY #0       INDEX INTO FBUF
 5570         STY DECFLG   USE FOR DIGITS FLAG
 5580  .2     LDA WBUF,X   GET CHAR FROM PICTURE
 5590         BEQ .10      END OF PICTURE
 5600         CMP #',      COMMA?
 5610         BNE .3
 5620         INX
 5630         LDA DECFLG   ANY DIGITS BEFORE THIS?
 5640         BNE .2            ...YES, LEAVE COMMA
 5650         LDA FILL.CHAR     ...NO, BUT LEAVE IF FILL
 5660         CMP #' '                 IS NON-BLANK.
 5670         BNE .2       ...NOT BLANK, SO LEAVE IN THE COMMA
 5680         STA WBUF-1,X ...COVER COMMA WITH BLANK
 5690         BNE .2       ...ALWAYS
 5700  *---CHECK FOR PICTURE SIGN-------
 5710  .3     JSR PRUS.SGN      IF + OR -, PROCESS
 5720         BCC .2            ...WAS + OR -
 5730  *---PICTURE IS DIGIT OR DECPT----
 5740         LDA FOUT.BUF,Y    GET CHAR FROM VALUE STRING
 5750         CMP #$20          SPACE?
 5760         BNE .5            ...NO
 5770         LDA FILL.CHAR     ...YES, USE FILL CHAR
 5780  .5     PHA               SAVE FOUT OR FILL CHAR
 5790         CMP #'-           IS IT A SIGN CHAR?
 5800         BNE .7            ...NO
 5810         LDA SIGN.CHAR1    IS THERE A SIGN IN FORMAT?
 5820         BNE .8            ...YES, SKIP THE SIGN
 5830         LDA WBUF+1,X      ...NO, INSTALL SIGN HERE
 5840         CMP #',           (UNLESS NEXT PIC.CHAR IS COMMA)
 5850         BNE .6            ...NOT COMMA
 5860         LDA FILL.CHAR     ...COMMA, SO COVER WITH FILLER
 5870         JSR STA.WBUFX.INX
 5880  .6     LDA FOUT.BUF,Y    GET SIGN CHAR AGAIN
 5890  .7     JSR STA.WBUFX.INX
 5900  .8     PLA               GET FOUT OR FILL CHAR BACK
 5910         INY               ADVANCE FOUT PNTR
 5920         CPY INDEX         END OF FOUTBUF?
 5930         BCS .9            ...YES
 5940         CMP FILL.CHAR     IF WE INSTALLED A DIGIT
 5950         BEQ .2            WE MUST SET THE DIGITS FLAG
 5960         CMP #'-           SIGN CHAR?
 5970         BEQ .2            ...YES
 5980         INC DECFLG        FOUND A DIGIT
 5990         BNE .2            ...ALWAYS
 6000  *---END OF FOUT.BUF--------------
 6010  .9     LDA WBUF,X
 6020         JSR PRUS.SGN
 6030  *---END OF FOUT OR PICTURE-------
 6040  .10    LDY #0
 6050  .11    LDA WBUF,Y
 6060         BEQ .12
 6070         JSR AS.COUT  PRINT IT
 6080         INY
 6090         BNE .11      ALWAYS
 6100  .12    RTS
 6110  *--------------------------------
 6120  PRUS.SGN
 6130         CMP #'+      SIGN?
 6140         BNE .1       NO
 6150         INX
 6160         LDA DAC.SIGN
 6170         BPL .2      SIGN ALREADY +
 6180         LDA #'-
 6190         STA WBUF-1,X
 6200         BNE .2       ALWAYS
 6210  .1     CMP #'-      -?
 6220         BNE .3       NO
 6230         INX
 6240         LDA DAC.SIGN
 6250         BMI .2      SIGN ALREADY -
 6260         LDA FILL.CHAR
 6270         STA WBUF-1,X   BLANK OUT SIGN
 6280  .2     CLC
 6290         RTS
 6300  .3     SEC
 6310         RTS
 6320  *--------------------------------
 6330  PRT.STR.IF.NEEDED
 6340         LDA FOUND.STR HAS STRING BEEN FOUND?
 6350         BEQ .3       NO
 6360         TYA
 6370         PHA          SAVE Y
 6380         LDA INPUT.FLAG
 6390         BEQ .1
 6400         JSR PRINT.STR
 6410         JMP .2
 6420  .1     JSR INPUT.STR
 6430  .2     PLA
 6440         TAY          RESTORE Y
 6450         JSR PRUS.CLEAR
 6460  .3     RTS
 6470  *--------------------------------
 6480  PRINT.STR
 6490         LDA #$20
 6500         STA FILL.CHAR
 6510         JSR AS.CHKCOM  MUST HAVE COMMA
 6520         JSR AS.FRMEVL     GET EXPRESSION
 6530         JSR AS.FRESTR     GET ADR AND LEN
 6540         STX P2
 6550         STY P2+1
 6560  *--------------------------------
 6570  PRINT.STR.1
 6580         PHA          SAVE LENGTH
 6590         SEC               LENGTH IS IN A
 6600         SBC FOUND.LEN     SUBTRACT FIELD LENGTH
 6610         BEQ .2            ...SAME, SO OKAY
 6620         BCC .2            ...EXP IS SHORTER THAN FIELD
 6630  *---FIELD OVERFLOW---------------
 6640         PLA               DISCARD LENGTH
 6650         LDY FOUND.LEN     GET FIELD LEN
 6660         LDA #'*           OVERFLOW CHAR
 6670  .1     JSR AS.COUT
 6680         DEY
 6690         BNE .1
 6700         RTS
 6710  *---JUSTIFY IN FIELD-------------
 6720  .2     EOR #$FF     GET POSITIVE #
 6730         TAY
 6740         INY
 6750         STY FOUND.LEN
 6760         LDA FOUND.CHAR
 6770         CMP #'A      LJ FIELD
 6780         BEQ .5
 6790         CMP #'C      CJ FIELD
 6800         BEQ .4
 6810  *---RIGHT JUSTIFY----------------
 6820         JSR PRINT.Y.SPACES
 6830         PLA          RESTORE STRING LEN
 6840         JMP PRT.STR  PRINT STRING
 6850  *---CENTER JUSTIFY---------------
 6860  .4     TYA          # OF SPACES
 6870         LSR          DIVIDE BY 2
 6880         TAY          # LEADING BLANKS
 6890         ADC #0       +1 IF IT WAS ODD
 6900         STA FOUND.LEN   # TRAILING BLANKS
 6910         JSR PRINT.Y.SPACES
 6920  *---LEFT JUSTIFY-----------------
 6930  .5     PLA          GET STRING LEN
 6940         JSR PRT.STR  PRINT IT
 6950         LDY FOUND.LEN  TRAILING SPACES
 6960         JMP PRINT.Y.SPACES
 6970  *--------------------------------
 6980  PRT.STR
 6990         STA FOUND.CHAR    LEN OF STRING
 7000         LDY #$FF
 7010  .1     INY
 7020         CPY FOUND.CHAR
 7030         BCS .2       DONE
 7040         LDA (P2),Y   GET CHAR
 7050         JSR AS.COUT  PRINT IT
 7060         JMP .1
 7070  .2     RTS
 7080  *--------------------------------
 7090  PRINT.Y.SPACES
 7100         TYA          TEST COUNT
 7110         BEQ .2       ...ZERO, EXIT NOW
 7120         LDA FILL.CHAR
 7130  .1     JSR AS.COUT
 7140         DEY
 7150         BNE .1
 7160  .2     RTS
 7170  *--------------------------------
 7180  DP.VTAB
 7190         STA MON.CV
 7200         JMP MON.VTABZ
 7210  *--------------------------------

