; rad -- a 1k minigame for 2002 ; ; slj Aug 2002 ; email: sjudd@ffd2.com ; processor 6502 org $7ae7 ;sys 31463 ; org $8000 ; ; positions are stored like sprites, i.e. x followed by y. This makes ; sprite access easier, and lets code be reused. The position list is ; the object list. Objects are ; 0 ship ; 1 chaff ; 2-5 missiles ; 6-7 hunter-killers ; 8-X factories ; ; Note that h/k's are between missiles and factories. This means that ; missile routines (like homing) is easily extended to h/k's, as are ; factory routines (like firing a missile). ; SHIPPOS = 0 ;offset of ship data in list ;CHAFFPOS = 2 MISSPOS = 4 NUMMISS = 4 TOPMISS = 10 HKPOS = 12 LASTPOS = 16 SPREND = 16 ;end of sprites FACPOS = 16 ;factories NUMFACS = 8 FACEND = FACPOS + 2*NUMFACS reload = $a3 ;will load from reload-FACPOS poshi = $70 ;xpos = 04, ypos = 05 poslo = $50 ;xpos = 02, ypos = 03 velocity = $40 ;xv = 06, yv = 07 lifetime = $20 ;active object list timebomb = $05 timer = $06 ;two bytes maxmiss = $08 ;maximum number of missiles redraw = $09 irqtemp = $0a ;two bytes irqcount = $0c ;two bytes tempvel = irqcount ;used to fire shots -- two bytes irqsign = $0e ;sign of screen coord delta miscount = $0f irqpunt = $10 ;offscreen flag killfac = $11 explode = $12 facsleft = $13 ; Fixmap uses temp, datap ; datap = $d0 count = $d2 ;count2 = $f3 temp = $a9 ;tempx = count ;tempy = count2 ; render uses: temp, screenp, rtsp ;column = $f0 ;coloff = $f1 ;column offset (used by Render) screenp = datap rtsp = count ;optimize all this crap ;temp = $f4 SpritePos = $0f00 MapPos = $1000 ;DataLo = $5000 ;DataHi = $5100 renlo = $5200 renhi = $5300 BlastRow = $6000 ;Start of row rendering code Blast2 = BlastRow + 13*128 ;13 pages total ($0d00) RowSize = 128 ColSize = RowSize MapSize = RowSize*ColSize lastrow = RowSize-1 lastcol = ColSize-1 ; ; Set up stuff to imitate real conditions ; FakeInit ; fake init begins here if 0 lda #$37 sta $01 ; sta redraw lda #00 tay jmp Init endif ;-------------------------------------------------- ; real code starts here ;-------------------------------------------------- ; ; Real init routine -- set up tables, grow map ; ; On entry: .A=.Y=0, $01=$37 ; Init subroutine ; zero out map memory ; sta temp ;entry: .a=.y=0 jsr FixMap ;exit: .x=.y=.a=0 ; init zero page ;0ptimize -- we don't use memory under ROM? ; dec $01 ; ldx #$02 ;zero out velocity, position, all zp .l0 sta $02,x inx bne .l0 ; Compute pointer table ; table of f(x) = 13*x -- used for renderer ;.a = .x = .y = 0 ldy #>BlastRow .loop sta renlo,x clc ;optimize? adc #13 pha tya sta renhi,x adc #00 tay pla inx bpl .loop ;.x=$80 ; fix up FixMap lda #$d0 ;BNE opcode sta modbne ;fix for map grow ; initialize rnd generator stx $d401+14 ; dec $d401+14 ;set to $ff stx $d404+14 ; disable interrupt dex ;.x = $7f stx $dc0d ;disable interrupt ; generate render code subroutine lda #16 sta lifetime+SHIPPOS ;fixme? lda #64 ;0ptimize? ; asl sta count ldy #00 ;optimize! .l0 ldx #00 .l1 lda spritevals,x ;init sprite tables here sta $07f8,x ;must occur before char copy lda rencode,x .sta1 sta BlastRow,y .sta2 sta Blast2,y iny bne .c1 inc .sta1+2 inc .sta2+2 .c1 inx cpx #13 bne .l1 lda Mappos+1 ;add 128 eor #$80 sta Mappos+1 bne .l0 ;.a = 0 inc Mappos+2 dec count bne .l0 ;128 instances total ;.x = 13, .a=0, .y=? ; seed map ldx #FACEND-1 .l11 ;stx temp lda $d41b ;get rnd and #$fe sta poshi,x ;y coord lsr ;replaces AND #127 tay dex lda $d41b ;update is too slow? eor #$ff ;otherwise they all lie in a line ; and #ColSize-1 and #$fe sta poshi,x ;x-coord lsr ;replaces AND #127 jsr SetDatap lda #8 ;"factory" sta (datap),y sta lifetime,x ;set lifetime inc facsleft ;total count dex cpx #FACPOS bcs .l11 ;.x = FACPOS ; grow map: loop through all locations, ; count adjacent cells, grow randomly if ; count is large enough ; subroutine ; lda #4 ;FIXME if only one level used ; sta temp lda #10 ; sta count2 ;for growth, below sta count ;for growth, below .bigloop ldx #lastcol-1 .l1 ldy #lastrow+1 ;+1 will do some wraparound stuff .l2 lda #3 sta temp lda #00 inx .l3 pha ;count adjacent cells jsr SetDatapx pla iny ;row adc (datap),y dey adc (datap),y dey adc (datap),y iny dex ;col dec temp bne .l3 ;.a now contains sum inx inx ;center cell ; cmp temp ;grow if sum greater than level cmp #4 bcc .skip lda $d41b ;Grow randomly ; cmp #64 ; bcs .skip bmi .skip jsr SetDatapx lda (datap),y ;factory check -- only grow nonzero parts bne .skip lda #$01 ;any neg number will do sta (datap),y .skip dey ;row bne .l2 inc $d020 ;FIXME? dex bne .l1 lda #4 jsr FixMap ;exit: .x=.y=0 ; dec count2 dec count bne .bigloop ; set up charset data at $0800 ; this routine is also used to generate sprite data. The sprite data ; is generated at $0800+96, in eight-byte (mirrored) chunks. Since the ; chars are arranged differently from sprites (2 bytes wide versus 3 bytes) ; a second routine is used to copy the sprite data from $08xx to $0f00 ; ; .x=0 subroutine ; stx count2 ;tile index ;FIXME -- use self-mod code instead? .loop lda #8 sta count .l1 txa eor #7 ; sta temp ;x = 0..7, y = 7..0 ; ldy count2 ; lda tiletab,y ; ldy temp tay .lda lda tiletab sta $0800,x sta $0810,y ;flip bits sta temp ;invert bits lda #1 .inv lsr temp rol bcc .inv sta $0808,x ;c set sta $0818,y inx ; inc count2 inc .lda+1 ;note: fails if "tiletab" is near page boundary dec count bne .l1 txa adc #23 ;c set -> +32 from original offset tax ; cpx #LENTILES ;64 = 2 4x4 tiles bcc .loop ;.a = .x = 0, .y = $e0, count = 0 ; set up sprite data ; ldx #7 ;0ptimize!!! ;.l4 lda spritevals,x ; sta $07f8,x ; dex ; bpl .l4 ;.x = 0 tay ;.y=0 is first offset .next lda #8 sta temp .col lda $0800+96,x ;copy one column of sprite data sta SpritePos,y iny iny iny inx dec temp bne .col inc .ldy+1 ;note -- will fail if spritemem near page boundary .ldy ldy spritemem-1 bpl .next .done ; initialize VIC ; init screen colors ; lda #$0f sta $0286 ;a = ? jsr $e544 ; FIXME on all of this ; lda #$13 ;fixme? :( ; sta $d011 lsr $d011 lda #$12 sta $d018 ; lda #$12 ;0ptimize -- move above sta $d012 lda #MainIRQ sta $0315 ; ldx #1 ;.x = 1 ; stx $d01a ;enable interrupt inc $d01a ;RESET -- will fail if restarted ; ; main wait loop ; subroutine .r jsr Render ;optimize -- no jsr needed .w ldx killfac beq .c1 lda poshi,x lsr tay lda poshi-1,x lsr ;optimize -- all a repeat of init code jsr SetDatap lda #4 ;optimize - lda #00? sta (datap),y lda #00 sta killfac dec facsleft .inc inc $d020 ;dumb -- fixme lda facsleft beq .inc .c1 lda redraw ; cmp #SHIPPOS ; bcc .w ; bcs .r bpl .r bmi .w ;jeez -- fixme ;--------------------------------- ; Main irq loop -- update screen, ; get input, update variables ;--------------------------------- MainIRQ ;--------------------------------- ; Second IRQ routine -- update ; VIC stuff ;--------------------------------- subroutine irq2 lda poslo+SHIPPOS ;x-coord, lower 3 bits eor #$07 sta $d016 lda poslo+1+SHIPPOS ;y-coord eor #7 ora #$10 sta $d011 ; fix background color -- will flash when hit lda #$06 ;possible optimize -- use 7 above sta $d021 ; set sprite coordinates and enable ldx #SPREND-1 ;highest coord .loop lsr irqpunt ;flag - high bit set if off screen ldy #1 ;y-coord first jsr diffcoord dex dey jsr diffcoord ;then x-coord lda irqsign ;high bit set if we are left of ship bpl .rol2 ;in which case, must force c=0! clc .rol2 rol irqtemp+1 ;high bit clc lda irqpunt ;high bit set -> off-screen bmi .rol lda lifetime,x cmp #1 ;lifetime = 0 -> c clear .rol rol irqtemp .dex dex bpl .loop ; lsr ;1 = active, 0=inactive ; cmp #1 ;0 = inactive ; beq .rol ; sec ; rol irqtemp ; bcc .loop ;keep going til all 8 sprites in reg lda irqtemp sta $d015 lda irqtemp+1 sta $d010 ; check for collisions subroutine lda facsleft ;don't kill if you've won! beq .done lda $d01e lsr ;0 = ship bcc .done lsr ;1 = chaff -- optimize? ldx #MISSPOS .loop lsr bcs .found inx inx cpx #TOPMISS+2 bne .loop beq .done ;bleah -- fixme .found lda #00 sta lifetime,x dec lifetime+SHIPPOS .dead dec $d021 lda lifetime+SHIPPOS beq .dead .done ; do a factory "explosion" .facdead lda explode beq .nope dec explode sta $d020 .nope ; all done! ;----------------------------- ; irq1 -- update positions, ; variables, internal stuff ;----------------------------- subroutine irq1 ; inc $d020 ;fixme dec timer bpl .nocheck lda #5 sta timer ; flash sprite when death is nigh lda #3 cmp lifetime+SHIPPOS bcc .ok eor $d027 sta $d027 .ok ; master timer -- alter gameplay as time goes on to be more intense ; inc timer+1 inc timer+1 bne .skip2 lda #3 cmp maxmiss bcs .incmiss ;launch h/k ; cmp lifetime+HKPOS ; bne .shrek ; sta lifetime+HKPOS+2 .shrek sta lifetime+HKPOS byte $2c .incmiss inc maxmiss .skip2 ; read joystick .joystick ldx #SHIPPOS+1 ;y-position first ldy #0 ;max velocity ; sty tempvel ; sty tempvel+1 ;joystick direction lda $dc00 ;read joystick ; cmp #$7f ; bne .c0 ; ; ldx #1 ;.stop lda velocity,x ;decelerate ; beq .dex ; bmi .inc ; dec velocity,x ; byte $2c ;.inc inc velocity,x ; dex ;.dex beq .stop ; bne .update .c0 lsr ;up bcs .c1 jsr DecVelocity ; dec tempvel+1 .c1 lsr ;down bcs .c2 jsr IncVelocity ; inc tempvel+1 .c2 dex ;x-coords lsr bcs .c3 ;left jsr DecVelocity ; dec tempvel .c3 lsr bcs .c4 ;right jsr IncVelocity ; inc tempvel .c4 ldx timebomb bne .decbomb lsr ;fire bcs .nocheck ; bomb factory lda #6 sta timebomb ldx #FACPOS .floop lda #2 jsr CheckRange bcs .inx inc $d020 dec lifetime-1,x ;a hit bne .inx stx killfac stx explode .inx inx cpx #FACEND bne .floop .decbomb dec timebomb .nocheck ; update chaff -- basically, chaff is fixed during its lifetime, ; and set to the current ship position otherwise, ;------------- if 0 ;out of space, alas... lda lifetime+CHAFFPOS bne .dec ldx #SHIPPOS+1 ldy #CHAFFPOS lda $dc01 and #$10 ;check for space bne .nochaff lda #200 ;can optimize -- use eor #$10 below byte $2c .nochaff lda #00 ;will set chaffpos to shippos .set jsr SetLifetime byte $2c .dec dec lifetime+CHAFFPOS endif ;------------- ; factory range check subroutine .facs ; ldx #FACPOS ;factories in object list ldx #HKPOS ;factories AND h/k's .floop lda #19 ;max range jsr CheckRange ;c set if failed lda reload-FACPOS,x bne .dec bcs .inx ;c set by CheckRange ; jsr FireMissile ;0ptimize ; Fire (instantiate) missile ; .x = factory position (y-coord) ;FireMissile lda maxmiss asl adc #MISSPOS ;fixme? MISSPOS+2? tay ; ldy #TOPMISS+2 .l1 dey dey cpy #MISSPOS bcc .skip lda lifetime,y ;check for open slot bne .l1 lda #160 sta reload-FACPOS,x lda #64 sta lifetime,y ;turn missile on and set lifetime lda poshi-1,x ;x-coord sta poshi,y ;copy coords lda poshi,x sta poshi+1,y .skip .dec dec reload-FACPOS,x .inx inx cpx #FACEND bne .floop ; run missiles - algorithm is to simply accelerate towards the target ; since this routine decrements lifetimes it is also used for bombs. subroutine .miss dec miscount bpl .skip ldx #4 ;FIXME? stx miscount ; ldy #2 ;max velocity index ; ldx #TOPMISS+1 ;update missile lifetimes ldx #LASTPOS-1 ;update missile AND hk lifetimes .loop ldy #2 ; lda lifetime-1,x ;0ptimize ; beq .dead cpx #HKPOS bcs .c0 dey ;.y = 2/3 for h/k's .c0 ; ldy #2 ; lda lifetime-1,x ;0ptimize ; beq .dead ; cpx #HKPOS ; bcs .nodec ; dey ;regular missile -> 1 ; dec lifetime-1,x ; byte $2c ;.dead sta poshi-1,x ;this will reset e.g. h/k's ;.nodec ;note dead objects get updated, otherwise dex ;stuff is complicated lda poshi+SHIPPOS+1 jsr HomeIn ;y-coord dex ; lda poshi+CHAFFPOS lda poshi+SHIPPOS jsr HomeIn ;x-coord lda lifetime,x ;optimize beq .dead cpx #HKPOS bcs .nodec dec lifetime,x byte $2c .dead sta poshi,x ;this will reset e.g. h/k's .nodec dex cpx #MISSPOS bcs .loop .skip ; update positions subroutine .update ldx #LASTPOS-1 ;last in list .ul ;.ul jsr update ;fixme? ;update lda poslo,x ;pos = pos + v clc adc velocity,x cmp #8 bcc .cont bmi .neg sbc #8 ;c set inc poshi,x bcs .flag ;always taken .neg adc #7 ;c set dec poshi,x .flag cpx #SHIPPOS+2 ;SHIP is object 0 now ; bcs .cont ; inc redraw ;start render process ror redraw ;c clear -> render! .cont sta poslo,x dex bpl .ul ;.x = $ff ; all done lsr $d019 jmp $ea81 ; ; accelerate ; subroutine HomeIn ;homing algorithm cmp poshi,x beq .rts2 ;fixme? what happens without it? :) bpl IncVelocity ;if ship-me>0, move right ;else move left DecVelocity pha lda velocity,x cmp negmaxvelocity,y beq .rts dec velocity,x .rts pla .rts2 rts IncVelocity pha lda velocity,x cmp posmaxvelocity,y beq .rts inc velocity,x pla rts ; ; Range check ; ; On entry: .A = max range .X = object index ; On exit: .A = distance, C clear/set if in/out of range, .X advanced ; ; uses irqtemp ; subroutine ;CheckXRange CheckRange sta irqtemp lda lifetime,x beq .norange ldy #SHIPPOS-1 ;will iny below jsr CheckYRange inx bcs .rts CheckYRange iny lda poshi,x sec sbc poshi,y bpl .c1 eor #$ff .c1 cmp irqtemp .rts rts .norange inx sec rts ; ; compute coordinate difference ; on exit, c set indicates overflow! ; scoffset byte 159+24-4, 150-4 diffcoord lda poslo,x sec sbc poslo+SHIPPOS,y and #$07 sta irqsign ;temp lda poshi,x sbc poshi+SHIPPOS,y cmp #-19 ;punt if we're off the screen bcs .ok cmp #19 bcs .punt .ok asl asl asl ora irqsign ;full expression, carry and all ror irqsign ;c set if neg (left of ship) clc adc scoffset,y ;add screen offset to get screen coord sta $d000,x ;and store! rts .punt ror irqpunt ;flag rts ;--------------------------------- ; ; render screen ; ; previously on entry; now set up in render routine ; temp = row offset (0 or 2) ; .y = data column offset ; .x = data row offset ; .a = ? ; c clear ; coloff<128 = no column offset ; coloff>128 = offset column ; ; on exit, redraw flag is reset to high bit set ; ; uses: temp, screenp, rtsp ;--------------------------------- Render subroutine sec ror redraw ;high bit ; compute y-coord stuff lda poshi+SHIPPOS+1 ;y-coord sec sbc #12 ;offset by 11 rows = 5.5 map coords ;(should be 11, but 12 works better with collision ; shortcuts) lsr tax ;row offset in C lda #00 sta screenp ; sta coloff ;basically, either start at 0 or -1 rol rol ;c is now clear sta temp ;0/2 = row offset lda #$04 sta screenp+1 ; and x-coord stuff lda poshi+SHIPPOS ;x-coord sec sbc #19 ;offset screen 19 cols (9.5 map coords) lsr ;note automatically fixes wraparound tay ;map coordinate -- start column ;c contains col offset ;optimize -- can locate JMP xxxx in zp, reuse zp pointer, update ; renlo table to save a few bytes (?) lda renlo,y ;compute jsr address and ending rts sta .jsr+1 sta rtsp ;ending rts is jsr address + 259 (256 + 3) lda renhi,y sta .jsr+2 sta rtsp+1 inc rtsp+1 ldy #3 bcc .lda ;c = column offset still ; dec coloff ;start at -1 dec screenp dec screenp+1 ldy #11 .lda lda #$60 ;RTS sta (rtsp),y ;will restore both to INY at end plotrow ; ldy coloff ;0 or -1 ldy #00 clc .jsr jsr $a9a9 ;render a row ($a9 common byte -> better compression) ; lda redraw ;d3bug? f1xme? ; bpl .alldone lda temp ;advance every other row eor #2 sta temp bne .c1 inx bpl .c1 ldx #00 ;wraparound .c1 lda screenp clc adc #40 sta screenp bcc .c2 inc screenp+1 .c2 cmp #$e8 ;$07e8 is row 25 beq .alldone cmp #$e7 bne plotrow .alldone lda #$c8 ;INY ldy #3 sta (rtsp),y ldy #11 sta (rtsp),y rts ; ; Set data pointer to column in .A (x-coord) ; SetDatapx txa SetDatap lsr ;offset is 128*coord pha lda #00 ror ;c is clear sta datap pla adc #>MapPos ;optimize - ORA for MapPos = $4000, $8000, $c000 sta datap+1 rts ; ; FixMap -- used both to zero out map memory, and to "grow" it ; after one iteration. ; ; On entry: .Y = 0, .a = value to be stored ; On exit: .X = .Y = 0 ; ; Fixmap uses temp, datap ; FixMap subroutine sta temp sty datap lda #>MapPos-1 ;Clear one page for sprites at $0f00 sta datap+1 ldx #>MapSize+1 .l1 lda (datap),y cmp #$01 modbne bit $04 ;changed to bpl .c1 lda temp sta (datap),y .c1 iny bne .l1 inc datap+1 dex bne .l1 rts ;.X = .Y = 0 ; this code is expanded to lda MapPos+128, +256, etc. and doubled up ; to handle +128 wraparound. The code is then called polygonamy-style, ; with a JSR to the appropriate place and an RTS inserted appropriately. rencode Mappos lda MapPos,x adc temp sta (screenp),y iny adc #1 sta (screenp),y iny ; ; tables ; ; optimize -- can use sbc/adc instead of CMP, save one table negmaxvelocity byte -3,-4,-2 ; ship, missile, h/k posmaxvelocity byte 3,4,2 ; ship, missile, h/k ; ; data -- chars and sprites ; ; sprites are stored like chars: S S-left S-up S-left/up mirroring spritemem ;col offset from memory pointer ($0f00) ; byte 0,1,24,25,64 ; now .y is initialized to 0 - don't need to read it from table byte 1,24,25,64 byte $ff ;end of data ; char tab ; ; note: needs to be at end of code, so self-mod setup code will work ; (uses an INC lobyte without checking if it passes through zero) ;optimize -- use "random" (i.e. code) tile as the grassy tile? tiletab = *-16 ; hex 1241844201488220 ; a grassy tile ; hex 8040201008040201 ; a diamond tile ; hex 0000001f10141211 ; factory hex 0000001f18141312 ; hex 0101221a150933ce ;ship sprite ; hex 0101221b150d33de ;ship sprite hex 0101221b170f33df ;ship sprite hex 081018be7d180810 ;missile col 1 spritedat ; hex 030f1f3f7f7f7e7d ;spaceship, col 1 ; hex 7d7e7f7f3f1f0f03 ; ; hex c0f0f8fcfefe7ede ;spaceship, col 2 ; hex de7efefefcf8f0c0 ; hex 081018be7d180810 ;missile col 1 ; hex 1020261991640408 ;ship shot, col 1 spritevals ;positions in memory ;copied to $07f8-$07ff hex 3c ;ship ($3c = 60 = $0f00) ; hex 3e ;chaff hex a9 ;chaff hex 3d3d3d3d ;missiles hex 3c ;h/k