* * GRABAS * * A graphics extension for C-64 BASIC * * SLJ 12/29/96 (Completed 2/10/97) * v1.0 * ORG $0801 * Constants TXTPTR = $7A ;BASIC text pointer IERROR = $0300 ICRUNCH = $0304 ;Crunch ASCII into token IQPLOP = $0306 ;List IGONE = $0308 ;Execute next BASIC token CHRGET = $73 CHRGOT = $79 CHROUT = $FFD2 GETBYT = $B79E ;BASIC routine GETPAR = $B7EB ;Get a 16,8 pair of numbers CHKCOM = $AEFD NEW = $A642 CLR = $A65E LINNUM = $14 ;Number returned by GETPAR TEMP = $FF TEMP2 = $FB POINT = $FD Y1 = $05 X1 = LINNUM X2 = $02 Y2 = $04 DY = $26 DX = $27 BUF = $0200 ;Input buffer CHUNK1 = $69 ;Circle routine stuff OLDCH1 = $6A CHUNK2 = $6B OLDCH2 = $6C CX = $A3 CY = $A5 X = $6D Y = $6E RADIUS = $6F LCOL = $A6 ;Left column RCOL = $A7 TROW = $A8 ;Top row BROW = $A9 ;Bottom row DA :LINK ;link DA 1997 DFB $9E ;SYS TXT '2063:' DFB $A2 ;NEW DFB 00 ;End of line :LINK DA 0 ;end of program INSTALL LDA #PBEGIN STA POINT+1 LDA #PEND SBC #>PBEGIN STA TEMP2+1 LDA #$C0 ;Copy to $C000 STA X2+1 LDY #00 STY X2 :LOOP LDA (POINT),Y STA (X2),Y INY BNE :LOOP INC POINT+1 INC X2+1 DEC TEMP2+1 BNE :LOOP LDY TEMP2 :LOOP2 LDA (POINT),Y STA (X2),Y DEY CPY #$FF BNE :LOOP2 LDX #5 ;Copy CURRENT vectors :LOOP3 LDA ICRUNCH,X STA OLDCRNCH,X DEX BPL :LOOP3 JMP INIT TXT 'so, you want a secret message, eh? ' TXT 'narnia, narnia, narnia, awake.' TXT ' love. think. speak. be walking trees.' TXT ' be talking beasts. be divine waters.' TXT 'stephen l. judd wuz here 1/20/97' PBEGIN ORG $C000 * * Init routine -- modify vectors * and set up values. * INIT LDX #5 ;Copy vectors :LOOP LDA :TABLE,X STA ICRUNCH,X DEX BPL :LOOP INX STX ORGX STX ORGY *------------------------------- DO 0 JSR GRON ;A little init thingy LDX #20 JSR CLEARCOL ;Part of GRON LDA #160 STA CX LDA #100 STA CY LDA #00 STA CX+1 LDA #$FF ;Mode 1 STA BITMASK :ILOOP LDX :TEMP JSR CIRCENT LDA :TEMP CLC ADC #10 STA :TEMP CMP #135 BCC :ILOOP LDA #00 ;Mode 0 STA BITMASK :ILOOP2 LDX :TEMP JSR CIRCENT LDA :TEMP SEC SBC #10 STA :TEMP CMP #5 BCS :ILOOP2 FIN *------------------------------- JMP MODE17 ;Mode 17 :TEMP DFB 05 :TABLE DA CRUNCH DA LIST DA EXECUTE JMPCRUN DFB $4C ;JMP OLDCRNCH DS 2 ;Old CRUNCH vector OLDLIST DS 2 OLDEXEC DS 2 * * Keyword list * Keywords are stored as normal text, * followed by the token number. * All tokens are >128, * so they easily mark the end of the keyword * KEYWORDS TXT 'plot',E0 TXT 'line',E1 TXT 'circle',E2 TXT 'gr',91,E3 ;grON TXT 'groff',E4 ;Graphics off TXT 'mode',E5 DFB $B0 ;OR TXT 'igin',E6 TXT 'clear',E7 ;Clear bitmap TXT 'buffer',E8 ;Set draw buffer TXT 'swap',E9 ;Swap foreground and background TXT 'col',B0,EA ;Set color DFB 00 ;End of list * * Table of token locations-1 * Subtract $E0 first * Then check to make sure number isn't greater than NUMWORDS * TOKENLOC :E0 DA PLOT-1 :E1 DA LINE-1 :E2 DA CIRCLE-1 :E3 DA GRON-1 :E4 DA GROFF-1 :E5 DA MODE-1 :E6 DA ORIGIN-1 :E7 DA CLEAR-1 :E8 DA BUFFER-1 :E9 DA SWAP-1 :EA DA COLOR-1 HITOKEN EQU $EB * * CRUNCH -- If this is one of our keywords, then tokenize it * CRUNCH JSR JMPCRUN ;First crunch line normally LDY #05 ;Offset for KERNAL ;Y will contain line length+5 :LOOP STY TEMP JSR ISWORD ;Are we at a keyword? BCS :GOTCHA :NEXT JSR NEXTCHAR BNE :LOOP ;Null byte marks end STA BUF-3,Y ;00 line number LDA #$FF ;'tis what A should be RTS ;Buh-bye * Insert token and crunch line :GOTCHA LDX TEMP ;If so, A contains opcode STA BUF-5,X :MOVE INX LDA BUF-5,Y STA BUF-5,X ;Move text backwards BEQ :NEXT INY BPL :MOVE * * ISWORD -- Checks to see if word is * in table. If a word is found, then * C is set, Y is one past the last char * and A contains opcode. Otherwise, * carry is clear. * * On entry, TEMP must contain current * character position. * ISWORD LDX #00 :LOOP LDY TEMP :LOOP2 LDA KEYWORDS,X BEQ :NOTMINE CMP #$E0 BCS :RTS ;Tokens are >=$E0 CMP BUF-5,Y BNE :NEXT INY ;Success! Go to next char INX BNE :LOOP2 :NEXT INX LDA KEYWORDS,X ;Find next keyword CMP #$E0 BCC :NEXT INX BNE :LOOP ;And check again :NOTMINE CLC :RTS RTS * * NEXTCHAR finds the next char * in the buffer, skipping * spaces and quotes. On * entry, TEMP contains the * position of the last spot * read. On exit, Y contains * the index to the next char, * A contains that char, and Z is set if at end of line. * NEXTCHAR LDY TEMP :LOOP INY LDA BUF-5,Y BEQ :DONE CMP #$8F ;REM BNE :CONT LDA #00 :SKIP STA TEMP2 ;Find matching character :LOOP2 INY LDA BUF-5,Y BEQ :DONE CMP TEMP2 BNE :LOOP2 ;Skip to end of line BEQ :LOOP :CONT CMP #$20 ;Space BEQ :LOOP CMP #$22 ;Quote BEQ :SKIP :DONE RTS * * LIST -- patches the LIST routine * to list my tokens correctly. * LIST CMP #$E0 BCC :NOTMINE ;Not my token CMP #HITOKEN BCS :NOTMINE BIT $0F ;Check for quote mode BMI :NOTMINE SEC SBC #$DF ;Find the corresponding text TAX STY $49 LDY #00 :LOOP DEX BEQ :DONE :LOOP2 INY LDA KEYWORDS,Y CMP #$E0 BCC :LOOP2 INY BNE :LOOP :DONE LDA KEYWORDS,Y BMI :OUT JSR $FFD2 INY BNE :DONE :OUT CMP #$B0 ;OR BEQ :OR CMP #$E0 ;It might be BASIC token BCS :CONT ;e.g. GRON LDY $49 :NOTMINE AND #$FF JMP (OLDLIST) ;QPLOP :CONT LDY $49 JMP $A700 ;Normal exit :OR LDA #'o' ;For ORIGIN JSR CHROUT LDA #'r' JSR CHROUT INY BNE :DONE * * EXECUTE -- if this is one of my * tokens, then execute it. * EXECUTE JSR CHRGET PHP CMP #$E0 BCC :NOTMINE CMP #HITOKEN BCS :NOTMINE PLP JSR :DISP JMP $A7AE ;Exit through NEWSTT :DISP EOR #$E0 ASL ;Mult by two TAX LDA TOKENLOC+1,X PHA LDA TOKENLOC,X PHA JMP CHRGET ;Exit to routine :NOTMINE PLP JMP $A7E7 ;Normal routine * * PLOT -- plot a point! * ORGX DFB 00 ;Upper-left corner of the screen ORGY DFB 00 DONTPLOT DFB 01 ;0=Don't plot point, just compute ;coordinates (used by e.g. circles) PLOT JSR GETPAR ;Get coordinate pair LDA LINNUM ;Add in origin offset SEC SBC ORGX STA LINNUM BCS :CONT1 DEC LINNUM+1 BMI :ERROR ;Underflow SEC :CONT1 TXA SBC ORGY BCC :ERROR TAX CPX #200 ;Check range BCS :ERROR LDA LINNUM CMP #<320 LDA LINNUM+1 SBC #>320 BCC SETPOINT :ERROR RTS ;Just don't plot point *:ERROR LDX #14 * JMP (IERROR) SETPOINT ;Alternative entry point ;X=y-coord, LINNUM=x-coord * ;X is preserved * STX TEMP2 * STY TEMP2+1 ;On exit, X,Y are AND #$07 ;i.e. are set up correctly. TXA AND #248 STA POINT LSR LSR LSR ADC BASE ;Base of bitmap STA POINT+1 LDA #00 ASL POINT ROL ASL POINT ROL ASL POINT ROL ADC LINNUM+1 ADC POINT+1 STA POINT+1 TXA AND #7 TAY LDA LINNUM AND #248 CLC ;Overflow is possible! ADC POINT STA POINT BCC SETPIXEL INC POINT+1 SETPIXEL LDA LINNUM AND #$07 TAX LDA DONTPLOT BEQ :RTS LDA POINT+1 SEC SBC BASE ;Overflow check CMP #$20 BCS :RTS SEI ;Get underneath ROM LDA #$34 STA $01 LDA (POINT),Y EOR BITMASK AND BITTAB,X EOR (POINT),Y STA (POINT),Y LDA #$37 STA $01 CLI * LDX TEMP2 * LDY TEMP2+1 ;On exit, X,Y are AND #$07 ;i.e. are set up correctly. ;for more plotting :RTS RTS BITMASK DFB #$FF ;Set point BITTAB DFB $80,$40,$20,$10,$08,$04,$02,$01 *------------------------------- * Drawin' a line. A fahn lahn. * * To deal with off-screen coordinates, the current row * and column (40x25) is kept track of. These are set * negative when the point is off the screen, and made * positive when the point is within the visible screen. * Little bit position table BITCHUNK HEX FF7F3F1F0F070301 CHUNK EQU X2 OLDCHUNK EQU X2+1 * DOTTED -- Set to $01 if doing dotted draws (diligently) * X1,X2 etc. are set up above (x2=LINNUM in particular) * Format is LINE x2,y2,x1,y1 LINE JSR GETPAR STX Y2 LDA LINNUM STA X2 LDA LINNUM+1 STA X2+1 JSR CHKCOM JSR GETPAR STX Y1 :CHECK LDA X2 ;Make sure x1=y1? EOR #$FF ;Otherwise dy=y1-y2 ADC #$01 LDX #$88 ;DEY :DYPOS STA DY STX YINCDEC STX XINCDEC LDA X1 ;Sub origin from 1st point SEC SBC ORGX STA X1 LDA X1+1 SBC #00 STA X1+1 PHP ;Save carry flag STA TEMP ;Next compute column LDA X1 LSR TEMP ROR LSR TEMP ROR LSR TEMP ROR STA CX ;X-column PLP BCC :NEGX ;If negative, then fix up CMP #40 ;If past column 40, then punt! BCC :CONT1 RTS :NEGX LDA X1 ;coordinate start and count AND #$07 STA X1 LDA #00 STA X1+1 LDA CX :CONT1 LDA Y1 ;Now do the same for Y SEC SBC ORGY STA Y1 TAX ;X=y-coord PHP ;Save carry bit LSR LSR LSR STA CY ;Y-column (well, OK, row then) PLP BCC :NEGY ;If negative, then fix stuff up! SBC #25 ;Check if we are past bottom of BCC :CONT2 ;screen ORA #$80 ;Otherwise, 128+rows past 24 STA CY ;(for plot range checking) TXA AND #$07 ORA #8*24 ;Start in last row TAX BMI :CONT2 :NEGY ORA #$E0 ;Set high bits of column STA CY TXA AND #$07 TAX ;Start in 1st row :CONT2 LDA #00 STA DONTPLOT JSR SETPOINT ;Set up X,Y and POINT INC DONTPLOT LDA BITCHUNK,X STA OLDCHUNK STA CHUNK SEI ;Get underneath ROM LDA #$34 STA $01 LDX DY CPX DX ;Who's bigger: dy or dx? BCC STEPINX ;If dx, then... LDA DX+1 BNE STEPINX * * Big steps in Y * * To simplify my life, just use PLOT to plot points. * * No more! * Added special plotting routine -- cool! * * X is now counter, Y is y-coordinate * * On entry, X=DY=number of loop iterations, and Y= * Y1 AND #$07 STEPINY LDA #00 STA OLDCHUNK ;So plotting routine will work right LDA CHUNK SEC LSR ;Strip the bit EOR CHUNK STA CHUNK TXA BNE :CONT ;If dy=0 it's just a point INX :CONT LSR ;Init counter to dy/2 * * Main loop * YLOOP STA TEMP * JSR LINEPLOT LDA CX ;Range check ORA CY BMI :SKIP LDA (POINT),Y ;Otherwise plot EOR BITMASK AND CHUNK EOR (POINT),Y STA (POINT),Y :SKIP YINCDEC INY ;Advance Y coordinate CPY #8 BCC :CONT ;No prob if Y=0..7 JSR FIXY :CONT LDA TEMP ;Restore A SEC SBC DX BCC YFIXX YCONT DEX ;X is counter BNE YLOOP YCONT2 LDA (POINT),Y ;Plot endpoint EOR BITMASK AND CHUNK EOR (POINT),Y STA (POINT),Y YDONE LDA #$37 STA $01 CLI RTS YFIXX ;x=x+1 ADC DY LSR CHUNK BNE YCONT ;If we pass a column boundary... ROR CHUNK ;then reset CHUNK to $80 STA TEMP2 LDA CX BMI :CONT ;Skip if column is negative CMP #39 ;End if move past end of screen BCS YDONE LDA POINT ;And add 8 to POINT ADC #8 STA POINT BCC :CONT INC POINT+1 :CONT INC CX ;Increment column LDA TEMP2 DEX BNE YLOOP BEQ YCONT2 * * Big steps in X direction * * On entry, X=DY=number of loop iterations, and Y= * Y1 AND #$07 COUNTHI DFB 00 ;Temporary counter ;only used once STEPINX LDX DX LDA DX+1 STA COUNTHI LSR ;Need bit for initialization STA Y1 ;High byte of counter TXA BNE :CONT ;Could be $100 DEC COUNTHI :CONT ROR * * Main loop * XLOOP LSR CHUNK BEQ XFIXC ;If we pass a column boundary... XCONT1 SBC DY BCC XFIXY ;Time to step in Y? XCONT2 DEX BNE XLOOP DEC COUNTHI ;High bits set? BPL XLOOP XDONE LSR CHUNK ;Advance to last point JSR LINEPLOT ;Plot the last chunk EXIT LDA #$37 STA $01 CLI RTS * * CHUNK has passed a column, so plot and increment pointer * and fix up CHUNK, OLDCHUNK. * XFIXC STA TEMP JSR LINEPLOT LDA #$FF STA CHUNK STA OLDCHUNK LDA CX BMI :CONT ;Skip if column is negative CMP #39 ;End if move past end of screen BCS EXIT LDA POINT ADC #8 STA POINT BCC :CONT INC POINT+1 :CONT INC CX LDA TEMP JMP XCONT1 * * Check to make sure there isn't a high bit, plot chunk, * and update Y-coordinate. * XFIXY DEC Y1 ;Maybe high bit set BPL XCONT2 ADC DX STA TEMP LDA DX+1 ADC #$FF ;Hi byte STA Y1 JSR LINEPLOT ;Plot chunk LDA CHUNK STA OLDCHUNK LDA TEMP XINCDEC INY ;Y-coord CPY #8 ;0..7 is ok BCC XCONT2 STA TEMP JSR FIXY LDA TEMP JMP XCONT2 * * Subroutine to plot chunks/points (to save a little * room, gray hair, etc.) * LINEPLOT ;Plot the line chunk LDA CX ORA CY BMI :SKIP LDA (POINT),Y ;Otherwise plot EOR BITMASK ORA CHUNK AND OLDCHUNK EOR CHUNK EOR (POINT),Y STA (POINT),Y :SKIP RTS * * Subroutine to fix up pointer when Y decreases through * zero or increases through 7. * FIXY CPY #255 ;Y=255 or Y=8 BEQ :DECPTR :INCPTR ;Add 320 to pointer LDY #0 ;Y increased through 7 LDA CY BMI :CONT1 ;If negative, then don't update CMP #24 BCS :TOAST ;If at bottom of screen then quit LDA POINT ADC #<320 STA POINT LDA POINT+1 ADC #>320 STA POINT+1 :CONT1 INC CY RTS :DECPTR ;Okay, subtract 320 then LDY #7 ;Y decreased through 0 LDA CY BEQ :TOAST BMI :CONT2 CMP #$7F ;It is possible we just decreased BNE :C1 ;through row 25 LDA #24 STA CY ;In which case, set correct row :C1 LDA POINT SEC SBC #<320 STA POINT LDA POINT+1 SBC #>320 STA POINT+1 :CONT2 DEC CY RTS :TOAST PLA ;Remove old return address PLA JMP EXIT ;Restore interrupts, etc. * * CIRCLE draws a circle of course, using my * super-sneaky algorithm. * CIRCLE cx,cy,radius (16,8,8) * CIRCLE JSR GETPAR STX CY ;CX,CY = center LDA X1 SEC SBC ORGX STA CX STA X1 LDA X1+1 SBC #00 STA CX+1 STA X1+1 PHP ;Save carry LSR ;Compute which column we start LDA CX ;in ROR LSR LSR PLP BCS :CONT ;Underflow means negative column TAX LDA X1 ;Set X to first column AND #$07 STA X1 LDA #00 STA X1+1 TXA ORA #$E0 ;so set high bits :CONT STA RCOL STA LCOL BMI :SKIP CMP #40 ;Check for benefit of SETPOINT BCC :SKIP LDA X1 ;Set X in last column AND #$07 ORA #64-8 ;312+X AND 7 STA X1 LDA #1 STA X1+1 :SKIP JSR CHKCOM JSR GETBYT CIRCENT ;Alternative entry point STX Y STX RADIUS TXA BNE :C ;Skip R=0 LDX CY JMP SETPOINT ;Plot it as a point. :C CLC ADC CY BCS :BLAH SEC SBC ORGY BCS :C4 ;cy+y200 then set pointer to BCC :C2 ;last row, but set TROW CLC ;correctly :C3 TAY AND #$07 ORA #$C0 ;Last row, set Y1 correctly TAX TYA :C2 ROR LSR LSR STA TROW ;Top row LDA #00 STA DONTPLOT ;Don't plot points JSR SETPOINT ;Plot XC,YC+Y STY Y2 ;Y AND 07 LDA BITCHUNK,X STA CHUNK1 ;Forwards chunk STA OLDCH1 LSR EOR #$FF STA CHUNK2 ;Backwards chunk STA OLDCH2 LDA POINT STA TEMP2 ;TEMP2 = forwards high pointer STA X2 ;X2 = backwards high pointer LDA POINT+1 STA TEMP2+1 STA X2+1 LDA CY ;Now compute upper points SEC SBC ORGY BCS :CSET SEC ;We are so very negative SBC Y CLC BCC :BNEG :CSET SBC Y ;Compute CY-Y-ORGY :BNEG PHP TAX LSR ;Compute row LSR LSR STA BROW PLP BCS :CONT ORA #$E0 ;Make row negative STA BROW TXA AND #07 ;Handle underflow special! TAX :CONT JSR SETPOINT ;Compute new coords STY Y1 LDA POINT STA X1 ;X1 will be the backwards LDA POINT+1 ;low-pointer STA X1+1 ;POINT will be forwards SEI ;Get underneath ROM LDA #$34 STA $01 LDA Y LSR ;A=r/2 LDX #00 STX X ;y=0 * Main loop :LOOP INC X ;x=x+1 LSR CHUNK1 ;Right chunk BNE :CONT1 JSR UPCHUNK1 ;Update if we move past a column :CONT1 ASL CHUNK2 BNE :CONT2 JSR UPCHUNK2 :CONT2 ;LDA TEMP SEC SBC X ;a=a-x BCS :LOOP ADC Y ;if a<0 then a=a+y; y=y-1 TAX JSR PCHUNK1 JSR PCHUNK2 LDA CHUNK1 STA OLDCH1 LDA CHUNK2 STA OLDCH2 TXA DEC Y ;(y=y-1) DEC Y2 ;Decrement y-offest for upper BPL :CONT3 ;points JSR DECYOFF :CONT3 LDY Y1 INY STY Y1 CPY #8 BCC :CONT4 JSR INCYOFF :CONT4 LDY X CPY Y ;if y<=x then punt BCC :LOOP ;Now draw the other half * * Draw the other half of the circle by exactly reversing * the above! * NEXTHALF LSR OLDCH1 ;Only plot a bit at a time ASL OLDCH2 LDA RADIUS ;A=-R/2-1 LSR EOR #$FF :LOOP TAX JSR PCHUNK1 ;Plot points JSR PCHUNK2 TXA DEC Y2 ;Y2=bottom BPL :CONT1 JSR DECYOFF :CONT1 INC Y1 LDY Y1 CPY #8 BCC :CONT2 JSR INCYOFF :CONT2 LDX Y BEQ :DONE CLC ADC Y ;a=a+y DEC Y ;y=y-1 BCC :LOOP INC X SBC X ;if a<0 then x=x+1; a=a+x LSR CHUNK1 BNE :CONT3 TAX JSR UPCH1 ;Upchunk, but no plot :CONT3 LSR OLDCH1 ;Only the bits... ASL CHUNK2 ;Fix chunks BNE :CONT4 TAX JSR UPCH2 :CONT4 ASL OLDCH2 BCS :LOOP :DONE CIRCEXIT ;Restore interrupts LDA #$37 STA $01 CLI LDA #1 ;Re-enable plotting STA DONTPLOT RTS * * Decrement upper pointers * DECYOFF TAY LDA #7 STA Y2 LDA TROW ;First check to see if Y is in BEQ EXIT2 CMP #25 ;range (rows 0-24) BCS :SKIP LDA X2 ;If we pass through zero, then SEC SBC #<320 ;subtract 320 STA X2 LDA X2+1 SBC #>320 STA X2+1 LDA TEMP2 SEC SBC #<320 STA TEMP2 LDA TEMP2+1 SBC #>320 STA TEMP2+1 :SKIP TYA DEC TROW RTS EXIT2 PLA ;Grab return address PLA JMP CIRCEXIT ;Restore interrupts, etc. * Increment lower pointers INCYOFF TAY LDA #00 STA Y1 LDA BROW BMI :ISKIP ;If <0 then don't update pointer. CMP #24 ;If we hit bottom of screen then BEQ EXIT2 ;just quit LDA X1 CLC ADC #<320 STA X1 LDA X1+1 ADC #>320 STA X1+1 LDA POINT CLC ADC #<320 STA POINT LDA POINT+1 ADC #>320 STA POINT+1 :ISKIP TYA INC BROW RTS * * UPCHUNK1 -- Update right-moving chunk pointers * Due to passing through a column * UPCHUNK1 TAX JSR PCHUNK1 UPCH1 LDA #$FF ;Alternative entry point STA CHUNK1 STA OLDCH1 LDA RCOL BMI :DONE ;Can start negative LDA TEMP2 CLC ADC #8 STA TEMP2 BCC :CONT INC TEMP2+1 CLC :CONT LDA POINT ADC #8 STA POINT BCC :DONE INC POINT+1 :DONE TXA INC RCOL RTS * * UPCHUNK2 -- Update left-moving chunk pointers * UPCHUNK2 TAX JSR PCHUNK2 UPCH2 LDA #$FF STA CHUNK2 STA OLDCH2 LDA LCOL CMP #40 BCS :DONE LDA X2 SEC SBC #8 STA X2 BCS :CONT DEC X2+1 SEC :CONT LDA X1 SBC #8 STA X1 BCS :DONE DEC X1+1 :DONE TXA DEC LCOL RTS * * Plot right-moving chunk pairs for circle routine * PCHUNK1 LDA RCOL ;Make sure we're in range CMP #40 BCS :SKIP2 LDA CHUNK1 ;Otherwise plot EOR OLDCH1 STA TEMP LDA BROW ;Check for underflow BMI :SKIP LDY Y1 LDA (POINT),Y EOR BITMASK AND TEMP EOR (POINT),Y STA (POINT),Y :SKIP LDA TROW ;If CY+Y >= 200... CMP #25 BCS :SKIP2 LDY Y2 LDA (TEMP2),Y EOR BITMASK AND TEMP EOR (TEMP2),Y STA (TEMP2),Y :SKIP2 RTS * * Plot left-moving chunk pairs for circle routine * PCHUNK2 LDA LCOL ;Range check in X CMP #40 BCS :SKIP2 LDA CHUNK2 ;Otherwise plot EOR OLDCH2 STA TEMP LDA BROW ;Check for underflow BMI :SKIP LDY Y1 LDA (X1),Y EOR BITMASK AND TEMP EOR (X1),Y STA (X1),Y :SKIP LDA TROW ;If CY+Y >= 200... CMP #25 BCS :SKIP2 LDY Y2 LDA (X2),Y EOR BITMASK AND TEMP EOR (X2),Y STA (X2),Y :SKIP2 RTS * * GRON -- turn graphics on. If a number appears * afterwards, then initialize the colormap to that * number and clear the bitmap. * BASE DFB $E0 ;Address of bitmap, hi byte BANK DFB 0 ;Bank 3=default OLDBANK DFB $FF ;VIC old bank OLDD018 DFB 00 GRON LDA $D011 ;Skip if bitmap is already on. AND #$20 BNE CLEAR LDA $DD02 ;Set the data direction regs ORA #3 STA $DD02 LDA $DD00 PHA AND #$03 STA OLDBANK PLA AND #252 ORA BANK STA $DD00 LDA $D018 STA OLDD018 LDA #$38 ;Set color map to base+$1C00 STA $D018 ;bitmap to 2nd 8k LDA $D011 ;And turn on bitmap ORA #$20 STA $D011 CLEAR JSR CHRGOT ;See if there's a color BEQ GRONDONE JSR GETBYT ;Get the char CLEARCOL LDA #00 ;Low byte of base address STA POINT LDA BASE ;Colormap is at base-$14 SEC SBC #$14 STA POINT+1 TXA LDY #00 LDX #4 :LOOP STA (POINT),Y INY BNE :LOOP INC POINT+1 DEX BNE :LOOP LDA BASE ;Now clear bitmap STA POINT+1 LDX #32 TYA :LOOP2 STA (POINT),Y INY BNE :LOOP2 INC POINT+1 DEX BNE :LOOP2 GRONDONE RTS * GROFF -- Restore old values if graphics are on. GROFF LDA $D011 AND #$20 BEQ GDONE GSET LDA $DD02 ;Set the data direction regs ORA #3 STA $DD02 LDA $DD00 AND #$7C ORA OLDBANK STA $DD00 LDA OLDD018 STA $D018 LDA $D011 AND #$FF-$20 STA $D011 GDONE RTS * * COLOR -- Set drawing color * COLOR JSR GETBYT COLENT CPX #00 ;MODE enters here BEQ :C2 :C1 CPX #01 BNE :RTS LDX #$FF :C2 STX BITMASK :RTS RTS * * MODE -- catch-all command. Currently implemented: * 00 Erase (background color) * 01 Foreground color * 16 SuperCPU mode -- screen -> A000, etc. * 17 Normal mode * 18 Double buffer mode * * Anything else -> BITMASK * MODENUM DFB 17 ;Current mode MODE JSR GETBYT CPX #2 BCC COLENT :C16 CPX #16 BNE :C18 STX MODENUM :SET16 LDA #$A0 ;Bitmap -> $A000 STA BASE LDA #01 STA BANK ;Bank 2 STA OLDBANK LDA #$FF ;End of BASIC memory STA $37 STA $33 LDA #$87 STA $38 STA $34 LDA #$24 ;Screen mem -> $8800 STA OLDD018 JSR GSET ;Part of GROFF LDA #$88 STA 648 ;Tell BASIC where the screen is STA $D07E ;Enable SuperCPU regs STA $D074 ;Bank 2 optimization STA $D07F ;Disable regs RTS :C18 CPX #18 ;Double-buffer mode! BNE :C17 STX MODENUM JSR :SET16 ;Set up mode 16 STA $D07E STA $D077 ;Turn off optimization STA $D07F RTS :C17 CPX #17 BNE MODEDONE MODE17 STX MODENUM LDA #$E0 STA BASE LDA #00 ;Bank 3 STA BANK LDA #3 ;Bank 0 == normal bank STA OLDBANK LDA #$FF STA $37 STA $33 LDA #$9F STA $38 STA $34 LDA #$14 ;Screen mem -> $0400 STA OLDD018 JSR GSET ;Part of GROFF LDA #$04 STA 648 ;Tell BASIC where the screen is STA $D07E STA $D077 ;No optimization STA $D07F RTS MODEDONE STX BITMASK RTS * * BUFFER -- Sets the current drawing buffer to 1 or 2, * depending on arg being even or odd. If double- * buffer mode is not enabled then punt. * * Now, buffer=0 swaps draw buffers, even/odd otherwise. * BUFFER JSR GETBYT LDA MODENUM CMP #18 BNE :PUNT LDY #$A0 TXA BNE :CONT CPY BASE BNE :CONT LDA #1 :CONT LSR BCC :LOW ;even = low buffer LDY #$E0 ;odd = high buffer :LOW STY BASE :PUNT RTS * * SWAP -- Swap displayed buffers. MODE 18 must * be enabled first. * SWAP LDA MODENUM CMP #18 BNE :PUNT LDA $DD00 ;Ooooooohhh, real tough! EOR #$01 STA $DD00 :PUNT RTS * * ORIGIN -- Set upper-left corner of the screen to * new coordinate offset. * ORIGIN JSR GETBYT STX ORGX JSR CHKCOM JSR GETBYT STX ORGY RTS ORG ;re-org PEND ;To get that label right :)