0100 ;PRINT-USR (NUMPRINT.M65)
0140 ;     BY MARC ESCOLA
0150 ;(c)1988, ANTIC PUBLISHING
0170 ;
0180 VVTP =  $86
0190 STMCUR = $8A
0200 FR0 =   $D4
0210 FILL1 = $D4
0220 FILL2 = $D5
0230 VADR =  $CB
0240 SADR =  $CD
0250 LEN =   $CF
0260 LBUFF = $057F
0270 ASROT = $D8E6
0280 FPROT = $D9AA
0290 ;
0300 ; BASIC CALL:
0310 ;
0320 ; X=USR(1536,ADR(STR$),LEN(STR$))
0330 ;
0340     *=  1536
0350 ;
0360 ; GET STRING ADDRESS FROM STACK
0370 ;
0380     PLA         ;PULL ARGS COUNT
0390     PLA         ;HIGH BYTE STR
0400     STA SADR+1
0410     PLA         ;LOW BYTE STR
0420     STA SADR
0430     PLA         ;IGNORE LEN HIGH
0440     PLA         ;LOW BYTE LEN
0450     STA LEN     ;SAVE IN LEN
0460     DEC LEN     ;RELATIVE TO ZERO
0470 ;
0480 ; FIND TOKEN IN BASIC LINE
0490 ;
0500     LDY #2
0510 SEARCH
0520     LDA (STMCUR),Y
0530 EQUAL
0540     CMP #$2D    ;EQUAL SIGN
0550     BEQ USER    ;CHECK FOR USR
0560     INY 
0570     BPL SEARCH  ;TRY NEXT
0571 ;
0580 USER
0590     INY 
0600     LDA (STMCUR),Y
0610     CMP #$3F    ;USR TOKEN
0620     BNE EQUAL   ;START OVER
0621 ;
0630 TOKEN
0640     DEY         ;POINT TO
0650     DEY         ;TOKEN
0660     LDA (STMCUR),Y
0670     AND #$7F    ;MASK HIGH BIT
0680     LDY #0      ;CLEAR HIGH ADR
0690     STY VADR+1
0700     ASL A
0710     ASL A       ;MULT BY 8
0720     ROL VADR+1
0730     ASL A
0740     ROL VADR+1
0750     CLC         ;THEN
0760     ADC VVTP    ;ADD VVTP VALUE
0770     STA VADR    ;TO FORM
0780     LDA VVTP+1  ;ENTRY
0790     ADC VADR+1  ;ADDRESS
0800     STA VADR+1
0810 ;
0820 ; MOVE TOKEN VALUE TO FR0
0830 ;
0840     LDX #7      ;MOVE 8 BYTES
0850     LDY #9      ;POINT PAST TYPE
0860 VALUE
0870     LDA (VADR),Y
0880     STA FR0,X
0890     DEY 
0900     DEX 
0910     BPL VALUE   ;NEXT BYTE
0911 ;
0920     LDA #'0     ;SET LBUFF ZERO
0930     STA LBUFF
0940     JSR ASROT   ;CONVERT TO ASCII
0950 ZCHECK
0960     LDA LBUFF   ;CHECK FOR
0970     CMP #'0     ;LEADING ZERO
0980     BNE CHECK   ;NO, CHECK FILL
0990 ;
1000 ; SHIFT NUMBER LEFT ONE BYTE
1010 ;
1020     LDX #0
1030     LDY #1
1040 SHIFT
1050     LDA LBUFF,Y
1060     STA LBUFF,X
1070     INY 
1080     INX 
1090     CMP #127    ;REACHED END?
1100     BMI SHIFT   ;NO.
1101 ;
1110     BPL ZCHECK
1120 ;
1130 ; CHECK FOR FILL CHARACTER
1140 ;
1150 CHECK
1160     LDA #$20    ;USE BLANK
1170     STA FILL1   ;AS DEFAULT
1180     STA FILL2   ;FILL CHAR
1190     LDY #1
1200     LDA (SADR),Y
1210     CMP #'$     ;FLOAT DOLLAR
1220     BEQ FLOAT
1221 ;
1230     CMP #'*     ;FLOAT ASTRIK
1240     BEQ FLOAT
1241 ;
1250     BNE NOFLOAT ;USE DEFAULT
1251 ;
1260 FLOAT
1270     STA FILL1
1280     LDA #'X
1290     STA (SADR),Y ;REPLACE IT
1300 NOFLOAT
1310     DEY 
1320     LDA (SADR),Y
1330     CMP #'X     ;FIRST AN X?
1340     BEQ NOTFIL  ;USE DEFAULT
1341 ;
1350     STA FILL2
1360     LDA #'X
1370     STA (SADR),Y ;REPLACE IT
1380 NOTFIL
1390 ;
1400 ; CHECK STRING FOR ENDING
1410 ; INTEGER POSITION
1420 ;
1430     LDY LEN     ;LAST BYTE
1440 STRDEC
1450     LDA (SADR),Y
1460     CMP #'.
1470     BEQ SFINISH ;FOUND IT
1471 ;
1480     DEY 
1490     BPL STRDEC
1491 ;
1500     LDY LEN     ;NO DEC POS
1510     BPL SDONE
1511 ;
1520 SFINISH
1530     DEY         ;WAS POS ZERO?
1540     BPL SDONE   ;NO
1541 ;
1550     INY         ;YES
1560 SDONE
1570 ;
1580 ; CHECK NUMBER FOR ENDING
1590 ; INTEGER POSITION
1600 ;
1610     LDX #0
1620 NUMDEC
1630     LDA LBUFF,X
1640     BMI NDONE
1641 ;
1650     CMP #'.
1660     BEQ NFINISH
1661 ;
1670     INX 
1680     BPL NUMDEC
1681 ;
1690 NFINISH
1700     DEX         ;WAS POS ZERO?
1710     BMI INTFILL ;YES, FILL IT
1711 ;
1720 NDONE
1730 ;
1740 ; THIS ROUTINE MOVES THE
1750 ; INTEGERS TO THE STRING
1760 ;
1770 MOVELEFT
1780     LDA LBUFF,X ;CHECK FOR NEG
1790     CMP #'-
1800     BNE NOTNEG
1801 ;
1810     LDX #0      ;FORCE END
1820     BEQ PLUS    ;GO PUT NEQ
1821 ;
1830 NOTNEG
1840     LDA (SADR),Y ;CHECK POS
1850     CMP #'X     ;PUT HERE?
1860     BEQ PUTINT  ;YES
1861 ;
1870     DEY         ;TRY NEXT
1880     BMI INTEND  ;STRING FULL
1881 ;
1890     BPL MOVELEFT
1891 ;
1900 PUTINT
1910     LDA LBUFF,X
1920     BPL PLUS
1921 ;
1930     AND #$7F    ;MASK HIGH BIT
1940 PLUS
1950     STA (SADR),Y ;STORE IT
1960     DEY 
1970     BMI INTEND
1971 ;
1980     DEX 
1990     BPL MOVELEFT
1991 ;
2000 INTFILL
2010     LDA FILL1   ;USE FLOAT
2020     STA (SADR),Y
2030     LDA FILL2   ;USE FILL
2040     STA FILL1
2050     DEY 
2060     BPL INTFILL ;FILL IT UP
2061 ;
2070 INTEND
2080 ;
2090 ; CHECK STRING FOR FRACTIONS
2100 ;
2110     LDY LEN
2120 STRFRAC
2130     LDA (SADR),Y
2140     CMP #'.     ;IS THIS IT?
2150     BEQ SFOUND  ;YES
2151 ;
2160     DEY 
2170     BPL STRFRAC ;CHECK NEXT BYTE
2171 ;
2180     BMI EOJ     ;NO FRACS EXIT
2181 ;
2190 SFOUND
2200     INY         ;POINT ONE BEYOND
2210 ;
2220 ; CHECK NUMBER FOR FRACTIONS
2230 ;
2240     LDX #0
2250 NUMFRAC
2260     LDA LBUFF,X
2270     BMI ZFILL   ;ZERO FILL REST
2271 ;
2280     CMP #'.
2290     BEQ MOVERITE
2291 ;
2300     INX 
2310     BPL NUMFRAC ;CHECK NEXT BYTE
2311 ;
2320 MOVERITE
2330     INX 
2340     LDA LBUFF,X
2350     BMI DLAST   ;LAST DECIMAL
2351 ;
2360     STA (SADR),Y
2370     INY 
2380     CPY LEN     ;CHECK FOR END
2390     BEQ MOVERITE ;ZERO CONTINUE
2391 ;
2400     BMI MOVERITE ;LESS THAN CONT
2401 ;
2410     BPL EOJ     ;ALL DONE EXIT
2411 ;
2420 DLAST
2430     AND #$7F    ;MASK HIGH BIT
2440     STA (SADR),Y
2450     INY 
2460 ZFILL
2470     CPY LEN
2480     BEQ ZNEXT   ;ZERO CONTINUE
2481 ;
2490     BMI ZNEXT   ;LESS THAN CONT
2491 ;
2500     BPL EOJ     ;ALL DONE
2501 ;
2510 ZNEXT
2520     LDA #'0
2530     STA (SADR),Y
2540     INY 
2550     BPL ZFILL
2551 ;
2560 EOJ
2570     RTS 


---

Back to previous page