; *** R O B O T C I T Y 1 K *** ; Copyright 2006/2017, Thomas Jentzsch ; Version 1.01 TIA_BASE_READ_ADDRESS = $30 processor 6502 include vcs.h ;free: $57 (without SFX, else $01) ; TODOs: ; ? CONTROLS ; x improved AI ; x helicopter facing correctly ; + symmetric "helicopter" ; ? shooting into current joystick direction ; + reorganize code (remove subroutines etc,) ; + tank "AI": ; + direction ; + missile ; + use brk vector ; + movement: ; + helicopter ; + shot ; + tanks ; + missile ; + collisions: ; + player vs. tank ; + player vs. missile ; + tank vs. shot ; + tank vs. missile ; + shot vs. PF ; + missile vs. PF ; - gameplay: ; x decrease mode ; x (re)start maze ; + next maze ; + increase difficulty ; + pause between mazes ; - sounds: ; x helicopter (0) ; o shot (0) ; o tanks (1) ; o missile (1) ; o helicopter killed (0) ; o tank destroyed (1) ; x maze beaten ; x game over ; - mazes ; x random maze generation ; x different maze data format ; x vertical symmetric mazes ; + calculate PF-color ; + rectangular missiles ; + ROM into RAM (+15 bytes RAM, -1 byte ROM) ; x clear and init in one loop ; x tanks keep moving after death ; + use SBX ; + put all code into last 4 pages ;=============================================================================== ; A S S E M B L E R - S W I T C H E S ;=============================================================================== VERSION = $1010 BASE_ADR = $fc00 NTSC_TIM = 1 ; (+-0) 0 = PAL-50 NTSC_COL = 0 ; (+-0) 0 = PAL colors DISABLE = 0 ; disable code (do NOT change) DEBUG = 0 ; debug mode ILLEGAL = 1 ; ( +1) use illegal opcodes ; options: SHOOT_DIR = 0 ; (- 8) always shoot into joystick direction SOUND0 = 1 SOUND1 = 1 ; (-60) sounds channel 1 DUAL_CONTROL = 1 ; (- 5) switchable control mode (+5 if using continous mode only) CONST_SPEED = 1 ; (+ 2) ;=============================================================================== ; T I A - C O N S T A N T S ;=============================================================================== ;ENAxy: ENABLE = %10 ;CTRLPF: PF_REFLECT = %001 PF_SCORE = %010 PF_PRIORITY = %100 ;NUSIZx: MSBL_SIZE1 = %000000 MSBL_SIZE2 = %010000 MSBL_SIZE4 = %100000 MSBL_SIZE8 = %110000 ;=============================================================================== ; C P U - C O N S T A N T S ;=============================================================================== opBIT_B = $24 ; 2 bytes, 3 cycles opBIT_W = $2c ; 3 bytes, 4 cycles opNOP_B = $82 ; 2 bytes, 2 cycles opNOP_ZP = $04 ; 2 bytes, 3 cycles opNOP_W = $0c ; 3 bytes, 4 cycles ;=============================================================================== ; C O N S T A N T S ;=============================================================================== RAND_EOR_8 = $95 ;$b2 NUM_MAZES = 2 ; grid layout: NUM_XBLOCKS = 9 NUM_YBLOCKS = 7 NUM_BLOCKS = NUM_YBLOCKS*2+1 ; = 15 IF NTSC_TIM H_VERT = 20/2 H_HORZ = 6/2 ELSE H_VERT = 22/2 H_HORZ = 8/2 ENDIF H_GRID = H_VERT+H_HORZ W_GRID = 16 ; sizes: H_PLAYER = 7 H_TANK = 7 H_SHOT = 2 H_MISL = 4 ; 7 KERNEL_H = NUM_YBLOCKS*H_VERT + (NUM_YBLOCKS+1)*H_HORZ ; direction constants: (SWCHA: RLDUrldu) NUM_DIRS = 4 DIR_UP = %00 DIR_DOWN = %01 DIR_LEFT = %10 DIR_RIGHT = %11 DIR_BITS = %11 ; dirTankLst constants: NO_TANK = %100 DIR_UP_BIT = 1 << (DIR_UP + 4) DIR_DOWN_BIT = 1 << (DIR_DOWN + 4) DIR_LEFT_BIT = 1 << (DIR_LEFT + 4) DIR_RIGHT_BIT = 1 << (DIR_RIGHT + 4) DIR_HORZ_BITS = DIR_LEFT_BIT | DIR_RIGHT_BIT DIR_VERT_BITS = DIR_UP_BIT | DIR_DOWN_BIT NUM_TANKS = 4 NUM_OBJECTS = 5 ; P0, P1, M0, M1, BL ;ID_P0 = 0+2 ;ID_P1 = 1+2 ID_MISL = 2+2 ID_PLAYER = 3+2 ID_SHOT = 4+2 ;--------------------------------------------------------------- ;*** initial positions and directions *** X0 = 17 IF NTSC_TIM Y0 = 3+H_TANK+H_HORZ ELSE Y0 = 3+H_TANK+H_HORZ ENDIF Y_TANK0 = Y0 ; orange Y_TANK1 = Y0 ; green Y_TANK2 = Y0 ; red Y_TANK3 = Y0 ; blue X_TANK0 = X0 X_TANK1 = X0+24+2 X_TANK2 = X0+69+5 ;X0+92+1 ; X_TANK3 = X0+48 DIR_TANK0 = DIR_LEFT DIR_TANK1 = DIR_LEFT DIR_TANK2 = DIR_RIGHT DIR_TANK3 = DIR_RIGHT X_PLAYER = X0+31*4 Y_PLAYER = Y0+(NUM_YBLOCKS-1)*H_GRID ;--------------------------------------------------------------- ; *** initial speeds *** NUM_SPEEDS = 4 IF NTSC_TIM IF CONST_SPEED SPEED_ADD = 8+2 SPEED_PLAYER = 80-1 ELSE SPEED_PLAYER = 78 ; 78, 88, 99 ENDIF SPEED_MISSILE = (SPEED_PLAYER+1)*3-1 SPEED_SHOT = (SPEED_PLAYER+1)*5-1 SPEED_TANK = (SPEED_PLAYER+1)/2-1 ELSE IF CONST_SPEED SPEED_ADD = 10+2 SPEED_PLAYER = 80*308/262-1+6 ; taller playfield ELSE SPEED_PLAYER = 78*308/262-1 ENDIF SPEED_MISSILE = (SPEED_PLAYER+1)*3-1 SPEED_SHOT = (SPEED_PLAYER+1)*5-1 SPEED_TANK = (SPEED_PLAYER+1)/2-1 ENDIF ;--------------------------------------------------------------- ; *** colors *** IF NTSC_COL MAZE0_COL = $56 ;MAZE_COL_ADD = $50 MAZE_COLOR_SUB = $30 TANK0_COL = $2c ; orange TANK1_COL = $ca ; green TANK2_COL = $4a ; red TANK3_COL = $8c ; blue ELSE MAZE0_COL = $86 ;MAZE_COL_ADD = $50 MAZE_COLOR_SUB = $50 TANK0_COL = $2c TANK1_COL = $5a TANK2_COL = $6a TANK3_COL = $dc ENDIF ;=============================================================================== ; Z P - V A R I A B L E S ;=============================================================================== SEG.U variables ORG $80 ; *** cleared variables: *** ;frameCnt ds 1 maze ds 1 ; contains maze data offset IF SOUND0 || SOUND1 sound0 ds 1 sound1 ds 1 ELSE mode ds 1 ENDIF ;--------------------------------------- delayAllLst ds NUM_SPEEDS delayLst = delayAllLst-3 delayTank = delayLst+3 ; one delay for all tank delayMisl = delayLst+ID_MISL ; other objects start here delayPlayer = delayLst+ID_PLAYER delayShot = delayLst+ID_SHOT ;--------------------------------------- pfLst = . pf1Lst ds NUM_BLOCKS-1 ; overlaps with next byte pf2Lst ds NUM_BLOCKS ;--------------------------------------- tmpVar ds 5 ; 5 required ;--------------------------------------- ; *** initialized variables: *** initLst = . -1 swapLst = . xPosAllLst ds NUM_OBJECTS+2 xPosTankLst = xPosAllLst xPosLst = xPosAllLst+2 ; visible objects start here xPosP0 = xPosLst+0 xPosP1 = xPosLst+1 xPosMisl = xPosLst+2 xPosPlayer = xPosLst+3 xPosShot = xPosLst+4 ;--------------------------------------- yPosAllLst ds NUM_OBJECTS+2 yPosTankLst = yPosAllLst yPosLst = yPosAllLst+2 ; visible objects start here yPosP0 = yPosLst+0 yPosP1 = yPosLst+1 yPosMisl = yPosLst+2 yPosPlayer = yPosLst+3 yPosShot = yPosLst+4 ;--------------------------------------- dirAllLst ds NUM_OBJECTS+2 dirTankLst = dirAllLst dirLst = dirAllLst+2 ; visible objects start here dirMisl = dirLst+2 dirPlayer = dirLst+3 dirShot = dirLst+4 ;--------------------------------------- colorAllLst ds NUM_TANKS colorTankLst = colorAllLst colorLst = colorAllLst+2 ; visible tank's colors ;--------------------------------------- numTanks ds 1 NUM_NEXT = . - initLst ;--------------------------------------- speedAllLst ds NUM_SPEEDS*2 speedLstLo = speedAllLst-3 speedTank = speedLstLo+3 speedMisl = speedLstLo+ID_MISL speedPlayer = speedLstLo+ID_PLAYER speedShot = speedLstLo+ID_SHOT speedLstHi = speedAllLst-3+NUM_SPEEDS speedTankHi = speedLstHi+3 ; ignored speedMislHi = speedLstHi+ID_MISL speedPlayerHi = speedLstHi+ID_PLAYER ; always 0! speedShotHi = speedLstHi+ID_SHOT ;--------------------------------------- colorPF ds 1 blockSizeLst ds NUM_BLOCKS ; just copied from ROM random ds 1 NUM_VALUES = . - initLst ;--------------------------------------- ptrLst ds 2*4 ptrP0 = ptrLst+0 ; kernel temp ptrP1 = ptrLst+2 ; kernel temp ptrM0Size = ptrLst+4 ; kernel temp ptrM0Move = ptrLst+6 ; kernel temp NUM_INITS = . - initLst IF SHOOT_DIR dirJoystick ds 1 ENDIF ;--------------------------------------- mislTankCol .byte ; id of missile fireing tank echo "******************************" echo "RAM free:", $100 - ., "bytes" FREE SET 0 ;=============================================================================== ; M A C R O S ;=============================================================================== MAC BIT_B .byte opBIT_B ENDM MAC BIT_W .byte opBIT_W ENDM MAC NOP_B IF ILLEGAL .byte opNOP_B ELSE BIT_B ENDIF ENDM MAC NOP_W IF ILLEGAL .byte opNOP_W ELSE BIT_W ENDIF ENDM MAC NOP_ZP IF ILLEGAL .byte opNOP_ZP ELSE BIT_B ENDIF ENDM MAC LAX_IY IF ILLEGAL lax ({1}),y ELSE lda ({1}),y ; tax ENDIF ENDM MAC SBX_IMM IF ILLEGAL sbx {1}+1 ; ignores carry!!! ELSE sbc {1} tax ENDIF ENDM MAC DEBUG_BRK IF DEBUG FREE SET FREE+1 brk ; ENDIF ENDM MAC SLEEP IF {1} = 1 ECHO "" ECHO "ERROR: SLEEP 1 not allowed!" ECHO "" ERR ENDIF IF {1} & 1 NOP_ZP .byte $00 REPEAT ({1}-3)/2 nop REPEND ELSE REPEAT ({1})/2 nop REPEND ENDIF ENDM MAC CHECKPAGE IF >. != >{1} ECHO "" ECHO "ERROR: different pages! (", {1}, ",", ., ")" ECHO "" ERR ENDIF ENDM MAC ALIGNPAGE FREE SET FREE - . IF <. > $f6 REPEAT ($100-2) - <. .byte $ea REPEND ENDIF FREE SET FREE + . ENDM ;=============================================================================== ; R O M - C O D E ;=============================================================================== SEG Code ORG BASE_ADR ;--------------------------------------------------------------- Start SUBROUTINE ;--------------------------------------------------------------- ; also: restart game cld ; Clear BCD math bit. ldx #0 txa .clearLoop: dex txs pha bne .clearLoop ;GameInit SUBROUTINE ldx #NUM_INITS-1 lda #>PlayerSizeTbl .loopInit: cpx #NUM_VALUES bcs .setPointers NextMaze: lda InitTbl,x .setPointers: sta initLst,x dex bpl .loopInit sta NUSIZ0 ; from last init value ;--------------------------------------------------------------- DecodePF SUBROUTINE ;--------------------------------------------------------------- DECODE_SIZE SET 0 - . ; lda #(NUM_BLOCKS-1)*2 ; sta maze ; switch maze: lda maze tay eor #(NUM_BLOCKS-1)*2 sta maze ; increase color: lda colorPF sta COLUPF sbc #MAZE_COLOR_SUB-1 ; C==0! sta colorPF ; copy maze data: ldx #(NUM_BLOCKS-1)*2 .loopBlocks: lda PFCodeTbl,y sta pfLst,x ; iny dex bpl .loopBlocks DECODE_SIZE SET DECODE_SIZE + . ;--------------------------------------------------------------- OverScan2 SUBROUTINE ; (part 2/2) ;--------------------------------------------------------------- ; x = -1; y = 0 MainLoop: lsr SWCHB bcc Start ;--------------------------------------- IF SOUND1 lda sound1 ELSE lda mode ENDIF bne .skipMoveTank ;. .skipMovePlayer: ldx numTanks beq .skipMoveTank ;********** J O Y S T I C K ********** ; *** fire shot: *** asl INPT4 bcs .skipFire lda yPosShot bne .skipFire IF SHOOT_DIR lda dirJoystick ELSE lda dirPlayer ENDIF sta dirShot lda xPosPlayer adc #4 sta xPosShot lda yPosPlayer adc #-3 sta yPosShot IF SOUND0 ; start fireing sound: lda #$0f sta sound0 ENDIF .skipFire: ; *** check joystick: *** IF SHOOT_DIR ;{ ldy #NUM_DIRS lda SWCHA .loopNew1: dey bmi .skipMovePlayer asl bcs .loopNew1 sty dirJoystick ELSE ;} IF DUAL_CONTROL bit SWCHB bvs .continous ; enable continous ship movement ENDIF inc SWCHA beq .skipMovePlayer .continous: ENDIF ; get valid directions for helicopter: ldx #ID_PLAYER jsr GetValidDirs ; returns valid dirs in A and X ora SWCHA ; check new direction (prefered): ldy #NUM_DIRS-1 .loopNew: asl bcc .newDirOk dey bpl .loopNew ; new direction not allowed, now check old direction: txa ldy dirPlayer and DirBitTbl,y bne .skipMovePlayer .newDirOk: sty dirPlayer ; valid direction, now move helicopter: ldx #ID_PLAYER brk ; jsr CheckMoveObject .skipMovePlayer: ;********** M O V E T A N K S ********** .offset = tmpVar tankIdx = .offset lda delayTank sec ; ??? adc speedTank sta delayTank ldx #NUM_TANKS-1 bcc .skipMoveTank .loopMove: stx tankIdx lda dirTankLst,x and #NO_TANK bne .skipTank jsr TankAI .skipTank: dex bpl .loopMove IF SOUND1 ;*** handle sound channel 1: *** ; ldx #$0f .skipMoveTank: ldy #$1f lda sound1 bpl .skipDeathSound ; handle death sound: dec sound1 lsr lsr tax eor #$0f ; ldy #$0f ; 6,f (3,7,8) bpl .setSound1 .skipDeathSound: ; load tank sound parameters: lda yPosMisl beq .contTankSound ; X==$03/$0f ; load missile sound parameters: eor xPosMisl ; lda frameCnt and #$05 ldx #$0a ldy #$08 NOP_B .contTankSound tya .setSound1: stx AUDV1 sta AUDF1 sty AUDC1 ELSE .skipMoveTank: ENDIF .skipMoves: IF SOUND0 ;*** handle sound channel 0: *** ldy #$07 ; shot control lax sound0 beq .setSound0 bpl .shotSound cmp #$c1 bcs .contExplosion ldy numTanks bne .setSound0 ldx #0 asl bne .decSound0 ; *** all tanks killed, goto next maze: *** ; increase speed by 1/8th: ldx #NUM_TANKS ; .loopInc: lda speedLstLo+2,x IF CONST_SPEED clc adc #SPEED_ADD ELSE lsr lsr lsr adc speedLstLo+2,x ENDIF sta speedLstLo+2,x bcc .skipIncHi inc speedLstHi+2,x .skipIncHi: dex bne .loopInc ldx #NUM_NEXT-1 jmp NextMaze .contExplosion: lsr lsr tax iny ; Y=8! lda #$18^$0f .shotSound: eor #$0f .decSound0: dec sound0 .setSound0; stx AUDV0 sta AUDF0 sty AUDC0 ENDIF .waitTim: ldx INTIM bpl .waitTim ;--------------------------------------------------------------- VerticalBlank SUBROUTINE ;--------------------------------------------------------------- ; set BL size and enable reflected PF: ; lda #MSBL_SIZE2|PF_PRIORITY|PF_REFLECT ;%011101 lda #%011101 ; = MSBL_SIZE2|PF_PRIORITY|PF_REFLECT|%1000 sta CTRLPF sta VDELP0 ; sta VDELBL ; lda #%0111 .waitSync: sta WSYNC sta VSYNC lsr bne .waitSync ; inc frameCnt IF NTSC_TIM lda #44-2-3 ELSE lda #(44)*5/4 ENDIF sta TIM64T ;********** M O V E S H O T S ********** ldx #ID_SHOT brk ; jsr CheckMoveObject ldx #ID_MISL brk ; jsr CheckMoveObject ;--------------------------------------------------------------- GameCalc SUBROUTINE ;--------------------------------------------------------------- ; swap visible/invisible tanks data: ldx #(NUM_OBJECTS+2)*4 ; sec NOP_B .loopX: clc .loopSwap: ldy swapLst-1-NUM_OBJECTS,x lda swapLst-1-NUM_OBJECTS+2,x sta swapLst-1-NUM_OBJECTS,x sty swapLst-1-NUM_OBJECTS+2,x dex bcs .loopX txa SBX_IMM #NUM_OBJECTS-1 ; C==0! bne .loopSwap ; setup colors and tank pointers: inx ; X=1! .loopCopy: sta ptrP1 ; set 2nd pointer after 1st loop lda colorTankLst+2,x sta COLUP0,x ldy dirTankLst+2,x lda TankPtrTbl,y sbc yPosP0,x dex bpl .loopCopy sta ptrP0 ; A now contains 1st pointer ; position all objects: ldx #NUM_OBJECTS-1 ; 2 .loopObjects: sta WSYNC lda xPosLst,x ; 4 WaitObject: sbc #$0f ; 2 adjust xPosShot depending on initial carry bcs WaitObject ; 2³ CHECKPAGE WaitObject eor #$07 ; 2 asl ; 2 asl ; 2 asl ; 2 asl ; 2 now C==1! sta RESP0,x ; 4 @22! sta HMP0,x ; 4 dex ; 2 bpl .loopObjects ; 2³ HMOVE done inside kernel! ; set low pattern pointers for helicopter: ; TODO: adjust C when killed ; lda #=59! lda pf1Lst,x ; 4 sta PF1 ; 3 @71..00 >=69! ;--------------------------------------- and #%10000000 ; 2 ora #%01000000|ENABLE ; 2 sta PF0 ; 3 = 21 @02..07 >=76! ; draw tank missile (part 2/2): sbc #0 ; 2 ENABLE taken from PF0! sta ENAM0 ; 3 = 5 @07..12 ; draw player shot: tya ; 2 sbc yPosShot ; 3 adc #H_SHOT ; 2 rol ; 2 asl ; 2 sta ENABL ; 3 = 14 @21..26 ; draw 2nd tank (part 1/2): tya ; 2 sec ; 2 sbc yPosP1 ; 3 adc #H_TANK ; 2 lda #0 ; 2 bcc .skipDrawP1 ; 2³ lda (ptrP1),y ; 5 .skipDrawP1: sec ; 2 pha ; 3 = 19/23 @40..49 ; draw helicopter (part 1/2): sta HMCLR ; 3 = 3 +3 clear HM values of other objects! tya ; 2 sbc yPosPlayer ; 3 adc #H_PLAYER ; 2 bcc .skipDrawPlayerA ; 2³ lda (ptrM0Move),y ; 5 sta HMM1 ; 3 .skipDrawPlayerA: ; = 10/17 @50..66 ; draw 2nd tank (part 2/2): pla ; 4 .enterKernel sta WSYNC ; 3 = 7 @57..73 ;--------------------------------------- sta HMOVE ; 3 sta GRP1 ; 3 = 6 @06 ; draw helicopter (part 2/2): lda #ENABLE|1 ; 2 bcc .skipDrawPlayer ; 2³ sta ENAM1 ; 3 = 7 @13 lda (ptrM0Size),y ; 5 sta NUSIZ1 ; 3 = 8 .contDrawPlayer: ; @21/22 dey ; 2 = 2 ; draw 1st tank: tya ; 2 sbc yPosP0 ; 3 adc #H_TANK ; 2 bcs .doDrawP0 ; 2³ lda #0 ; 2 NOP_W ;-1 .doDrawP0: lda (ptrP0),y ; 5 sta GRP0 ; 3 = 18/18 @41/42 (VDELed!) ; check for next PF block: tya ; 2 cmp blockSizeLst,x ; 4 current PF block finished? bne .loopBlock ; 2³= 8/9 dex ; 2 bpl .nextBlock ; 2³= 4/5 KERNEL_SIZE SET KERNEL_SIZE + . ;--------------------------------------------------------------- OverScan1 SUBROUTINE ; (part 1/2) ;--------------------------------------------------------------- .offset = tmpVar IF NTSC_TIM lda #36+1+3+2 ELSE lda #(36+1)*5/4 ENDIF sta TIM64T ;********** C O L L I S I O N S ********** ; a != 0, x = -1, y = 0 ; tanks vs. player: bit CXM1P bmi .killPlayer bvs .killPlayer ; missile vs. player: bit CXPPMM bvc .skipPlayer ; sty yPosMisl .killPlayer: IF SOUND1 lda sound1 bne .skipPlayer ldx #$bf stx sound1 ELSE stx mode ENDIF .skipPlayer: stx VBLANK ; late, saves one WSYNC (X==-1!) ;--------------------------------------- ; shot vs. PF: bit CXBLPF bpl .skipDisableShot .disableShot: sty yPosShot .skipDisableShot: ; missile vs. PF: bit CXM0FB bpl .skipDisableMissile .disableMissile: sty yPosMisl .skipDisableMissile: ;--------------------------------------- ; shot vs. tanks: ldx #1 .loopTank: asl CXP0FB,x ; tank hit by shot? bpl .nextTank ; no, next tank sty yPosShot ; Y==0! lda dirLst,x cmp dirShot ; shot hit into tank's back? beq .disableTank ; yes, disable tank .nextTank: dex bpl .loopTank ; missile vs. tanks inx ; X=0! bit CXM0P bvs .checkDisableTank bpl .endMislTank inx .checkDisableTank: lda colorLst,x cmp mislTankCol ; collision with fireing tank? beq .endMislTank ; yes, skip .disableTank: lda #NO_TANK cmp dirLst,x ; tank already disabled? beq .endMislTank ; yes, skip sta dirLst,x IF SOUND0 ; start tank killed sound: dey sty sound0 ; Y==$ff ENDIF dec numTanks IF SOUND0 = 0 ;{ ; *** all tanks killed, goto next maze: *** ; increase speed by 1/8th: tax ; X==NO_TANK==NUM_SPEEDS! .loopInc: lda speedLstLo+2,x IF CONST_SPEED clc adc #SPEED_ADD ELSE lsr lsr lsr adc speedLstLo+2,x ENDIF sta speedLstLo+2,x bcc .skipIncHi inc speedLstHi+2,x .skipIncHi: dex bne .loopInc ldx #NUM_NEXT-1 jmp NextMaze ENDIF ;} ;--------------------------------------- .endMislTank: jmp MainLoop ;--------------------------------------------------------------- TankAI SUBROUTINE ;--------------------------------------------------------------- .offset = tmpVar+1 .validDirs = .offset AI_SIZE SET 0 - . ;;***** missile AI: ***** ; check if missile active: IF SOUND1 lda sound1 ; 3 player dead.. ELSE lda mode ; 3 player dead.. ENDIF ora yPosMisl ; 3 ..or missile already used? bne .skipMisl ; 2³= 5/6 yes, skip ; check horizontal distance: .horizontal: lda xPosPlayer sec sbc xPosTankLst,x ldy #DIR_LEFT ; 2 = 2 cmp #-5 bmi .vertical iny ; 2 DIR_RIGHT cmp #5 bpl .vertical ldy #-2 ; horizontal match! ; check vertical distance: .vertical ; y = -2, 2, 3 lda yPosPlayer sec sbc yPosTankLst,x cmp #6 ; 2 bpl .down cmp #-5 ; 2 bpl .checkMislDir ; vertical match! iny ; DIR_UP .down: iny ; DIR_DOWN iny ; compare with tank direction: .checkMislDir: tya cmp dirTankLst,x ; 4 bne .skipMisl ; fire missile: sty dirMisl ; 3 lda xPosTankLst,x ; 4 adc #2 ; 2 C==1! sta xPosMisl ; 3 lda yPosTankLst,x ; 4 adc #-2 ; 2 C==0! sta yPosMisl ; 3 lda colorTankLst,x sta mislTankCol ; 3 remember which tank fired missile .skipMisl: ;********** tank direction AI ********** ;*** find allowed new tank directions: *** jsr GetValidDirs ldx tankIdx bcs .skipTurn ; skip, when not a turning position ldy dirTankLst,x ; prevent reversing direction: ora ReverseBitTbl,y sta .validDirs ;*** find best direction: ***: ldy #DIR_LEFT lda xPosPlayer ; 3 sec ; 2 sbc xPosTankLst,x ; 4 beq .tryUpDown bcc .left iny ; DIR_RIGHT .left: ; lda DirBitTbl,y ; and .validDirs ; bne .tryUpDown bit random bpl .tryAI .tryUpDown: lda yPosPlayer ; 3 sec ; 2 sbc yPosTankLst,x ; 4 beq .tryAI ldy #DIR_UP bcs .tryAI iny ; DIR_DOWN bcc .tryAI ; 3 ; random direction: .loopDir: ; calculate next random number: lda random ; 3 lsr ; 2 bcc .skipEor ; 2³ eor #RAND_EOR_8 ; 2 .skipEor: ; = 11/12 (~11.5) sta random ; 3 and #DIR_BITS tay .tryAI: lda DirBitTbl,y and .validDirs bne .loopDir sty dirTankLst,x .skipTurn: pha ; 3 prepare RTI inc $fe ; 5 prepare RTI lda #1 clc bcc MoveObject ; 3 ;--------------------------------------------------------------- CheckMoveObject SUBROUTINE ;--------------------------------------------------------------- dec $fe ; 5 prepare RTI lda yPosAllLst,x ; 4 object disabled? beq .skipObject ; 2³ yes, don't move lda delayLst,x sec adc speedLstLo,x sta delayLst,x lda speedLstHi,x MoveObject: ldy dirAllLst,x ; 4 beq .yDir ; 2 UP (0) dey ; 2 dey ; 2 dey beq .xDir ; 2³ sbc #0 ; 2 DOWN (1), LEFT(2): Y = -2,-1 eor #$ff ; 2 clc ; 2 iny ; 2 bne .yDir ; 2³ .xDir: ; RIGHT (3) adc xPosAllLst,x ; 4 sta xPosAllLst,x ; 4 .skipObject: rti ; 6 .yDir: adc yPosAllLst,x ; 4 sta yPosAllLst,x ; 4 rti ; 6 ;CheckMoveObject END FREE SET FREE - . org BASE_ADR+$2e3-1 FREE SET FREE + . ;--------------------------------------------------------------- GetValidDirs SUBROUTINE ;--------------------------------------------------------------- ; return: valid dir bits == 0 ; x = OBJECT_ID .offset = tmpVar+1 .validDirs = .offset .xGrid = .offset+1 .yGrid = .offset+2 .dirIdx = .offset+3 ; calc x-grid: lda xPosAllLst,x ; 4 ldy #NUM_XBLOCKS ; 2 = 11 .loopX: dey ; 2 cmp XGridTbl,y ; 4 bcc .loopX ; 2³= 8/9 beq .contDirs ; 2³ ldx #DIR_VERT_BITS ; 2 .exitDirs: txa ; 2 rts ; 6 C==1! .contDirs: sty .xGrid ; calc y-grid: lda yPosAllLst,x ; 4 sbc #Y0 ; 2 C==1! ldx #DIR_HORZ_BITS ; 2 ldy #NUM_YBLOCKS*2+1 ; 2 = 13 .loopY: dey ; 2 dey ; 2 cmp BlockSizeTbl-1,y ; 4 bcc .loopY ; 2³= 10/11 bne .exitDirs ; 2³ sty .yGrid ; 3 = 5 ; total: ; get all valid new directions: ldx #NUM_DIRS-1 ; 2 = 2 .loopCheckDir: ;order: up, down, left, right stx .dirIdx ; 3 txa ; 2 ldy .xGrid ; 3 ldx .yGrid ; 3 lsr ; 2 = 10 bne .checkVertical bcc .checkRight .checkLeft: ; ~11 cylces dey ; 2 .checkRight: ; ~ 9 cylces lda HorzMaskTbl,y ; 4 cpy #NUM_XBLOCKS-1 ; 2 bcc .checkPattern ; 2³ bcs .contCheck ; 3 .checkVertical: bcs .checkUp .checkDown: ; ~ 8 cycles dex ; 2 NOP_B ; 0 .checkUp: ; ~ 6 cylces inx ; 2 lda VertMaskTbl,y ; 4 .checkPattern: ; = 6..11 ; y = x-grid (0..7) ; x = y-grid (0..14) dey ; 2 dey ; 2 cpy #4 ; 4 Y<2 || Y>=6? bcs .checkPF1 ; 2³ and pf2Lst,x ; 4 NOP_W ; 0 .checkPF1: and pf1Lst,x ; 4 = 9/13/16 ~13.5 cycles ;--------------------------------------- cmp #1 ; 2 A==0 for valid dirs .contCheck: ror .validDirs ; 5 ldx .dirIdx ; 3 dex ; 2 bpl .loopCheckDir ; 2³= 14/15 (total 57/58) clc ; total: ~235 cylces lax .validDirs ; 5 rts ; 6 C==0! ;=============================================================================== ; R O M - T A B L E S ;=============================================================================== FREE SET FREE - . org BASE_ADR+$340-1 FREE SET FREE + . XGridTbl: .byte X0, X0 +16,X0 +32,X0+ 48 .byte X0+ 62 .byte X0+ 76, X0+ 92,X0+108,X0+124 HorzMaskTbl: .byte $20, $02 ; PF1 left .byte $04, $40 ; PF2 left VertMaskTbl: .byte $40, $04 ; PF2 right (shared!) .byte $02, $20 ; PF1 right (shared!) ; .byte %10000000, %00001000 ; $80, $10 ; .byte %00000001, %00010000 ; $01, $08, .byte %10000000, %00010000 ; $80, $08 .byte %00000001, %00001000, %10000000 ; $01, $10, $80 TankPtrTbl: .byte <(Tank0 +H_TANK), <(Tank180+H_TANK) .byte <(Tank270+H_TANK), <(Tank90 +H_TANK) .byte <(NoTank +H_TANK) DirBitTbl: .byte DIR_UP_BIT, DIR_DOWN_BIT, DIR_LEFT_BIT, DIR_RIGHT_BIT ReverseBitTbl: .byte DIR_DOWN_BIT, DIR_UP_BIT, DIR_RIGHT_BIT, DIR_LEFT_BIT DECODE_SIZE SET DECODE_SIZE - . PFCodeTbl: ; maze #0: ;PF2: .byte %11111111 .byte %00000000 .byte %00111100 .byte %00000000 .byte %11000111 .byte %00000000 .byte %00111100 .byte %00000000 .byte %00111100 .byte %00000000 .byte %11000111 .byte %00000000 .byte %00111100 .byte %00000000 ;PF1: .byte %11111111 .byte %00000000 .byte %00111110 .byte %00100000 .byte %00100011 .byte %00000010 .byte %00100010 .byte %00100000 .byte %00100010 .byte %00000010 .byte %00100011 .byte %00100000 .byte %00111110 .byte %00000000 ; maze #1: .byte %11111111 .byte %00000000 .byte %00111111 .byte %00000000 .byte %01000111 .byte %01000100 .byte %01000100 .byte %01000000 .byte %01000100 .byte %01000100 .byte %01000111 .byte %00000000 .byte %00111111 .byte %00000000 .byte %11111111 .byte %00000000 .byte %00111111 .byte %00000000 .byte %00100011 .byte %00100000 .byte %00111110 .byte %00000000 .byte %00111110 .byte %00100000 .byte %00100011 .byte %00000000 .byte %00111111 .byte %00000000 ; end .byte %11111111 DECODE_SIZE SET DECODE_SIZE + . ; initial values: InitTbl: ; NUSIZ0: .byte MSBL_SIZE4 ; x-pos .byte X_TANK0, X_TANK1, X_TANK2, X_TANK3 .byte 0, X_PLAYER, 0 ; y-pos: .byte Y_TANK0, Y_TANK1, Y_TANK2, Y_TANK3 .byte 0, Y_PLAYER, 0 ; dirs: .byte DIR_TANK0, DIR_TANK1, DIR_TANK2, DIR_TANK3 .byte 0, DIR_LEFT, 0 ; colors: .byte TANK0_COL, TANK1_COL, TANK2_COL, TANK3_COL ; numTanks: .byte NUM_TANKS ; speeds: .byte SPEED_TANK, >SPEED_MISSILE, >SPEED_PLAYER, >SPEED_SHOT ; colorPF: .byte MAZE0_COL ; ROM tables copied into RAM for saving bytes: BlockSizeTbl: ; (15 bytes, RAM: -1 bytes) I SET 0 .byte 0 REPEAT NUM_YBLOCKS .byte H_VERT*I + H_HORZ*(I+1) I SET I + 1 .byte H_VERT*I + H_HORZ*I REPEND ; random: ; shared! ;.byte %00101000 TankPatTbl: Tank180: .byte %00010000 ; X .byte %01000100 .byte %00010000 ; X .byte %10111010 ; XOX .byte %00101000 ; X X .byte %01000100 ; .byte %00000000 Tank0: .byte %00000000 .byte %01000100 .byte %00101000 ; X X .byte %10111010 ; XOX .byte %00010000 ; X .byte %01000100 ; .byte %00010000 ; X Tank90 .byte %00010000 .byte %01000100 .byte %00110000 ; XX .byte %00011010 ; OX X .byte %00110000 ; XX .byte %01000100 ; .byte %00010000 Tank270 .byte %00010000 .byte %01000100 .byte %00011000 ; XX .byte %10110000 ; X XO .byte %00011000 ; XX .byte %01000100 ; .byte %00010000 NoTank: .byte %00010000 ; X .byte %01000100 ; X X .byte %00000000 ; .byte %10000010 ;X X .byte %00000000 ; .byte %01000100 ; X X ; .byte %00010000 ; X ; helicopter graphics: PlayerSizeTbl: .byte %010000 ; | XX | shared with tank graphic! .byte %100000 ; | XXXX | .byte %110000 ; |XXXXXXXX| .byte %010000 ; | XX | .byte %110000 ; |XXXXXXXX| .byte %100000 ; | XXXX | .byte %010000 ; | XX | PlayerMoveTbl: .byte $f0 .byte $e0 .byte $30 .byte $d0 .byte $20 .byte $10 .byte $c0 .byte $10 ; extra move when ship destroyed FREE SET FREE - . org BASE_ADR + $3fc FREE SET FREE + . .word Start .word CheckMoveObject echo "******************************" echo "Kernel:", KERNEL_SIZE, "bytes" echo "Decode:", DECODE_SIZE, "bytes" echo "free :", FREE, "bytes" IF DEBUG echo "DEBUG ENABLED!" ENDIF