Z80.TAB ; Invaders coded 9/12/89 S.M.Brattel (Design-Design Software) ; Some routines from Abdul Ibrahim (Strobe Computers) ; Using the META IBM cross-assembler package (why !?) ; (It may not be the worst assembler in the world, but it's ; not far off) MOTOROLA ; Use a "$" prefix for hex SEGMENT BYTE AT 01000 'CODE' ; this means "ORG $1000" CMDR EQU $01 ; Machine EQUs IER EQU $04 ; STR EQU $05 ; SIOR EQU $06 ; LCDC_D EQU $20 ; LCDC_S EQU $21 ; LCDC_C EQU $21 ; REstart EQU $103 ; Abduls routine entry points new_page EQU $106 ; "I'm a stranger here myself . ." def_sys_keys EQU $109 ; scr_DEL EQU $10C ; scroll EQU $10E ; bleep EQU $111 ; Fscroll EQU $114 ; delay EQU $117 ; get_char EQU $11A ; add_hl_a EQU $11D ; prog_stack EQU $120 ; def_cur_keys EQU $122 ; repeat_on EQU $125 ; write_7508 EQU $12B ; LCDcom EQU $12E ; LCDdata EQU $131 ; PUT_KEYPTR EQU $F22D ; Machine EQUs GET_KEYPTR EQU $F22F ; BDOS EQU $0005 ; CP/M (ish) entry points WBOOT EQU $EB03 ; CONST EQU $EB06 ; CONIN EQU $EB09 ; CONOUT EQU $EB0C ; TIMDAT EQU $EB4E ; PUTPFK EQU $EB6F ; BEEP EQU $EB39 ; GRAPHICS EQU $EB93 ; TOUCH EQU $EB96 ; TIMER1M EQU $F032 ; BUZ_FLG EQU $F094 ; RZIER EQU $F42E ; iBase_X EQU 11 ; Start position xShield_0 EQU 10 ; LHS xShield_1 EQU 35 ; Middle xShield_2 EQU 60 ; RHS yShield EQU 92 ; Shield Y Base_Min EQU 1 ; Clip X Base_Max EQU 71 ; Inv_Min EQU 4 ; Clip X Inv_Max EQU 74 ; ; Offsets for invaders iFlags EQU 0 ; b0=alive,b1=bottom inv,b2=last inX EQU 1 ; inY EQU 2 ; iType EQU 3 ; lInv EQU 4 ; Length of table entry (must be 4) nInvs EQU 36 ; 6 by 6 array mFlags EQU 0 ; b0=Alive,b1=base/inv mX EQU 1 ; mY EQU 2 ; mdY EQU 3 ; mType EQU 4 ; mSpeed EQU 5 ; miSpeed EQU 6 ; mLife EQU 7 ; lMiss EQU 8 ; Length nMiss EQU 5 ; Number of missiles ssiTime EQU 300 ; Time to appear ssTime EQU 4 ; Speed Start LD HL,0 ; Clear high score LD (Highscore),HL ; New_Game CALL new_page ; Cls CALL Show_Menu_Key ; This merely draws the menu key CALL Init_Prog ; Set up the timer etc. CALL Init_Game ; Set up the game CALL Init_Base ; Set up the next base CALL Init_Missiles ; Clear the projectile list Sheet_Lp CALL Init_Sheet ; Set up the sheet Game_Lp CALL Read_Keys ; Update the key map CALL Move_Missiles ; Move the missiles CALL Move_Base ; Move the base CALL Move_Invaders ; Move one invader one place CALL Move_Spaceship ; Move the ship, if present LD A,(Base_Cnt_A) ; Get displayed count LD B,A ; LD A,(Base_Cnt_D) ; Get real cnt CP B ; Same as displayed ? CALL NZ,Disp_Base_Cnt ; No, show new value LD DE,(Score_D) ; Get real score LD HL,(Score_A) ; Get displayed score OR A ; Same ? SBC HL,DE ; CALL NZ,Disp_Score ; No, show new value LD A,(Game_Flag) ; Keep playing ? OR A ; JR NZ,Game_1 ; No, new sheet or killed LD A,(kMenu) ; Check for exit OR A ; JR Z,Game_Lp ; No, carry on LD A,$9F ; ?? OUT ($24),A ; LD C,$16 ; Enable kbd. ints CALL write_7508 ; from the 7508 JP REstart ; Back to menu Game_1 CP 1 ; New sheet ? JR Z,Sheet_Lp ; Yes PUSH AF ; Save state CALL Base_Explode ; Bang ! POP AF ; Restore reason for death CP 3 ; All killed ? (landed) JR Z,New_Game ; LD A,(Base_Cnt_D) ; Kill one base DEC A ; LD (Base_Cnt_D),A ; JR Z,New_Game ; All killed XOR A ; Clear flag LD (Game_Flag),A ; JR Game_Lp ; Next base Base_Explode CALL Clear_Missiles ; Kill all the missiles LD C,$0A ; Undraw the base LD HL,Base_AND_Data ; CALL GRAPHICS ; LD A,(Base_X) ; LHS DEC A ; LD (Base_Expl_Data),A ; Set-up X LD B,15 ; Count BE_Lp PUSH BC ; Save cnt LD A,R ; Get a random explosion shape AND $07 ; CALL Get_Base_Expl ; Get the pointers PUSH DE ; Save the undraw ptr LD IX,Base_Expl_Data ; Set up data LD (IX+4),L ; Set OR ptr LD (IX+5),H ; LD (IX+6),2 ; OR flag PUSH IX ; Get ptr POP HL ; LD C,$0A ; Put CALL GRAPHICS ; Show it CALL Move_Missiles ; So that they can explode LD HL,1000 ; Some delay BE_Wait DEC HL ; Dec cnt LD A,L ; Loop OR H ; JR NZ,BE_Wait ; POP DE ; Get un-draw ptr LD IX,Base_Expl_Data ; Set up data LD (IX+4),E ; Set AND ptr LD (IX+5),D ; LD (IX+6),3 ; AND flag PUSH IX ; Get ptr POP HL ; LD C,$0A ; Put CALL GRAPHICS ; Show it POP BC ; Loop DJNZ BE_Lp ; LD HL,15000 ; Some delay BE_Wait1 DEC HL ; Dec cnt LD A,L ; Loop OR H ; JR NZ,BE_Wait1 ; RET ; Done Init_Sheet XOR A ; Clear flag LD (Game_Flag),A ; LD A,(Sheet_No) ; Get no. of attack wave LD B,A ; Save INC A ; Step it AND $07 ; Mask LD (Sheet_No),A ; Next wave no (0..7) LD A,B ; Current wave CALL Init_Invaders ; Create the inv. data CALL Draw_Invaders ; Show them CALL Draw_Shields ; Show the shields LD HL,Ship_Score_Tab ; Reset ship's score count LD (pShip_Score),HL ; RET ; Dummy Init_Game XOR A ; Start at sheet 0 LD (Sheet_No),A ; LD HL,0 ; Clear score LD (Score_D),HL ; INC L ; Make displayed value different, LD (Score_A),HL ; to force an update CALL Show_High ; Show the highest LD A,3 ; Start with 3 bases LD (Base_Cnt_D),A ; XOR A ; Force update LD (Base_Cnt_A),A ; CALL Init_Spaceship ; Set up delay RET ; Done Init_Base LD A,iBase_X ; Reset base position LD (Base_X),A ; CALL Draw_Base ; Show the base RET ; Done Init_Prog CALL Init_Keys ; Set-up the key scan LD C,$06 ; disable keyboard interrupts CALL write_7508 ; from the 7508 RET ; Done Init_Invaders AND $07 ; Only eight waves LD L,A ; Look-up start Y LD H,0 ; LD DE,Inv_Y_Table ; ADD HL,DE ; LD C,(HL) ; Get Y LD IX,Invaders_Tab ; Point at data area LD HL,Invaders_Data ; Definition for init. LD B,nInvs ; Number of invaders II_Lp LD A,(HL) ; Get flags INC HL ; LD (IX+iFlags),A ; Store LD A,(HL) ; Get X INC HL ; LD (IX+inX),A ; Store LD A,(HL) ; Get Y INC HL ; ADD A,C ; Add start Y LD (IX+inY),A ; Store LD A,(HL) ; Get Type INC HL ; LD (IX+iType),A ; Store LD DE,lInv ; Step ptr ADD IX,DE ; DJNZ II_Lp ; Loop XOR A ; Clear flags LD (Inv_Change_Dir),A ; LD (Inv_Y_Step),A ; LD A,4 ; Step size LD (Inv_X_Step),A ; LD HL,Inv_Move_R_Tab ; Table to use LD (pInv_Move_Tab),HL ; RET ; Done Draw_Invaders LD IX,Invaders_Tab ; Data for the invaders DI_Lp CALL Draw_Inv ; Draw the thing BIT 2,(IX+iFlags) ; Last invader ? RET NZ ; Yes, done LD DE,lInv ; Step ptr ADD IX,DE ; JR DI_Lp ; Loop Draw_Inv CALL Get_Inv_Shape ; Get the shape data DI_Code LD A,(IX+inX) ; Get X LD (HL),A ; Save X LD A,(IX+inY) ; Get Y INC HL ; Point to Y INC HL ; LD (HL),A ; Store Y DEC HL ; DEC HL ; LD C,$0A ; Put JP GRAPHICS ; Show it Undraw_Inv CALL Get_Inv_Shape ; Get the shape data EX DE,HL ; Undraw JR DI_Code ; Same as draw MI_Next_Step LD A,(Inv_Moved_Flag) ; Have we moved any ? OR A ; JR NZ,MINS_OK ; Yes, continue LD A,1 ; New sheet LD (Game_Flag),A ; RET ; Done MINS_OK XOR A ; Clear stepping down flag LD (Inv_Y_Step),A ; LD (Inv_Moved_Flag),A ; kill any alive flag LD HL,Inv_Move_R_Tab ; Table for right LD DE,Inv_Move_L_Tab ; left LD A,(Inv_X_Step) ; Current step size OR A ; JP P,MINS_R ; Right, done EX DE,HL ; Stepping left MINS_R LD A,(Inv_Change_Dir) ; Check flag OR A ; JR Z,MINS_1 ; Don't bounce XOR A ; Clear flag LD (Inv_Change_Dir),A ; EX DE,HL ; Swap dirn table LD A,(Inv_X_Step) ; Swap dirn NEG ; LD (Inv_X_Step),A ; LD A,4 ; Set Y step LD (Inv_Y_Step),A ; MINS_1 LD (pInv_Move_Tab),HL ; Store ptr Move_Invaders LD HL,(pInv_Move_Tab) ; Get the next invader to move LD A,(HL) ; Get its no. OR A ; End ? JR Z,MI_Next_Step ; Yes, reset ptr INC HL ; Step ptr LD (pInv_Move_Tab),HL ; DEC A ; 0..35 LD L,A ; 16 bit LD H,0 ; ADD HL,HL ; * lInvs ADD HL,HL ; LD DE,Invaders_Tab ; Index into table ADD HL,DE ; BIT 0,(HL) ; Alive ? JR Z,Move_Invaders ; No, get next one LD A,1 ; Assert one moved flag LD (Inv_Moved_Flag),A ; PUSH HL ; Get ptr POP IX ; CALL Undraw_Inv ; Clear it LD A,(Inv_X_Step) ; Move it LD B,A ; Save dirn ADD A,(IX+inX) ; LD (IX+inX),A ; BIT 7,B ; Check dirn JR NZ,MI_L ; Moving left CP Inv_Max ; Hit RHS ? JR C,MI_0 ; No LD A,1 ; Flag it LD (Inv_Change_Dir),A ; JR MI_0 ; Next MI_L CP Inv_Min ; Hit LHS ? JR NC,MI_0 ; No LD A,1 ; Flag it LD (Inv_Change_Dir),A ; MI_0 LD A,(Inv_Y_Step) ; Move it ADD A,(IX+inY) ; LD (IX+inY),A ; CP 104-5 ; Landed ? JR C,MI_1 ; No LD A,3 ; All killed LD (Game_Flag),A ; MI_1 LD A,(IX+iType) ; Change shape LD B,A ; INC B ; Step XOR B ; AND $FC ; Up to 4 shapes XOR B ; LD (IX+iType),A ; Store new shape CALL Draw_Inv ; Show it ; Now do firing . . . LD A,R ; Get a random AND $3D ; Do we want to fire ? RET NZ ; No CALL Get_Miss_Space ; Space in the table ? RET C ; No, ignore LD DE,lInv ; Skip length MI_GL_Lp BIT 0,(IX+iFlags) ; Alive ? JR Z,MI_GL_1 ; No, skip PUSH IX ; Save ptr POP HL ; MI_GL_1 BIT 1,(IX+iFlags) ; Bottom ? JR NZ,MI_GL_X ; Yes, done ADD IX,DE ; Skip it JR MI_GL_Lp ; Loop MI_GL_X PUSH HL ; Get last live one POP IX ; LD (IY+mFlags),1 ; Create it LD A,(IX+inX) ; Get X ADD A,3 ; LD (IY+mX),A ; LD A,(IX+inY) ; Get Y ADD A,6 ; Skip invader LD (IY+mY),A ; LD A,R ; Get type AND $02 ; LD (IY+mType),A ; Type 0 (line) or 1 (Zig-Zag) LD (IY+mdY),3 ; Step downwards LD A,R ; Get random speed RLCA ; RLCA ; RLCA ; AND $03 ; INC A ; LD (IY+miSpeed),A ; JP MM_Start ; Move the projectile Draw_Shields LD A,xShield_0 ; Get its X CALL Draw_Shield ; LD A,xShield_1 ; Get its X CALL Draw_Shield ; LD A,xShield_2 ; Get its X Draw_Shield LD HL,Shield_Data ; Point at data area LD (HL),A ; Save X LD C,$0A ; Mode JP GRAPHICS ; Show it Move_Base LD A,(kLeft) ; Left flag LD B,A ; Save LD A,(kRight) ; Right flag XOR B ; Same ? JR Z,MB_Draw ; Yes, redraw LD B,1 ; Assume Right LD A,(kRight) ; Right ? OR A ; JR NZ,MB_Move ; LD B,-1 ; Left MB_Move LD A,(Base_X) ; Get X LD (Base_AND_Data),A ; Save posn. ADD A,B ; Step X CP Base_Min ; Clip JR C,MB_Draw ; Fail CP Base_Max ; Clip JR NC,MB_Draw ; Fail LD (Base_X),A ; Save new posn. LD C,$0A ; LD HL,Base_AND_Data ; AND it CALL GRAPHICS ; MB_Draw CALL Draw_Base ; Show it LD A,(kFire) ; Fire pressed ? OR A ; RET Z ; No, ignore LD IY,Missile_Tab ; Point at base's missile entry BIT 0,(IY+mFlags) ; Alive ? RET NZ ; Yes, ignore CALL Step_Ship_Score ; Change ship score LD (IY+mFlags),1 ; Create it LD A,(Base_X) ; Get X ADD A,6 ; Offset to gun LD (IY+mX),A ; Store LD (IY+mY),104-7+5 ; Missile Y LD (IY+mType),0 ; Type 0 (line) LD (IY+mdY),-5 ; Step upwards LD (IY+miSpeed),1 ; Fast missile JP MM_Start ; Move the projectile Draw_Base LD A,(Base_X) ; Get X LD (Base_AND_Data),A ; LD HL,Base_OR_Data ; OR it LD (HL),A ; Save x LD C,$0A ; Put CALL GRAPHICS ; RET ; Done Init_Missiles LD IY,Missile_Tab ; Point at table LD DE,lMiss ; Length of entry LD B,nMiss ; Number XOR A ; Null flags IM_Lp LD (IY+mFlags),A ; Kill them ADD IY,DE ; Step ptr DJNZ IM_Lp ; Loop RET ; Dummy Clear_Missiles LD IY,Missile_Tab ; Point at table LD B,nMiss ; Number CM_Lp BIT 0,(IY+mFlags) ; Is it alive ? JR Z,CM_1 ; No, skip PUSH BC ; Save cnt CALL Explode_Miss ; Kill missile POP BC ; CM_1 LD DE,lMiss ; Length of entry ADD IY,DE ; Step ptr DJNZ CM_Lp ; Loop RET ; Dummy Explode_Miss CALL Undraw_Miss ; Clear it LD (IY+miSpeed),1 ; Fast(ish) SET 7,(IY+mFlags) ; Assert explosion flag LD (IY+mLife),6 ; Lifetime of explosion DEC (IY+mX) ; Explosions are wider DEC (IY+mX) ; RET ; Get_Miss_Space LD IY,Missile_Tab + lMiss ; Point to table LD DE,lMiss ; LD B,nMiss - 1 ; Number to check GMS_Lp LD A,(IY+mFlags) ; Alive ? AND $01 ; Check, clear carry RET Z ; No, use ADD IY,DE ; Skip DJNZ GMS_Lp ; Loop SCF ; Fail RET ; Done Move_Missiles LD IY,Missile_Tab ; Point at data area LD B,nMiss ; Number of missiles MM_Lp BIT 0,(IY+mFlags) ; Alive ? JR Z,MM_Next ; No, ignore it DEC (IY+mSpeed) ; Count down JR NZ,MM_Next ; Skip till time PUSH BC ; Save cnt CALL Move_Miss ; Move it POP BC ; MM_Next LD DE,lMiss ; Step ptr ADD IY,DE ; DJNZ MM_Lp ; Loop RET ; Done Move_Miss CALL Undraw_Miss ; Undraw it MM_Start LD A,(IY+miSpeed) ; Reset speed LD (IY+mSpeed),A ; BIT 7,(IY+mFlags) ; Proj. or explosion ? JP NZ,MM_Explo ; Explosion LD A,(IY+mY) ; Get it's Y ADD A,(IY+mdY) ; Move it LD (IY+mY),A ; Store CP 10 ; Hit roof ? JP C,MMK_4 ; Yes, done CP 108 ; Hit ground ? JP NC,MMK_4 ; Yes, done CALL Collide_Miss ; Hit anything ? JR NZ,MM_Kill ; Yes, kill etc. LD A,(IY+mType) ; Change type XOR $01 ; LD (IY+mType),A ; Draw_Miss CALL Set_Miss_Data ; Set the X,Y etc CALL Get_Miss_Shape ; Get draw/undraw shape LD (IX+4),L ; Set draw graphic ptr LD (IX+5),H ; LD (IX+6),2 ; "OR" mode PUSH IX ; POP HL ; Restore ptr LD C,$0A ; Put CALL GRAPHICS ; RET ; Done MM_Kill LD A,(IY+mY) ; Check for base killed CP 104 - 7 ; Possible ? JR C,MMK_1 ; No, too high BIT 7,(IY+mdY) ; Going the right way ? JR NZ,MMK_1 ; No LD A,(Base_X) ; Get the base X ADD A,6 ; Center X SUB (IY+mX) ; Get difference JP P,MMK_a ; Positive NEG ; Abs MMK_a CP 7 ; Hit base ? JR NC,MMK_1 ; No, too far away LD A,2 ; Base killed LD (Game_Flag),A ; RET ; Ignore rest of code ; Check for invader hit MMK_1 LD B,(IY+mX) ; Get X INC B ; Avoid equal case LD A,(IY+mY) ; Y SUB 7 ; LD L,A ; ADD A,15 ; LD H,A ; LD IX,Invaders_Tab ; Look in table LD DE,lInv ; Skip length MMK_2_Lp BIT 0,(IX+iFlags) ; Alive ? JR Z,MMK_2_X ; No, skip LD A,(IX+inX) ; Get X CP B ; LHS JR NC,MMK_2_X ; Fail ADD A,8 ; Look at RHS CP B ; mX JR C,MMK_2_X ; Not this one LD A,(IX+inY) ; Get X CP H ; Top JR NC,MMK_2_X ; Not this one CP L ; Bottom JR C,MMK_2_X ; No ; This invader hit CALL Undraw_Inv ; Clear it RES 0,(IX+iFlags) ; Kill it LD A,(IX+inX) ; Use its co-ords ADD A,3 ; LD (IY+mX),A ; LD A,(IX+inY) ; Use its co-ords ADD A,1 ; LD (IY+mY),A ; LD DE,$0010 ; Step Score CALL Add_Score ; JR MMK_4 ; Explode MMK_2_X BIT 2,(IX+iFlags) ; Last one ? JR NZ,MMK_3 ; Yes, done ADD IX,DE ; Skip JR MMK_2_Lp ; Loop ; Hit spaceship ? MMK_3 LD A,(Ship_Flag) ; Is it alive ? OR A ; JR Z,MMK_4 ; No, ignore LD A,(Ship_X) ; LD B,A ; LD A,(IY+mX) ; Get difference X SUB B ; CP 16 ; Out of range ? JR NC,MMK_4 ; Yes, not hit LD A,(IY+mY) ; In top line ? CP 16 ; JR NC,MMK_4 ; No, can't be ship ; Ship hit CALL Undraw_Ship ; Remove the ship CALL Init_Spaceship ; Reset ship LD HL,(pShip_Score) ; Get score LD E,(HL) ; INC HL ; LD D,(HL) ; CALL Add_Score ; Step the score LD A,(Ship_X) ; ADD A,8 ; Middle LD (IY+mX),A ; LD (IY+mY),9 ; Height MMK_4 SET 7,(IY+mFlags) ; Assert explosion flag LD (IY+mLife),6 ; Lifetime of explosion DEC (IY+mX) ; Explosions are wider DEC (IY+mX) ; MM_Explo DEC (IY+mLife) ; Time out ? JR Z,MME_Done ; Yes, kill it LD A,R ; Get a random no. AND $07 ; ADD A,4 ; Explosion shape LD (IY+mType),A ; JP Draw_Miss ; Show the explosion MME_Done LD (IY+mFlags),0 ; Kill it RET ; Done Undraw_Miss CALL Set_Miss_Data ; Set the X,Y etc CALL Get_Miss_Shape ; Get draw/undraw shape LD (IX+4),E ; Set AND graphic ptr LD (IX+5),D ; LD (IX+6),3 ; "AND" mode PUSH IX ; POP HL ; Restore ptr LD C,$0A ; Put CALL GRAPHICS ; RET ; Done Collide_Miss LD IX,Miss_Get_Data ; Point at get buffer LD A,(IY+mX) ; Get X DEC A ; LD (IX),A ; X1 ADD A,2 ; LD (IX+4),A ; X2 LD A,(IY+mY) ; Get Y LD (IX+2),A ; Y1 ADD A,6 ; Calc Y2 LD (IX+6),A ; Y2 PUSH IX ; Read screen POP HL ; LD C,$09 ; GET PUSH IY ; Save CALL GRAPHICS ; Read screen POP IY ; Restore CALL Get_Miss_Shape ; Get draw/undraw shape LD DE,4 ; Skip widths ADD HL,DE ; LD DE,MGB ; Now look for collisions LD A,(DE) ; Get byte AND (HL) ; Any pixels set ? RET NZ ; Yes, collision INC HL ; INC DE ; LD A,(DE) ; Get byte AND (HL) ; Any pixels set ? RET NZ ; Yes, collision INC HL ; INC DE ; LD A,(DE) ; Get byte AND (HL) ; Any pixels set ? RET ; Done Step_Ship_Score LD HL,(pShip_Score) ; Step ptr INC HL ; INC HL ; LD (pShip_Score),HL ; LD A,(HL) ; End of table ? INC A ; RET NZ ; LD HL,SST_1 ; Reset ship's score count LD (pShip_Score),HL ; RET ; Done Init_Spaceship LD HL,ssiTime ; Set up wait count LD (Ship_Delay),HL ; XOR A ; Ship active flag LD (Ship_Flag),A ; RET ; Done Move_Spaceship LD HL,(Ship_Delay) ; Count down DEC HL ; LD (Ship_Delay),HL ; LD A,L ; Done ? OR H ; RET NZ ; Not time yet LD HL,ssTime ; Reset count LD (Ship_Delay),HL ; LD A,(Ship_Flag) ; Alive ? OR A ; JR NZ,MS_Move ; Yes, move it LD A,1 ; Flag alive LD (Ship_Flag),A ; LD BC,$0002 ; LHS, move right LD A,R ; Get random AND $01 ; JR NZ,MS_1 ; Go right LD BC,$44FE ; RHS, move left MS_1 LD A,B ; Set X LD (Ship_X),A ; LD A,C ; Disp LD (Ship_Disp),A ; CALL Draw_Ship ; Show it RET ; Done MS_Move CALL Undraw_Ship ; Clear it LD A,(Ship_X) ; Get X LD B,A ; LD A,(Ship_Disp) ; Step it ADD A,B ; LD (Ship_X),A ; CP 69 ; Done ? JR NC,Init_Spaceship ; Yes, kill it Draw_Ship LD HL,gShip_OR ; Draw it LD (Ship_Data + 4),HL ; LD A,2 ; OR LD (Ship_Data + 6),A ; LD HL,Ship_Data ; LD C,$0A ; JP GRAPHICS ; Undraw_Ship LD HL,gShip_AND ; Draw it LD (Ship_Data + 4),HL ; LD A,3 ; AND LD (Ship_Data + 6),A ; LD HL,Ship_Data ; LD C,$0A ; JP GRAPHICS ; Set_Miss_Data LD HL,Missile_Data ; Sprite definition PUSH HL ; Save ptr LD A,(IY+mX) ; Get X DEC A ; Sprite offset LD (HL),A ; Save X-1 LD A,(IY+mY) ; Get Y INC HL ; INC HL ; LD (HL),A ; Save Y POP IX ; Into IX RET ; Done Get_Inv_Shape LD L,(IX+iType) ; Get type LD H,0 ; ADD HL,HL ; * 4 (bytes per entry) ADD HL,HL ; LD DE,Inv_Type_Tab ; Base of table JR GMS_Read ; Get DE,HL Get_Base_Expl LD L,A ; Get type LD H,0 ; ADD HL,HL ; * 4 (bytes per entry) ADD HL,HL ; LD DE,Base_Expl_Tab ; Base of table JR GMS_Read ; Get DE,HL Get_Miss_Shape LD L,(IY+mType) ; Get type LD H,0 ; ADD HL,HL ; * 4 (bytes per entry) ADD HL,HL ; LD DE,Miss_Type_Tab ; Base of table GMS_Read ADD HL,DE ; LD E,(HL) ; Get ptr to AND graphic (DE) INC HL ; LD D,(HL) ; INC HL ; LD A,(HL) ; Get ptr to OR graphic (HL) INC HL ; LD H,(HL) ; LD L,A ; RET ; Done Disp_Score EX DE,HL ; Get score into HL LD (Score_A),HL ; Save new value CALL Set_Score_Chars ; Set shape LD HL,Score_Data ; Show it LD C,$0A ; CALL GRAPHICS ; LD HL,(Score_A) ; Same or higher than HS ? LD DE,(Highscore) ; OR A ; SBC HL,DE ; RET C ; High is larger ADD HL,DE ; Update it LD (Highscore),HL ; LD HL,Highscore_Data ; Show it LD C,$0A ; JP GRAPHICS ; Show_High LD HL,(Highscore) ; Show latest CALL Set_Score_Chars ; Set shape LD HL,Highscore_Data ; Show it LD C,$0A ; JP GRAPHICS ; Set_Score_Chars LD DE,gScore + 4 ; Graphics area LD A,L ; LSD CALL DS_Digit ; LD A,L ; RRCA ; RRCA ; RRCA ; RRCA ; CALL DS_Digit ; LD A,H ; CALL DS_Digit ; LD A,H ; MSD RRCA ; RRCA ; RRCA ; RRCA ; DS_Digit PUSH HL ; AND $0F ; Mask digit ADD A,$30 ; 0..9 PUSH DE ; Save ptr CALL get_char ; Get the shape POP DE ; LD BC,8 ; Copy it LDIR ; POP HL ; Done RET ; Disp_Base_Cnt LD (Base_Cnt_A),A ; New value ADD A,$30 - 1 ; Make into a number CALL get_char ; Get a pointer to it LD DE,gBase_Cnt + 4 ; Graphics data area LD BC,8 ; Length of char LDIR ; Copy it LD HL,Base_Cnt_Data ; Point at graphics area LD C,$0A ; Put JP GRAPHICS ; Show it Add_Score LD A,(Score_D) ; 4-digit BCD ADD A,E ; DAA ; LD (Score_D),A ; LD A,(Score_D + 1) ; ADC A,D ; DAA ; LD (Score_D + 1),A ; RET ; Done Init_Keys XOR A ; Zero the key flags LD HL,kMenu ; Point at first LD B,4 ; 4 keys IK_Lp LD (HL),A ; Clear it INC HL ; DJNZ IK_Lp ; Loop RET ; Done Read_Keys CALL Scan_Keys ; Update the bit-map LD IX,key_buffer ; Point at key-buffer LD A,(IX+3) ; Menu key OR (IX+5) ; OR (IX+7) ; BIT 5,A ; Menu ? LD HL,kMenu ; Point at var CALL RK_AssertKey ; 0 or 1 LD A,(IX+1) ; Left ? AND $1C ; Bits 2,3,4 LD HL,kLeft ; CALL RK_AssertKey ; LD A,(IX+5) ; Right AND $1C ; Bits 2,3,4 LD HL,kRight ; CALL RK_AssertKey ; BIT 3,(IX+9) ; Fire LD HL,kFire ; CALL RK_AssertKey ; RET ; Done RK_AssertKey LD (HL),0 ; Assume not pressed RET Z ; No, not pressed LD (HL),1 ; Pressed RET ; Done Scan_Keys DI ; Interlock LD B,5 ; column ctr LD C,$01 ; port $24 output value LD HL,key_buffer ; write ptr SK1 LD A,C ; select column OUT ($24),A ; CALL wait_50 ; wait for at least 50 micro sec's IN A,($25) ; ?? LD D,A ; IN A,($26) ; AND $3F ; ensure non-key bits are not set LD E,A ; OR D ; JR Z,SK2 ; CALL wait_40 ; wait for at leat 40 micro sec's IN A,($25) ; all bits reset EXCEPT for bits set AND D ; before and after delay LD D,A ; IN A,($26) ; all bits reset EXCEPT for bits set AND E ; before and after delay LD E,A ; SK2 LD (HL),D ; ?? INC HL ; LD (HL),E ; INC HL ; SLA C ; DJNZ SK1 ; EI ; Done RET ; wait_40 LD A,4 ; Cnt JR wait_m ; wait_50 LD A,5 ; Cnt wait_m PUSH BC ; Wait A * 10 uS LD B,A ; Use B, why not ? wL NOP ; I assume Abdul timed this NOP ; NOP ; NOP ; NOP ; NOP ; NOP ; DJNZ wL ; Loop POP BC ; Restore the register we needn't have RET ; corrupted in the first place . . Show_Menu_Key LD C,1 ; define 1 key LD DE,SMK_Data ; ptr to descriptor block CALL TOUCH ; LD C,$0A ; Show keys LD HL,Key_Data ; CALL GRAPHICS ; RET ; Done Key_Data WORD 11,120,gKeys ; Show keys DC.B 0 ; PSET mode Base_OR_Data WORD 0,104,gBase_OR ; Show base DC.B 2 ; OR mode Base_AND_Data WORD 0,104,gBase_AND ; Show base DC.B 3 ; AND mode Base_Expl_Data WORD 0,104,0 ; Data for explode DC.B 0 ; Base_Cnt_Data WORD 38,0,gBase_Cnt ; Number of bases left DC.B 0 ; PSET Score_Data WORD 0,0,gScore ; Current score DC.B 0 Highscore_Data WORD 52,0,gScore ; Highest score DC.B 0 Ship_X Ship_Data WORD 0,9,gShip_OR ; Show ship DC.B 2 ; OR mode Shield_Data WORD 0,yShield,gShield ; Show shield DC.B 2 ; OR mode Missile_Data WORD 0,0,gM0_OR ; Shape 0, OR DC.B 2 ; Miss_Get_Data WORD 0,0,0,0 ; X,X1,Y,Y1 WORD Miss_Get_Buffer,7 ; Addr of buffer,length MGB_Data WORD 10,10,Miss_Get_Buffer DC.B 2 ; i0_OR WORD 0,0,gi0_OR ; OR 0 DC.B 2 ; i0_AND WORD 0,0,gi0_AND ; AND 0 DC.B 3 ; i1_OR WORD 0,0,gi1_OR ; DC.B 2 ; i1_AND WORD 0,0,gi1_AND ; DC.B 3 ; i2_OR WORD 0,0,gi2_OR ; DC.B 2 ; i2_AND WORD 0,0,gi2_AND ; DC.B 3 ; i3_OR WORD 0,0,gi3_OR ; DC.B 2 ; i3_AND WORD 0,0,gi3_AND ; DC.B 3 ; i4_OR WORD 0,0,gi4_OR ; DC.B 2 ; i4_AND WORD 0,0,gi4_AND ; DC.B 3 ; i5_OR WORD 0,0,gi5_OR ; DC.B 2 ; i5_AND WORD 0,0,gi5_AND ; DC.B 3 ; i6_OR WORD 0,0,gi6_OR ; DC.B 2 ; i6_AND WORD 0,0,gi6_AND ; DC.B 3 ; i7_OR WORD 0,0,gi7_OR ; DC.B 2 ; i7_AND WORD 0,0,gi7_AND ; DC.B 3 ; Inv_Y_Table DC.B 17,19,21,24,27,31,35,39 ; Top line Y for each sheet Miss_Type_Tab WORD gM0_AND,gM0_OR ; Line WORD gM0_AND,gM0_OR ; WORD gM1_AND,gM1_OR ; Zig-Zag WORD gM2_AND,gM2_OR ; WORD gE0_AND,gE0_OR ; Explosions WORD gE1_AND,gE1_OR ; WORD gE2_AND,gE2_OR ; WORD gE3_AND,gE3_OR ; WORD gE0_AND,gE0_OR ; WORD gE1_AND,gE1_OR ; WORD gE2_AND,gE2_OR ; WORD gE3_AND,gE3_OR ; Inv_Type_Tab WORD i0_AND,i0_OR ; Data for invaders WORD i1_AND,i1_OR ; WORD i0_AND,i0_OR ; WORD i1_AND,i1_OR ; WORD i2_AND,i2_OR ; WORD i3_AND,i3_OR ; WORD i2_AND,i2_OR ; WORD i3_AND,i3_OR ; WORD i4_AND,i4_OR ; WORD i5_AND,i5_OR ; WORD i4_AND,i4_OR ; WORD i5_AND,i5_OR ; WORD i6_AND,i6_OR ; WORD i7_AND,i7_OR ; WORD i6_AND,i6_OR ; WORD i7_AND,i7_OR ; WORD i6_AND,i6_OR ; WORD i7_AND,i7_OR ; WORD i6_AND,i6_OR ; WORD i7_AND,i7_OR ; Base_Expl_Tab WORD gEB0_AND,gEB0_OR ; Explosions WORD gEB1_AND,gEB1_OR ; WORD gEB2_AND,gEB2_OR ; WORD gEB3_AND,gEB3_OR ; WORD gEB0_AND,gEB0_OR ; WORD gEB1_AND,gEB1_OR ; WORD gEB2_AND,gEB2_OR ; WORD gEB3_AND,gEB3_OR ; ; Initial data for invaders ; Flag,X,Y,Type Invaders_Data DC.B 1,0,0,0 ; X,Y,Type DC.B 1,0,9,4 ; DC.B 1,0,18,8 ; DC.B 1,0,27,8 ; DC.B 1,0,36,12 ; DC.B 3,0,45,16 ; DC.B 1,10,0,1 ; 1 DC.B 1,10,9,5 ; DC.B 1,10,18,9 ; DC.B 1,10,27,9 ; DC.B 1,10,36,13 ; DC.B 3,10,45,16 ; DC.B 1,20,0,0 ; 2 DC.B 1,20,9,4 ; DC.B 1,20,18,8 ; DC.B 1,20,27,8 ; DC.B 1,20,36,12 ; DC.B 3,20,45,16 ; DC.B 1,30,0,1 ; 3 DC.B 1,30,9,5 ; DC.B 1,30,18,9 ; DC.B 1,30,27,9 ; DC.B 1,30,36,13 ; DC.B 3,30,45,16 ; DC.B 1,40,0,0 ; 4 DC.B 1,40,9,4 ; DC.B 1,40,18,8 ; DC.B 1,40,27,8 ; DC.B 1,40,36,12 ; DC.B 3,40,45,16 ; DC.B 1,50,0,1 ; 5 DC.B 1,50,9,5 ; DC.B 1,50,18,9 ; DC.B 1,50,27,9 ; DC.B 1,50,36,13 ; DC.B 7,50,45,16 ; Inv_Move_R_Tab DC.B 36,30,24,18,12,6 ; Table for move right order DC.B 35,29,23,17,11,5 ; DC.B 34,28,22,16,10,4 ; DC.B 33,27,21,15, 9,3 ; DC.B 32,26,20,14, 8,2 ; DC.B 31,25,19,13, 7,1 ; DC.B 0 ; Sentinel Inv_Move_L_Tab DC.B 6,12,18,24,30,36 ; Left DC.B 5,11,17,23,29,35 ; DC.B 4,10,16,22,28,34 ; DC.B 3, 9,15,21,27,33 ; DC.B 2, 8,14,20,26,32 ; DC.B 1, 7,13,19,25,31 ; DC.B 0 ; Sentinel Ship_Score_Tab WORD $50,$150,$100 SST_1 WORD $50,$200,$50,$45 WORD $50,$100,$50,$25 WORD $50,$60,$70,$80 WORD $200,$10,$200,$75 WORD $100,$150,$50,$300 WORD $FFFF ;......xxxx...... ;..xxxxxxxxxxxx.. ;xx.xx..xx..xx.xx ;..xxxxxxxxxxxx.. ;....xxx..xxx.... ;................ gShip_OR WORD 5,16 DC.B $20,$20,$50,$70,$78,$58,$D8,$F0 DC.B $F0,$D8,$58,$78,$70,$50,$20,$20 gShip_AND WORD 5,16 DC.B $DF,$DF,$8F,$8F,$87,$87,$07,$07 DC.B $07,$07,$87,$87,$8F,$8F,$DF,$DF gBase_Cnt WORD 8,8 ; One char DC.B 0,0,0,0,0,0,0,0 ; gScore WORD 8,32 ; four chars DC.B 0,0,0,0,0,0,0,0 ; DC.B 0,0,0,0,0,0,0,0 ; DC.B 0,0,0,0,0,0,0,0 ; DC.B 0,0,0,0,0,0,0,0 ; gM0_OR WORD 7,3 ; Sizes DC.B $00,$FE,$00 ; gM0_AND WORD 7,3 ; DC.B $FF,$01,$FF ; ;.x. ;x.. ;.x. ;..x ;.x. ;x.. ;.x. gM1_OR WORD 7,3 ; Zig DC.B $44,$AA,$10 ; gM1_AND WORD 7,3 ; DC.B $BB,$55,$EF ; gM2_OR WORD 7,3 ; Zig DC.B $10,$AA,$44 ; gM2_AND WORD 7,3 ; DC.B $EF,$55,$BB ; ;...x... ;.x.xxx. ;.xxxx.. ;x..x.x. ;..x.x.. ;.x..xx. ;.x..x.. gE0_OR WORD 7,7 DC.B $10,$66,$28,$F0,$6E,$54,$00 gE0_AND WORD 7,7 DC.B $EF,$99,$D7,$0F,$91,$AB,$FF ;.x.xx.. ;x.xx..x ;.x.xxx. ;x..x.x. ;...xx.x ;.x.x... ;..x..x. gE1_OR WORD 7,7 DC.B $50,$A4,$42,$FC,$A8,$32,$48 gE1_AND WORD 7,7 DC.B $AF,$5B,$BD,$03,$57,$CD,$B7 ;...x... ;.x.xx.. ;.xxxx.. ;...x.x. ;..x.x.. ;..x..x. ;....... gE2_OR WORD 7,7 DC.B $00,$60,$26,$F0,$68,$14,$00 gE2_AND WORD 7,7 DC.B $FF,$9F,$D9,$0F,$97,$EB,$FF ;...x... ;.x.x... ;...x.x. ;.x.x... ;.x...x. ;...x... ;....... gE3_OR WORD 7,7 DC.B $00,$4C,$00,$F4,$00,$28,$00 gE3_AND WORD 7,7 DC.B $FF,$B3,$FF,$0B,$FF,$D7,$FF ; Base explosions ;.......x....x.. ;.x.x..x..x..... ;..x.x...x..x.x. ;.x...x...x..xx. ;..x...x.xx..x.. ;.x..x...x..x... ;..xx.x...x.x.x. ;.x.x..x.x.x.x.. gEB0_OR WORD 8,15 DC.B $00,$55,$2A,$43,$24,$12,$49,$80 DC.B $2D,$5A,$01,$26,$99,$32,$00 gEB0_AND WORD 8,15 DC.B $FF,$AA,$D5,$BC,$DB,$ED,$B6,$7F DC.B $D2,$A5,$FE,$D9,$66,$CD,$FF ;..X....x....x.. ;...X..x...X.... ;.Xx...X..X...x. ;.x.X.x...x.X... ;X.x...x.xx..x.X ;.x.X..X.x.X.X.. ;..XX.x..X..x.x. ;.x.x..xXx.x.x.. gEB1_OR WORD 8,15 DC.B $08,$35,$AA,$57,$00,$12,$6B,$81 DC.B $0F,$38,$45,$12,$8D,$22,$08 gEB1_AND WORD 8,15 DC.B $F7,$CA,$55,$A8,$FF,$ED,$94,$7E DC.B $F0,$C7,$BA,$ED,$72,$DD,$F7 ;............... ;...X...X.X..... ;......X..X..... ;..X..X.....X... ;....X.XXX.X.... ;..X...XXX..X... ;...X.X..XX..X.. ;.....X.....X... gEB2_OR WORD 8,15 DC.B $00,$00,$14,$42,$08,$13,$2C,$4C DC.B $0E,$62,$08,$15,$02,$00,$00 gEB2_AND WORD 8,15 DC.B $FF,$FF,$ED,$BD,$F7,$EC,$D3,$B3 DC.B $F1,$9D,$F7,$EA,$FD,$FF,$FF ;............... ;...X........... ;.....X.....X.X. ;...X...X.X..... ;....XX....XX... ;...X.X..X...... ;...X..X..XX..X. ;..X.........X.. gEB3_OR WORD 8,15 DC.B $00,$00,$01,$56,$08,$2C,$02,$10 DC.B $04,$12,$0A,$28,$01,$42,$00 gEB3_AND WORD 8,15 DC.B $FF,$FF,$FE,$A9,$F7,$D3,$FD,$EF DC.B $FB,$ED,$F5,$D7,$FE,$BD,$FF ;...xx... ;..xxxx.. ;.x.xx.x. ;.x.xx.x. ;.xxxxxx. ;..x..x.. ;.x....x. ;..x..x.. gi0_OR WORD 8,8 ; Size DC.B $00,$3A,$4D,$F8,$F8,$4D,$3A,$00 gi0_AND WORD 8,8 DC.B $FF,$C5,$80,$00,$00,$80,$C5,$FF ;...xx... ;..xxxx.. ;.x.xx.x. ;.x.xx.x. ;.xxxxxx. ;..x..x.. ;...xx... ;..x..x.. gi1_OR WORD 8,8 ; Size DC.B $00,$38,$4D,$FA,$FA,$4D,$38,$00 gi1_AND WORD 8,8 DC.B $FF,$C7,$82,$00,$00,$82,$C7,$FF ;.x..x... ;..x..x.. ;.xxxxxx. ;xx.xx.xx ;xx.xx.xx ;.xxxxxx. ;.x....xx ;xx...... gi2_OR WORD 8,8 ; Size DC.B $19,$BF,$64,$3C,$BC,$64,$3E,$1A gi2_AND WORD 8,8 DC.B $E6,$40,$01,$01,$01,$80,$C1,$E5 ;...x..x. ;..x..x.. ;.xxxxxx. ;xx.xx.xx ;xx.xx.xx ;.xxxxxx. ;xx....x. ;......xx gi3_OR WORD 8,8 ; Size DC.B $1A,$3E,$64,$BC,$3C,$64,$BF,$19 gi3_AND WORD 8,8 DC.B $E5,$C1,$80,$01,$01,$01,$40,$E6 ;x....... ;.x....xx ;..xxxx.. ;.x.xx.x. ;xx.xx.x. ;xxxxxxxx ;x......x ;.......x gi4_OR WORD 8,8 ; Size DC.B $8E,$5C,$24,$3C,$3C,$24,$5C,$47 gi4_AND WORD 8,8 DC.B $71,$A1,$81,$81,$81,$81,$81,$80 ;.......x ;xx....x. ;..xxxx.. ;.x.xx.x. ;.x.xx.xx ;xxxxxxxx ;x......x ;x....... gi5_OR WORD 8,8 ; Size DC.B $47,$5C,$24,$3C,$3C,$24,$5C,$8E gi5_AND WORD 8,8 DC.B $80,$81,$81,$81,$81,$81,$A1,$71 ;..xxxx.. ;.xx..xx. ;xxxxxxxx ;xxxxxx.x ;x.xxxx.x ;x.xxxx.. ;..x..xx. ;.xx..... gi6_OR WORD 8,8 ; Size DC.B $3C,$71,$FF,$BC,$BC,$FE,$62,$38 gi6_AND WORD 8,8 DC.B $C3,$82,$00,$00,$01,$01,$85,$C7 ;..xxxx.. ;.xx..xx. ;xxxxxxxx ;x.xxxxxx ;x.xxxx.x ;..xxxx.x ;.xx..x.. ;.....xx. gi7_OR WORD 8,8 ; Size DC.B $38,$62,$FE,$BC,$BC,$FF,$71,$3C gi7_AND WORD 8,8 DC.B $C7,$85,$01,$01,$00,$00,$82,$C3 gKeys WORD 12,70 ; dY,dX DC.B $FF,$F0 DC.B $FF,$F0,$FD,$50,$F9,$50,$F1,$50 DC.B $E1,$50,$C1,$50,$81,$50,$A1,$50 DC.B $D1,$50,$E9,$50,$F5,$F0,$F9,$50 DC.B $FD,$50,$FF,$F0,$FF,$F0 DC.B 0,0,0,0,0,0,0,0 DC.B 0,0,0,0,0,0,0,0 DC.B 0,0,0,0,0,0,0,0,0,0 DC.B $FF,$F0,$F9,$F0,$F4,$F0,$E8,$70 DC.B $D0,$30,$80,$10,$FF,$F0 DC.B $90,$10,$FF,$F0,$90,$10 DC.B $FF,$F0,$90,$10,$FF,$F0 DC.B 0,0 DC.B 0,0,0,0,0,0,0,0,0,0 DC.B 0,0,0,0,0,0,0,0,0,0 DC.B 0,0 DC.B 0,0,0,0,0,0 DC.B $FF,$F0,$90,$10,$FF,$F0 DC.B $90,$10,$FF,$F0,$90,$10 DC.B $FF,$F0,$80,$10,$D0,$30 DC.B $E8,$70,$F4,$F0,$F9,$F0 DC.B $FF,$F0 gBase_OR WORD 8,13 DC.B $04,$1E,$07,$3B,$1D,$1D DC.B $DF,$1D,$1D,$3B,$07,$1E,$04 gBase_AND WORD 8,13 DC.B $FB,$E1,$F8,$C4,$E2,$E2 DC.B $20,$E2,$E2,$C4,$F8,$E1,$FB gShield WORD 11,14 DC.B $1F,$E0,$3F,$E0,$7F,$E0,$FF,$E0 DC.B $FF,$E0,$FF,$C0,$FF,$80 DC.B $FF,$80,$FF,$C0,$FF,$E0 DC.B $FF,$E0,$7F,$E0,$3F,$E0,$1F,$E0 SMK_Data DC.B 2,14 ; key block position DC.B 3,1 ; key block = 3 keys wide x 1 key high DC.B 0 ; key code DC.B $07 ; attribute DC.B $00 ; using 'CHARACTER' mode DC.B 'M','E','N','U',' ' sName DC.B $01,'V','A','D','E','R','S' DC.B ' ',' ',$00 key_buffer DC.B 0,0 ; ports 25/26 for col 0 DC.B 0,0 ; ports 25/26 for col 1 DC.B 0,0 ; ports 25/26 for col 2 DC.B 0,0 ; ports 25/26 for col 3 DC.B 0,0 ; ports 25/26 for col 4 kMenu DC.B 0 ; Key pressed flags kLeft DC.B 0 ; kRight DC.B 0 ; kFire DC.B 0 ; Score_D DC.W 0 ; Score Score_A DC.W 0 ; Displayed Highscore DC.W 0 ; Highest Sheet_No DC.B 0 ; Current sheet no. 0..? Game_Flag DC.B 0 ; Alive or dead or new sheet Base_X DC.B 0 ; Position of base center Base_Cnt_D DC.B 0 ; Number of bases Base_Cnt_A DC.B 0 ; Displayed Inv_X_Step DC.B 0 ; Current step Inv_Y_Step DC.B 0 ; Count to add to Y Inv_Change_Dir DC.B 0 ; Flag for hit side Inv_Moved_Flag DC.B 0 ; Flag for end of sheet pInv_Move_Tab DC.W 0 ; Ptr to table of move order Ship_Delay DC.W 0 ; Counter for spaceship Ship_Flag DC.B 0 ; Alive/dead Ship_Disp DC.B 0 ; Direction pShip_Score DC.W 0 ; Ptr to score table Miss_Get_Buffer WORD 7,3 ; Widths MGB DC.B 0,0,0 ; Data Invaders_Tab EQU * ; Table for invaders Missile_Tab EQU Invaders_Tab + 200 ; Table for missiles END