0000001: PAG 0000002: ***************************** 0000003: * * 0000004: * Applesoft - Part D * 0000005: * * 0000006: * Copywrite Apple Computer, * 0000007: * Inc. and Microsoft, Inc.; * 0000008: * not for publication or * 0000009: * distribution. * 0000010: * * 0000011: ***************************** 0000012: * * 0000013: * Graphics, etc. * 0000014: * * 0000015: * $F1D5 - $F7FF * 0000016: * * 0000017: ***************************** 0000018: 0000019: CALL JSR FRMNUM ;Note that CALL does not set up 0000020: JSR GETADR ; registers as in INTEGER BASIC 0000021: JMP (LINNUM) ;On a CALL: 0000022: ; Y has low byte CALL adrs 0000023: ; A has high byte CALL adrs 0000024: ; X has $9D 0000025: 0000026: INNU JSR GETBYT ;IN# 0000027: TXA 0000028: JMP INPORT 0000029: 0000030: PRNU JSR GETBYT ;PR# 0000031: TXA 0000032: JMP OUTPORT 0000033: 0000034: * Lores subroutines: 0000035: 0000036: * Subroutine to get *,* coordinates: 0000037: 0000038: DO APPLEC 0000039: SIZE = 80 ;Screen size for lores 0000040: ELSE 0000041: SIZE = 48 0000042: FIN 0000043: 0000044: PLOTFNS JSR GETBYT ;Get first coordinate 0000045: CPX #SIZE ;Make sure it is < SIZE 0000046: BCS GOERR 0000047: STX FIRST 0000048: LDA #',' 0000049: JSR SYNCHR ;Syntax check 0000050: JSR GETBYT ;Get 2nd coor 0000051: CPX #SIZE ;Must be SPEEDZ 0000143: EOR #$FF 0000144: TAX 0000145: INX 0000146: STX SPEEDZ 0000147: RTS 0000148: 0000149: TRACE SEC 0000150: HEX 90 ;Fake BCC to skip 0000151: NOTRACE CLC 0000152: ROR TRCFLG 0000153: RTS 0000154: 0000155: NORMAL LDA #$FF 0000156: BNE NRM 0000157: INVERSE LDA #$3F 0000158: NRM LDX #0 0000159: SI STA INVFLG 0000160: STX ORMASK 0000161: RTS 0000162: 0000163: FLASH LDA #$7F 0000164: LDX #$40 0000165: BNE SI 0000166: 0000167: HIMEM JSR FRMNUM ;Get specified HIMEM 0000168: JSR GETADR 0000169: CMPR LINNUM;STREND 0000170: BGE SETHI ;Above variable table? 0000171: JMM JMP MEMERR ;Error if not 0000172: 0000173: SETHI LDA LINNUM 0000174: STA MEMSIZ 0000175: STA FRETOP 0000176: LDA LINNUM+1 0000177: STA MEMSIZ+1 0000178: STA FRETOP+1 0000179: RTS 0000180: 0000181: LOMEM JSR FRMNUM 0000182: JSR GETADR 0000183: CMPR LINNUM;MEMSIZ 0000184: BGE JMM 0000185: CMPR LINNUM;VARTAB 0000186: BLT JMM 0000187: MOVD LINNUM;VARTAB 0000188: JMP CLEARC ;LOMEM clears variables 0000189: 0000190: ONERR LDA #goto 0000191: JSR SYNCHR 0000192: MOVD TXTPTR;TXTPSV 0000193: SEC 0000194: ROR ERRFLG 0000195: MOVD CURLIN;CURLSV 0000196: JSR REMN ;Ignore rest of line 0000197: JMP ADDON 0000198: 0000199: * Routine to handle errors if ONERR GOTO active: 0000200: 0000201: HANDLERR STX ERRNUM 0000202: LDX REMSTK ;Get stack ptr saved at NEWSTT 0000203: STX ERRSTK ;Remember it 0000204: ;(Should also have done TXS 0000205: ; here; see ONERR correction 0000206: ; in Applesoft manual.) 0000207: MOVD CURLIN;ERRLIN 0000208: MOVD OLDTEXT;ERRPOS 0000209: MOVD TXTPSV;TXTPTR 0000210: MOVD CURLSV;CURLIN 0000211: JSR CHRGOT 0000212: JSR GOTO ;Goto specified ONERR line 0000213: JMP NEWSTT 0000214: 0000215: RESUME MOVD ERRLIN;CURLIN 0000216: MOVD ERRPOS;TXTPTR 0000217: LDX ERRSTK ;Retrieve stack ptr as it was 0000218: TXS ; when error was encountered 0000219: JMP NEWSTT 0000220: 0000221: JSYN JMP SYNERR 0000222: 0000223: DEL BCS JSYN ;Error if # not specified 0000224: TRX PRGEND;VARTAB 0000225: JSR LINGET ;Get beginning of range 0000226: JSR FNDLIN ;Find this line or next 0000227: MOVD LOWTR;DEST 0000228: LDA #',' 0000229: JSR SYNCHR ;Check syntax 0000230: JSR LINGET ;Get end range 0000231: ;(Does nothing if end range 0000232: ; not specified.) 0000233: INCR LINNUM ;Point 1 past it 0000234: JSR FNDLIN ;Find next line to it 0000235: CMPR LOWTR;DEST 0000236: BGE MOVDWN ;Do move unless it is 0000237: RTS ; an invalid range 0000238: MOVDWN LDY #0 ;Move LOWTR through VARTAB 0000239: MOVIT LDA (LOWTR),Y ; to DEST 0000240: STA (DEST),Y 0000241: INCR LOWTR 0000242: INCR DEST 0000243: CMPR VARTAB;LOWTR 0000244: BGE MOVIT 0000245: LDX DEST+1 ;Set Y,X to DEST-1 0000246: LDY DEST 0000247: BNE :OV 0000248: DEX 0000249: :OV DEY 0000250: STX VARTAB+1 ;Point VARTAB to last 0000251: STY VARTAB ; byte moved 0000252: JMP LINKSET ;Reset links after a delete 0000253: 0000254: GR LDA LORES 0000255: LDA MIXSET 0000256: DO APPLEC 0000257: JMP GRPATCH 0000258: ELSE 0000259: JMP SETGR 0000260: FIN 0000261: 0000262: TEXT LDA LOWSCR ;JMP $FB36 would have 0000263: JMP SETTXT ; done both these. 0000264: 0000265: DO APPLEC 0000266: 0000267: PLOT80 LSR 0000268: PHP 0000269: JSR GBASCALC 0000270: PLP 0000271: LDA #$F 0000272: BCC :OV 0000273: ADC #$E0 ;= LDA #$F0 0000274: :OV STA MASK 0000275: DOPLOT PHY 0000276: JSR SELSCR ;Select page 0000277: BCC :JP ;Branch if page 1 0000278: PHX 0000279: LDA HMASK ;Rotate bit 0 to 7 0000280: TAX 0000281: LSR 0000282: TXA 0000283: ROR 0000284: SEC 0000285: STA HMASK 0000286: :JP JSR PLOT1 0000287: BCC :Y ;Skip if on page 1 0000288: LDA LOWSCR ;Switch to page 1 0000289: STX HMASK ;Replace HMASK 0000290: PLX 0000291: CLC 0000292: :Y PLY 0000293: RTS 0000294: 0000295: IS80 LDA RDDOUBHG ;Double hires on? 0000296: EOR #$80 ;Set hi bit if so 0000297: AND RD80ST ; and 80STORE active 0000298: AND RD80COL ; and 80-col mode 0000299: ASL ;Set carry if all 3 true 0000300: RTS 0000301: 0000302: ELSE ;//e roms: 0000303: 0000304: * Tape array store and recall routines: 0000305: * (No corresponding routines for disk in Applesoft.) 0000306: 0000307: STORE JSR GETARYPT 0000308: LDY #3 0000309: LDA (LOWTR),Y 0000310: TAX 0000311: DEY 0000312: LDA (LOWTR),Y 0000313: SBC #1 0000314: BCS :OV 0000315: DEX 0000316: :OV STA LINNUM 0000317: STX LINNUM+1 0000318: JSR WRITE 0000319: JSR TAPEPNT 0000320: JMP WRITE 0000321: 0000322: RECALL JSR GETARYPT 0000323: JSR MONREAD 0000324: LDY #2 0000325: LDA (LOWTR),Y 0000326: CMP LINNUM 0000327: INY 0000328: LDA (LOWTR),Y 0000329: SBC LINNUM+1 0000330: BCS :OV 0000331: JMP MEMERR 0000332: :OV JSR TAPEPNT 0000333: JMP MONREAD 0000334: 0000335: FIN 0000336: 0000337: * Hires initialization routines: 0000338: 0000339: HGR2 BIT HISCR 0000340: BIT MIXCLR ;Default to full screen 0000341: LDA #$40 0000342: BNE SETHPG 0000343: HGR LDA #$20 0000344: BIT LOWSCR 0000345: BIT MIXSET ;Default to mixed screen 0000346: SETHPG STA HPAG 0000347: LDA HIRES 0000348: LDA TXTCLR 0000349: HCLR LDA #0 ;Set for black bkgrnd 0000350: STA HCOLOR1 0000351: BKGND LDA HPAG ;Init hires screen mem 0000352: STA SHAPEH 0000353: LDY #0 0000354: STY SHAPEL 0000355: BKGND1 LDA HCOLOR1 0000356: STA (SHAPEL),Y ;Clear hires to HCOLOR1 0000357: JSR CSHFT2 ;Correct for color shift 0000358: INY ;(Slows clear by factor of 2) 0000359: BNE BKGND1 0000360: INC SHAPEH 0000361: LDA SHAPEH 0000362: AND #$1F ;Done? 0000363: BNE BKGND1 0000364: RTS 0000365: 0000366: * Hires position and plot subroutines 0000367: 0000368: HPOSN STA Y0 ;Enter with Y in A-reg 0000369: STX X0L ; XL in X-reg, 0000370: STY X0H ; and XH in Y-reg. 0000371: PHA 0000372: AND #$C0 0000373: STA GBASL ;For y-coor = 00ABCDEF 0000374: LSR ;calculates base addr 0000375: LSR ;in GBASL,GBASH for 0000376: ORA GBASL ;accessing screen memory 0000377: STA GBASL ;via (GBASL),Y. 0000378: PLA 0000379: STA GBASH 0000380: ASL ;Calculates 0000381: ASL ; GBASH = PPPFGHCD, 0000382: ASL ; GBASL = EABAB000 0000383: ROL GBASH ;where PPP=001 for $2000-$3FFF 0000384: ASL ;and PPP=010 for $4000-$5FFF, 0000385: ROL GBASH ;given y-coor = ABCDEFGH 0000386: ASL 0000387: ROR GBASL 0000388: LDA GBASH 0000389: AND #$1F 0000390: ORA HPAG 0000391: STA GBASH 0000392: TXA ;Divide X0 by 7 for 0000393: CPY #0 ;index from base adrs (quotient) 0000394: BEQ HPOSN2 ;and bit within screen mem byte 0000395: LDY #$23 ;(mask specified by remainder). 0000396: ADC #4 0000397: HPOSN1 INY 0000398: HPOSN2 SBC #7 0000399: BCS HPOSN1 0000400: STY HNDX ;Works for X0 from 0 to 279, 0000401: TAX ;low byte in X-reg, high in 0000402: LDA MSKTBL-$F9,X 0000403: STA HMASK ;Y-reg on entry. 0000404: TYA 0000405: LSR 0000406: LDA HCOLORZ ;If on odd byte (carry set) 0000407: STA HCOLOR1 ;then rotate bits 0000408: BCS CSHFT2 0000409: RTS 0000410: 0000411: HPLOT0 JSR HPOSN 0000412: LDA HCOLOR1 ;Calculate bit posn in GBAS, 0000413: EOR (GBASL),Y ; HNDX, and HMASK from 0000414: AND HMASK ; Y-coor in A-reg, 0000415: EOR (GBASL),Y ; X-coor in X,Y regs. 0000416: STA (GBASL),Y ;For any 1-bits, substitute 0000417: RTS ;corresp bit of HCOLOR1. 0000418: 0000419: * Hires L,R,U,D subroutines 0000420: 0000421: LFTRT BPL RIGHT ;Use sign for left/right subr. 0000422: LEFT LDA HMASK 0000423: LSR ;Shift low-order 7 bits 0000424: BCS LEFT1 ; of HMASK one bit posn. 0000425: EOR #$C0 0000426: LR1 STA HMASK 0000427: RTS 0000428: LEFT1 DEY ;Decr horiz index 0000429: BPL LEFT2 0000430: LDY #$27 ;Wrap around screen 0000431: LEFT2 LDA #$C0 ;New HMASK, rightmost 0000432: NEWNDX STA HMASK ; dot of byte. 0000433: STY HNDX ;Update horiz index. 0000434: CSHIFT LDA HCOLOR1 0000435: CSHFT2 ASL ;Rotate low-order 7 bits 0000436: CMP #$C0 ; of HCOLOR1 one bit posn. 0000437: BPL :RET ;Branch if black or white 0000438: LDA HCOLOR1 0000439: EOR #$7F 0000440: STA HCOLOR1 0000441: :RET RTS 0000442: 0000443: RIGHT LDA HMASK 0000444: ASL ;Shift low order 7 bits 0000445: EOR #$80 ; of HMASK one bit posn. 0000446: BMI LR1 0000447: LDA #$81 0000448: INY ;Next byte 0000449: CPY #40 0000450: BCC NEWNDX 0000451: LDY #0 ;Wrap around 0000452: BCS NEWNDX ;Always taken 0000453: LRUDX1 CLC ;No 90 deg rot 0000454: LRUDX2 LDA DXH 0000455: AND #4 ;If bit2=0 then no plot 0000456: BEQ LRUD4 0000457: LDA #$7F 0000458: AND HMASK 0000459: AND (GBASL),Y ;Screen bit set? 0000460: BNE LRUD3 0000461: INC COLCOUNT 0000462: LDA #$7F 0000463: AND HMASK 0000464: BPL LRUD3 ;Always 0000465: LRUD1 CLC ;No 90 deg rot 0000466: LRUD2 LDA DXH 0000467: AND #4 ;If bit2=0 then no plot 0000468: BEQ LRUD4 0000469: LDA (GBASL),Y 0000470: EOR HCOLOR1 ;Set hires screen bit 0000471: AND HMASK ; to corresponding HCOLOR. 0000472: BNE LRUD3 ;If screen bit changes, 0000473: INC COLCOUNT ;then incr collsn count. 0000474: LRUD3 EOR (GBASL),Y 0000475: STA (GBASL),Y 0000476: LRUD4 LDA DXH ;Add quadrant to specified 0000477: ADC QDRNT ; vector and move lft, rt, 0000478: AND #3 ; up, or down based on 0000479: EQ3 = *-1 ; sign and carry. 0000480: CMP #2 0000481: ROR 0000482: BCS LFTRT 0000483: UPDOWN BMI DOWN ;Sign for up/down select. 0000484: UP CLC 0000485: LDA GBASH ;Calc base adrs for next 0000486: BIT EQ1C ; line up in (GBAS) 0000487: BNE :U4 ; with 192-line wrap around. 0000488: ASL GBASL 0000489: BCS :U2 0000490: BIT EQ3 0000491: BEQ :U1 0000492: ADC #$1F ;**** BIT MAP **** 0000493: SEC 0000494: BCS :U3 ;for row = ABCDEFGH 0000495: :U1 ADC #$23 0000496: PHA 0000497: LDA GBASL ;GBASL = EABAB000 0000498: ADC #$B0 ;GBASH = PPPFGHCD 0000499: BCS :U5 0000500: ADC #$F0 ;where PPP=001 for pg1 0000501: :U5 STA GBASL 0000502: PLA 0000503: BCS :U3 0000504: :U2 ADC #$1F 0000505: :U3 ROR GBASL 0000506: :U4 ADC #$FC 0000507: UPDWN1 STA GBASH 0000508: RTS 0000509: CLC 0000510: DOWN LDA GBASH 0000511: ADC #4 ;Calc base adr for next 0000512: EQ4 = *-1 ; line down, with 192 0000513: BIT EQ1C ; line wrap around. 0000514: BNE UPDWN1 0000515: ASL GBASL 0000516: BCC :D1 0000517: ADC #$E0 0000518: CLC 0000519: BIT EQ4 0000520: BEQ :D2 0000521: LDA GBASL 0000522: ADC #$50 0000523: EOR #$F0 0000524: BEQ :D3 0000525: EOR #$F0 0000526: :D3 STA GBASL 0000527: LDA HPAG 0000528: BCC :D2 0000529: :D1 ADC #$E0 0000530: :D2 ROR GBASL 0000531: BCC UPDWN1 0000532: 0000533: * Hires line draw subroutines 0000534: 0000535: HLINRL PHA 0000536: LDA #0 ;Set X0L,H and Y0 0000537: STA X0L ; to 0 for rel line draw 0000538: STA X0H ; (DX,DY). 0000539: STA Y0 0000540: PLA 0000541: HGLIN PHA ;On entry: 0000542: SEC ; XL: A-reg 0000543: SBC X0L ; XH: X-reg 0000544: PHA ; Y: Y-reg 0000545: TXA 0000546: SBC X0H 0000547: STA QDRNT ;Calc ABS(X-X0) 0000548: BCS :HL2 ; in (DXL,H) 0000549: PLA 0000550: EOR #$FF ;X dir to sign bit 0000551: ADC #1 ; of qdrnt. 0000552: PHA ; 0=right (DX pos) 0000553: LDA #0 ; 1=left (DX neg) 0000554: SBC QDRNT 0000555: :HL2 STA DXH 0000556: STA EH ;Init EL,H to ABS(X-X0) 0000557: PLA ; = DELTX 0000558: STA DXL 0000559: STA EL 0000560: PLA 0000561: STA X0L ;Set ptr to end of line 0000562: STX X0H 0000563: TYA 0000564: CLC 0000565: SBC Y0 ;Calc -DELTY-1 in DY where 0000566: BCC :HL3 ; DELTY = ABS(Y-Y0) 0000567: EOR #$FF 0000568: ADC #$FE 0000569: :HL3 STA DY ;Rotate Y dir into 0000570: STY Y0 ; qdrnt sign bit 0000571: ROR QDRNT ; (0=up, 1=down) 0000572: SEC 0000573: SBC DXL ;Init COUNTL,H (COUNTL=X-reg) 0000574: TAX ; to -(DELTX+DELTY+1) 0000575: LDA #$FF 0000576: SBC DXH 0000577: STA COUNTH 0000578: LDY HNDX ;Horiz index. 0000579: BCS MOVEX2 ;Always taken. 0000580: MOVEX ASL ;Move in X-dir. Use 0000581: JSR LFTRT ; QDRNT bit6 for lft/rt set. 0000582: SEC 0000583: MOVEX2 LDA EL ;Assume carry set 0000584: ADC DY ;(EL,H)-DELTY to (EL,H) 0000585: STA EL ;Note: DY is (-DELTY)-1 0000586: LDA EH ;Carry clr if (EL,H) goes neg. 0000587: SBC #0 ;= ADC #$FF 0000588: HCOUNT STA EH 0000589: LDA (GBASL),Y 0000590: EOR HCOLOR1 ;Plot dot of HCOLOR1. 0000591: AND HMASK 0000592: EOR (GBASL),Y 0000593: STA (GBASL),Y 0000594: INX ;Done (DELTX+DELTY) dots? 0000595: BNE :OV 0000596: INC COUNTH 0000597: BEQ RTS2 ;Yes, return. 0000598: :OV LDA QDRNT ;For direction test. 0000599: BCS MOVEX ;If carry set, (EL,H) plot 0000600: JSR UPDOWN ; if clr, neg, move 0000601: CLC 0000602: LDA EL ;(EL,H)+DELTX to (EL,H). 0000603: ADC DXL 0000604: STA EL 0000605: LDA EH 0000606: ADC DXH 0000607: BVC HCOUNT ;Always taken 0000608: 0000609: MSKTBL DFB %10000001 0000610: DFB %10000010 0000611: DFB %10000100 0000612: DFB %10001000 0000613: DFB %10010000 0000614: DFB %10100000 0000615: DFB %11000000 0000616: 0000617: EQ1C HEX 1C 0000618: 0000619: * Table of COS(90*X/16 degrees)*$100 - 1 with 0000620: * one byte precision, X=0 to 16: 0000621: 0000622: COSTBL HEX FFFEFAF4ECE1D4C5 0000623: HEX B4A18D7861493118 0000624: HEX FF 0000625: 0000626: * Hires coordinate restore subroutine: 0000627: * (not called by any Applesoft routine) 0000628: 0000629: HFIND LDA GBASL ;Converts base adrs 0000630: ASL 0000631: LDA GBASH ; to y-coor. 0000632: AND #3 0000633: ROL ;For GBASL=EABAB000 0000634: ORA GBASL ; GBASH=PPPFGHCD 0000635: ASL 0000636: ASL ;generate 0000637: ASL ; Y-coor=ABCDEFGH 0000638: STA Y0 0000639: LDA GBASH ;(PPP=screen page) 0000640: LSR 0000641: LSR 0000642: AND #7 0000643: ORA Y0 0000644: STA Y0 ;Converts HNDX (index from 0000645: LDA HNDX ; base adrs) and HMASK 0000646: ASL ; (bit mask) to x-coor 0000647: ADC HNDX ; in (X0L,H), range 0000648: ASL ; 0-$133 0000649: TAX 0000650: DEX 0000651: LDA HMASK 0000652: AND #$7F 0000653: :HF1 INX 0000654: LSR 0000655: BNE :HF1 0000656: STA X0H 0000657: TXA 0000658: CLC ;Calc HNDX*7+LOG(HMASK), base 2 0000659: ADC HNDX 0000660: BCC :HF2 0000661: INC X0H 0000662: :HF2 STA X0L 0000663: RTS2 RTS 0000664: 0000665: * Hires shape drawing subroutines 0000666: 0000667: DRAW0 STX SHAPEL ;Shape pointer 0000668: STY SHAPEH 0000669: DODRAW TAX ;A holds ROT (0-$3F) 0000670: LUP 4 0000671: LSR 0000672: --^ 0000673: STA QDRNT ;QDRNT 0=UP, 1=RT 0000674: TXA ; 2=DWN, 3=LFT 0000675: AND #$F 0000676: TAX 0000677: LDY COSTBL,X ;Save COS and SIN 0000678: STY DXL ; values in DXL and DY. 0000679: EOR #$F 0000680: TAX 0000681: LDY COSTBL+1,X 0000682: INY 0000683: STY DY 0000684: LDY HNDX ;Index from base adrs. 0000685: LDX #0 0000686: STX COLCOUNT ;Clear collision count. 0000687: LDA (SHAPEL,X) ;First byte of shape defn 0000688: :D2 STA DXH 0000689: LDX #$80 0000690: STX EL ;EL,H for fractional 0000691: STX EH ; L,R,U,D vectors. 0000692: LDX SCALEZ ;Scale factor. 0000693: :D3 LDA EL 0000694: SEC ;If frac. cos overflow 0000695: ADC DXL ; then move in specified 0000696: STA EL ; vector direction. 0000697: BCC :D4 0000698: JSR LRUD1 0000699: CLC 0000700: :D4 LDA EH ;If frac. sin overflow 0000701: ADC DY ; then move in specified 0000702: STA EH ; direction+90 deg. 0000703: BCC :D5 0000704: JSR LRUD2 0000705: :D5 DEX ;Loop on scale factor. 0000706: BNE :D3 0000707: LDA DXH 0000708: LSR ;Next 3 bit vector 0000709: LSR ; of shape defn. 0000710: LSR 0000711: BNE :D2 ;Not done this byte. 0000712: INCR SHAPEL 0000713: LDA (SHAPEL,X) ;Next byte of shape defn. 0000714: BNE :D2 ;Done if 0. 0000715: RTS 0000716: 0000717: * Hires shape xdraw subroutine: 0000718: 0000719: XDRAW0 STX SHAPEL ;See DRAW comments 0000720: STY SHAPEH 0000721: DOXDRAW TAX 0000722: LUP 4 0000723: LSR 0000724: --^ 0000725: STA QDRNT 0000726: TXA 0000727: AND #$F 0000728: TAX 0000729: LDY COSTBL,X 0000730: STY DXL 0000731: EOR #$F 0000732: TAX 0000733: LDY COSTBL+1,X 0000734: INY 0000735: STY DY 0000736: LDY HNDX 0000737: LDX #0 0000738: STX COLCOUNT 0000739: LDA (SHAPEL,X) 0000740: :XD2 STA DXH 0000741: LDX #$80 0000742: STX EL 0000743: STX EH 0000744: LDX SCALEZ 0000745: :XD3 LDA EL 0000746: SEC 0000747: ADC DXL 0000748: STA EL 0000749: BCC :XD4 0000750: JSR LRUDX1 0000751: CLC 0000752: :XD4 AD EH;DY;EH 0000753: BCC :XD5 0000754: JSR LRUDX2 0000755: :XD5 DEX 0000756: BNE :XD3 0000757: LDA DXH 0000758: LSR 0000759: LSR 0000760: LSR 0000761: BNE :XD2 0000762: INCR SHAPEL 0000763: LDA (SHAPEL,X) 0000764: BNE :XD2 0000765: RTS 0000766: 0000767: * Parsing routines used by BASIC for Hires access: 0000768: 0000769: HFNS JSR FRMNUM 0000770: JSR GETADR 0000771: LDY LINNUM+1 ;Get horiz coor in X,Y 0000772: LDX LINNUM 0000773: CPY #>280 ;Make sure it is < 280 0000774: BLT HFNS1 0000775: BNE GGERR 0000776: CPX #<280 0000777: BGE GGERR 0000778: HFNS1 TXA ;Save horiz coor on stack 0000779: PHA 0000780: TYA 0000781: PHA 0000782: LDA #',' 0000783: JSR SYNCHR ;Check syntax 0000784: JSR GETBYT ;Get vert coor 0000785: CPX #$C0 ;Check it is < $C0 = 192 0000786: BGE GGERR 0000787: STX DSCTMP ;Save it 0000788: PLA ;Retrieve horiz coor 0000789: TAY 0000790: PLA 0000791: TAX 0000792: LDA DSCTMP ; and vert coor 0000793: RTS ;Return to caller 0000794: 0000795: GGERR JMP GOERR ;Illegal quantity 0000796: 0000797: HCOLOR JSR GETBYT 0000798: CPX #8 0000799: BGE GGERR 0000800: LDA COLORTBL,X 0000801: STA HCOLORZ 0000802: RTS3 RTS 0000803: 0000804: COLORTBL DFB %00000000 ;Black1 0000805: DFB %00101010 ;Green 0000806: DFB %01010101 ;Violet 0000807: DFB %01111111 ;White1 0000808: DFB %10000000 ;Black2 0000809: DFB %10101010 ;Orange 0000810: DFB %11010101 ;Cyan 0000811: DFB %11111111 ;White2 0000812: 0000813: HPLOT CMP #to ;Continued plot requested? 0000814: BEQ :P3 ;Branch if so 0000815: JSR HFNS ;Get coor of start point 0000816: JSR HPLOT0 ;Plot it, setting up coor 0000817: :P2 JSR CHRGOT 0000818: CMP #to ;Line specified? 0000819: BNE RTS3 ;Exit if not 0000820: :P3 JSR SYNCHR 0000821: JSR HFNS ;Get coor of line end 0000822: STY DSCTMP ;Set up for line 0000823: TAY 0000824: TXA 0000825: LDX DSCTMP 0000826: JSR HGLIN ;Plot line 0000827: JMP :P2 ;Loop till no more "TO" 0000828: 0000829: ROT JSR GETBYT 0000830: STX ROTZ 0000831: RTS 0000832: 0000833: SCALE JSR GETBYT 0000834: STX SCALEZ 0000835: RTS 0000836: 0000837: DRWPNT JSR GETBYT ;Shape number specified 0000838: MOVD SHAPEPNT;SHAPEL 0000839: TXA 0000840: LDX #0 0000841: CMP (SHAPEL,X) ;Shape defined in table? 0000842: BEQ DP1 0000843: BGGERR BGE GGERR ;Error if not 0000844: DP1 ASL ;Find address of shape 0000845: BCC :DP2 ; from table. 0000846: INC SHAPEH 0000847: CLC 0000848: :DP2 TAY 0000849: LDA (SHAPEL),Y 0000850: ADC SHAPEL 0000851: TAX 0000852: INY 0000853: LDA (SHAPEL),Y 0000854: ADC SHAPEPNT+1 0000855: STA SHAPEH ;Save adrs of shape 0000856: STX SHAPEL 0000857: JSR CHRGOT ;Check syntax 0000858: CMP #at 0000859: BNE :DP3 0000860: JSR SYNCHR 0000861: JSR HFNS ;Draw it where? 0000862: JSR HPOSN 0000863: :DP3 LDA ROTZ 0000864: RTS 0000865: 0000866: DRAW JSR DRWPNT ;Entries from BASIC 0000867: JMP DODRAW 0000868: XDRAW JSR DRWPNT 0000869: JMP DOXDRAW 0000870: 0000871: DO NEWROMS 0000872: DO APPLEC 0000873: CHKSIZ JSR IS80 ;Double gr mode? 0000874: BCS :OV ;Branch if so 0000875: CPY #40 0000876: BCS BGGERR 0000877: :OV CPY #80 0000878: BCS BGGERR 0000879: RTS 0000880: 0000881: VLIN80 PHA 0000882: LDA V2 ;Check vert range 0000883: CMP #48 0000884: PLA 0000885: BCS BGGERR 0000886: NEWVLIN1 PHA 0000887: JSR PLOT80 0000888: PLA 0000889: CMP V2 0000890: INC 0000891: BLT NEWVLIN1 0000892: VRET RTS 0000893: 0000894: HLINE80 TXA 0000895: LDY FIRST 0000896: JSR PLOT80 0000897: :L CPY H2 0000898: BGE VRET 0000899: INY 0000900: JSR DOPLOT 0000901: BRA :L 0000902: 0000903: SCRN80 PHA 0000904: JSR SELSCR 0000905: PLA 0000906: PHP ;Remember page used 0000907: JSR SCRN 0000908: PLP 0000909: BCC :X ;Exit if on page 1 0000910: STA LOWSCR ;Switch to page 1 0000911: CMP #8 0000912: ASL ;Should be ROL (BUG) 0000913: AND #$F ;This routine gives 0000914: :X RTS ; incorrect results 0000915: 0000916: SELSCR JSR IS80 ;Double gr enabled? 0000917: BCC :X ;Exit with C clear if not 0000918: TYA 0000919: EOR #1 0000920: LSR ;Which page to use? 0000921: TAY 0000922: BCC :X 0000923: LDA HISCR ;Switch page if needed 0000924: :X RTS ;Result is in carry 0000925: 0000926: SUBCH TXA 0000927: BIT RD80COL 0000928: BMI SUBOURCH 0000929: HEX 2C ;Skip 0000930: SETCH STA CH 0000931: SEC 0000932: TXA 0000933: SBC CH 0000934: CHRET RTS 0000935: 0000936: GETARYPT LDA #$40 0000937: STA SUBFLG 0000938: JSR PTRGET 0000939: STZ SUBFLG 0000940: RTS 0000941: 0000942: SUBOURCH SBC OURCH 0000943: RTS 0000944: 0000945: HTAB JSR GETBYT ;Get tab in X 0000946: DEX 0000947: :HT LDA #40 0000948: CMP WNDWDTH 0000949: BCS :OV 0000950: LDA WNDWDTH ;Use wdth if it is > 40 0000951: :OV JSR SETCH 0000952: STX CH 0000953: BCC CHRET 0000954: TAX 0000955: JSR CRDO 0000956: BRA :HT 0000957: 0000958: ELSE ;New //e roms: 0000959: 0000960: SHLOAD SEC 0000961: BCC * ;Fake for branch 0000962: DS -1 0000963: TAPEPNT CLC 0000964: STA INTROM 0000965: JSR $C500 0000966: STA SLOTROM 0000967: BCS JMEMERR 0000968: RTS 0000969: 0000970: JMEMERR JMP MEMERR 0000971: 0000972: GETUPC0 LDA IN+1,X 0000973: BPL CNVUPC ;Always 0000974: GETUPC LDA ENDCHR 0000975: BEQ NOCNV ;Don't convert if REM 0000976: CMP #'"' 0000977: BEQ NOCNV ; or literal 0000978: LDA DATAFLG 0000979: CMP #data-':' 0000980: BEQ NOCNV ; or DATA 0000981: INUPC LDA IN,X 0000982: CNVUPC PHP 0000983: CMP #'a' 0000984: BLT :PP 0000985: AND #%01011111 ;Convert to upper case 0000986: :PP PLP 0000987: RTS 0000988: NOCNV LDA IN,X 0000989: RTS 0000990: 0000991: SPCLIN PHA 0000992: LDA #' ' 0000993: JSR OUTDO ;Precede line # with space 0000994: PLA ; to ease editing 0000995: JMP LINPRT 0000996: 0000997: GETCH LDA CH 0000998: CMP #40-7 0000999: BIT RD80COL ;80 col mode? 0001000: BPL :X ;Exit if not 0001001: LDA OURCH 0001002: CMP #80-7 0001003: :X RTS 0001004: 0001005: SUBCH TXA 0001006: BIT RD80COL 0001007: BMI SUBOURCH 0001008: HEX 2C ;Skip 0001009: SETCH STA CH 0001010: SEC 0001011: TXA 0001012: SBC CH 0001013: CHRET RTS 0001014: 0001015: SUBOURCH SBC OURCH 0001016: RTS 0001017: 0001018: ERR \$F7D9 0001019: DS $F7D9-* 0001020: 0001021: GETARYPT LDA #$40 ;Called by STORE & RECALL 0001022: STA SUBFLG 0001023: JSR PTRGET 0001024: LDA #0 0001025: STA SUBFLG 0001026: JMP VARTIO 0001027: 0001028: HTAB JSR GETBYT ;Get tab in X 0001029: DEX 0001030: :HT LDA #40 0001031: CMP WNDWDTH 0001032: BCS :OV 0001033: LDA WNDWDTH 0001034: :OV JSR SETCH 0001035: STX CH 0001036: BCC CHRET 0001037: TAX 0001038: JSR CRDO 0001039: BNE :HT 0001040: 0001041: FIN 0001042: ELSE ;Old roms: 0001043: 0001044: * Load shape table from tape: 0001045: 0001046: SHLOAD LDA #0 0001047: STA A1H 0001048: STA A2H 0001049: LDY #LINNUM 0001050: STY A1L 0001051: INY 0001052: STY A2L 0001053: JSR MONREAD ;Read length to LINNUM 0001054: CLC 0001055: LDA MEMSIZ 0001056: TAX 0001057: DEX 0001058: STX A2L ;MEMSIZ-1 -> end ptr 0001059: SBC LINNUM ;MEMSIZ-2-len -> start 0001060: PHA 0001061: LDA MEMSIZ+1 0001062: TAY 0001063: INX 0001064: BNE :SL1 0001065: DEY 0001066: :SL1 STY A2H 0001067: SBC LINNUM+1 0001068: CMP STREND+1 0001069: BCC :SL2 0001070: BNE :SL3 ;Require page > STREND 0001071: :SL2 JMP MEMERR 0001072: :SL3 STA MEMSIZ+1 ;Set HIMEM and shape ptr 0001073: STA FRETOP+1 ; to shape table 0001074: STA A1H 0001075: STA SHAPEPNT+1 0001076: PLA 0001077: STA SHAPEPNT 0001078: STA MEMSIZ 0001079: STA FRETOP 0001080: STA A1L 0001081: JSR RD2BIT ;Find edge 0001082: LDA #3 0001083: JMP MONREAD2 ;Read shape tbl to (A1L) 0001084: 0001085: TAPEPNT ADD LOWTR;LINNUM;A2L 0001086: LDY #4 0001087: LDA (LOWTR),Y 0001088: JSR GETARY2 0001089: MOVD HIGHDS;A1L 0001090: RTS 0001091: 0001092: * Non graphics stuff: 0001093: 0001094: GETARYPT LDA #$40 ;Called by STORE & RECALL 0001095: STA SUBFLG 0001096: JSR PTRGET 0001097: LDA #0 0001098: STA SUBFLG 0001099: JMP VARTIO 0001100: 0001101: * Note that if WNDLEFT is not 0, HTAB can print 0001102: * outside the screen (eg., in the program). 0001103: 0001104: HTAB JSR GETBYT ;Get tab in X 0001105: DEX 0001106: TXA 0001107: HTAB1 CMP #40 0001108: BLT HTAB2 0001109: SBC #40 0001110: PHA 0001111: JSR CRDO 0001112: PLA 0001113: JMP HTAB1 0001114: HTAB2 STA CH 0001115: RTS 0001116: 0001117: HEX CBD278 ;Left over 0001118: 0001119: FIN 0001120: ERR *-$F800 0001121: PAG 0001122: *------------------------------------------------ 0001123: * Applesoft zero page usage map: 0001124: *------------------------------------------------ 0001125: * KEY: X = General usage 0001126: * . = Not used 0001127: * C = Set by cold start but not used 0001128: * H = Used by high resolution graphics only 0001129: * G = Used by low resolution graphics only 0001130: * T = Used by tape routines only 0001131: * D = Important DOS use 0001132: * $ = Used by STR$ routine only 0001133: * U = Set up for USR, not otherwise used 0001134: * 8 = Used by some 80 column cards 0001135: *------------------------------------------------ 0001136: * 0001137: * 0 1 2 3 4 5 6 7 8 9 A B C D E F 0001138: * ------------------------------- 0001139: * 0X: C C C C C C . . . . U U U X X X 0001140: * 1X: X X X X X X X . . . H H H H 8 8 0001141: * 2X: X X X X X X H H X X X X G G X T 0001142: * 3X: G . X X . X X X X X . . T T T T 0001143: * 4X: D D D D D D D D D D . . . . X X 0001144: * 5X: X X X X X X X X X X X X X X X X 0001145: * 6X: X X X X X X X X X X X X X X X X 0001146: * 7X: X X X X X X X X X X X X X X X X 0001147: * 8X: X X X X X X X X X X X X X X . X 0001148: * 9X: X X X X X X X X X X X X X X X X 0001149: * AX: X X X X X X X X X X X X X X X X 0001150: * BX: X X X X X X X X X X X X X X X X 0001151: * CX: X X X X X X X X X X X X X X . . 0001152: * DX: H H H H H H X . X . X X X X X X 0001153: * EX: H H H H H H H H H H H . . . . . 0001154: * FX: X X X X X X X X X H . . . . . $ 0001155: * ------------------------------- 0001156: * 0 1 2 3 4 5 6 7 8 9 A B C D E F