START EQU 0D40H A158B EQU 158BH L1439 EQU 1A55H ;************************************************************* ; RAM usage (you probably shouldn't mess with these directly) ;************************************************************* ; EQU 7000H ; 32 unused bytes SndArray EQU 7020H ; music array pointer? NoiseP EQU 7022H ; Pointer to program for noise generator Tone1P EQU 7024H ; Pointer to program for tone1 generator Tone2P EQU 7026H ; Pointer to program for tone2 generator Tone3P EQU 7028H ; Pointer to program for tone3 generator NoiseCtlShad EQU 702AH ; Noise control register shadow ; Free memory from 702B thru 73B9 Stack EQU 73B9H ; Default initial stack pointer ParmArea EQU 73BAH ; Parameter storage for PCOPY parameters VDP0Shad EQU 73C3H ; VDP register 0 shadow VDP1Shad EQU 73C4H ; VDP register 1 shadow ; EQU 73C5H ; unused? D73C6 EQU 73C6H ; flag byte? WrtRAMSprt EQU 73C7H ; BlkWrtVRAM to RAM sprite attr table if =1 RandSeed EQU 73C8H ; Random number seed D73CA EQU 73CAH ; unknown D73CB EQU 73CBH ; unknown D73CC EQU 73CCH ; unknown D73CD EQU 73CDH ; unknown D73CF EQU 73CFH ; unknown D73D1 EQU 73D1H ; unknown TimerList EQU 73D3H ; Pointer to timer list TimerAux EQU 73D5H ; Pointer to end of timer aux storage RawCtlState EQU 73D7H ; Raw controller state table (2 x 10 bytes) PulseCnt1 EQU 73EBH ; Pulse counter #1 PulseCnt2 EQU 73ECH ; Pulse counter #2 ; EQU 73EDH ; unused? Joy1Shad EQU 73EEH ; shadow for joystick #1 Joy2Shad EQU 73EFH ; shadow for joystick #2 Key1Shad EQU 73F0H ; shadow for keypad #1 Key2Shad EQU 73F1H ; shadow for keypad #2 VDPBaseShad EQU 73F2H ; shadow for VDP table base addresses SprtTabShad EQU 73F2H ; shadow for sprite table VRAM base addr SprtPatTabShad EQU 73F4H ; shadow for sprite pattern generator VRAM base addr NameTabShad EQU 73F6H ; shadow for name table VRAM base address PatGenTabShad EQU 73F8H ; shadow for pattern generator VRAM base addr ClrTabShad EQU 73FAH ; shadow for color table VRAM base address ; EQU 73FCH ; unused? D73FE EQU 73FEH ; temp3 ;*************************************** ; Cartridge header addresses ;*************************************** Cart_Sig EQU 8000H ; AA55 = title screen, 55AA = no screen RamSprtTab EQU 8002H ; RAM sprite attribute table pointer RAMSprtIdx EQU 8004H ; sprite index table pointer VDP_Temp EQU 8006H ; pointer to temp image storage (up to 40 bytes used) CtlState EQU 8008H ; pointer to controller state table (2 + 2x5 bytes) Cart_Start EQU 800AH ; start of cart code V_RST_08H EQU 800CH ; RST 08H vector V_RST_10H EQU 800FH ; RST 10H vector V_RST_18H EQU 8012H ; RST 18H vector V_RST_20H EQU 8015H ; RST 20H vector V_RST_28H EQU 8018H ; RST 28H vector V_RST_30H EQU 801BH ; RST 30H vector V_RST_38H EQU 801EH ; RST 38H vector V_NMI EQU 8021H ; NMI vector (vertical blank interrupt) Cart_Title EQU 8024H ; Title string "LINE 3/LINE 2/yyyy" ;*************************************** ; Offsets into data blocks ;*************************************** ; Offsets into RawCtlState RawCtlLeft EQU 00H ; raw left controller state RawCtlRight EQU 0AH ; raw right controller state ; Offsets into RawCtlLeft and RawCtlRight RawCtlLFBit EQU 00H ; previous left fire bit RawCtlLFState EQU 01H ; left fire button state RawCtlDBits EQU 02H ; previous directional bits RawCtlDState EQU 03H ; directionals state ; EQU 04H ; unused? ; EQU 05H ; unused? RawCtlRFBit EQU 06H ; previous right fire bit RawCtlRFState EQU 07H ; right fire button state RawCtlKPBit EQU 08H ; previous keypad bits RawCtlKPState EQU 09H ; keypad state ; Offsets into CtlState table CtlStateLFlag EQU 00H ; left controller flags CtlStateRFlag EQU 01H ; right controller flags CtlStateLeft EQU 02H ; left controller state CtlStateRight EQU 07H ; right controller state ;CtlStateLeftL EQU 02H ; CtlStateLeft+CtlStateLFire ;CtlStateLeftD EQU 03H ; CtlStateLeft+CtlStateDir ;CtlStateLeftS EQU 04H ; CtlStateLeft+CtlStateSpin ;CtlStateLeftR EQU 05H ; CtlStateLeft+CtlStateRFire ;CtlStateLeftK EQU 06H ; CtlStateLeft+CtlStateKey ;CtlStateRightL EQU 07H ; CtlStateRight+CtlStateLFire ;CtlStateRightD EQU 08H ; CtlStateRight+CtlStateDir ;CtlStateRightS EQU 09H ; CtlStateRight+CtlStateSpin ;CtlStateRightR EQU 0AH ; CtlStateRight+CtlStateRFire ;CtlStateRightK EQU 0BH ; CtlStateRight+CtlStateKey ; CtlStateLF/CtlStateRF bits CtlCheckMe EQU 80H ; 7 ; if =0, do not check this ctrl at all ; EQU 40H ; 6 ; unused? ; EQU 20H ; 5 ; unused? CtlCheckKP EQU 10H ; 4 ; check keypad CtlCheckRFire EQU 08H ; 3 ; check right fire button CtlCheckSpinner EQU 04H ; 2 ; check spinner CtlCheckDir EQU 02H ; 1 ; check directionals CtlCheckLFire EQU 01H ; 0 ; check left fire button ; Offsets into CtlStateLeft and CtlStateRight CtlStateLFire EQU 00H ; left fire button CtlStateDir EQU 01H ; directionals CtlStateSpin EQU 02H ; spinner value CtlStateRFire EQU 03H ; right fire button CtlStateKey EQU 04H ; key code ;*************************************** ; I/O port addresses ;*************************************** IO_KP_Select EQU 080H ; Keypad select output port IO_Joy_Select EQU 0C0H ; Joystick select output port IO_Joy1 EQU 0FCH ; Joystick 1 input port IO_Joy2 EQU 0FFH ; Joystick 2 input port IO_Sound EQU 0FFH ; Sound chip output port IO_VDP_Data EQU 0BEH ; VDP data port IO_VDP_Addr EQU 0BFH ; VDP VRAM address output port IO_VDP_Status EQU 0BFH ; VDP status input port ;*************************************** ; VDP table identifiers ;*************************************** SprAttrTable EQU 00H ; Sprite attribute table (1B00) SprPatTable EQU 01H ; Sprite pattern generator (3800) NameTable EQU 02H ; Name table (display) (1800) PatTable EQU 03H ; Pattern generator table (0000) ColorTable EQU 04H ; Color table (2000) ;******************************************************** ; ROM addresses (what do they do? Use The Source, Luke!) ;******************************************************** ; EQU 0069H ; decimal 60 (vertical refresh rate?) FontA EQU 006AH ; points to font bitmap for 'A' Font0 EQU 006CH ; points to font bitmap for '0' DoSound EQU 1F61H L1F64 EQU 1F64H L1F67 EQU 1F67H FlipRL EQU 1F6AH FlipUD EQU 1F6DH Rotate EQU 1F70H Expand EQU 1F73H ReadCtlRaw EQU 1F76H ReadCtl EQU 1F79H SkillScrn EQU 1F7CH InitFont EQU 1F7FH FillVRAM EQU 1F82H InitVDP EQU 1F85H ReadSpinner EQU 1F88H PBaseLoad EQU 1F8BH PBlkReadVRAM EQU 1F8EH PBlkWrtVRAM EQU 1F91H PInitRAMSprt EQU 1F94H PCopyRAMSprt EQU 1F97H PInitTimers EQU 1F9AH PStopTimer EQU 1F9DH PStartTimer EQU 1FA0H PTestTimer EQU 1FA3H PWriteReg EQU 1FA6H PWrtVRAM EQU 1FA9H PReadVRAM EQU 1FACH L1FAF EQU 1FAFH PInitSound EQU 1FB2H PAddSound EQU 1FB5H BaseLoad EQU 1FB8H BlkReadVRAM EQU 1FBBH BlkWrtVRAM EQU 1FBEH InitRAMSprt EQU 1FC1H CopyRAMSprt EQU 1FC4H InitTimers EQU 1FC7H StopTimer EQU 1FCAH StartTimer EQU 1FCDH TestTimer EQU 1FD0H RunTimers EQU 1FD3H NoSound EQU 1FD6H WriteReg EQU 1FD9H VDP_Status EQU 1FDCH WrtVRAM EQU 1FDFH ReadVRAM EQU 1FE2H L1FE5 EQU 1FE5H L1FE8 EQU 1FE8H ReadCtlState EQU 1FEBH InitSound EQU 1FEEH AddSound EQU 1FF1H UpdateSound EQU 1FF4H L1FF7 EQU 1FF7H L1FFA EQU 1FFAH Random EQU 1FFDH ;----------------------------------------------------------------------- ; RAM storage ;----------------------------------------------------------------------- ORG 7030H PrevDir1 DS 2 PrevKey1 DS 2 PrevDir2 DS 2 PrevKey2 DS 2 ; Index register offsets PrevDir EQU 0 PrevKey EQU 2 LSpin DS 1 RSpin DS 1 ;----------------------------------------------------------------------- ; Character codes for special font characters ;----------------------------------------------------------------------- NE EQU 01H NW EQU 02H SE EQU 03H SW EQU 04H F1 EQU 05H F2 EQU 06H F3 EQU 07H F4 EQU 08H ;----------------------------------------------------------------------- ; Put code in ROM space ;----------------------------------------------------------------------- ; at L1439, put a jump to the following ORG L1439 JP MAIN ORG START ; loop here until button pressed MAIN OUT (IO_Joy_Select),A ; select left fire/stick mode IN A,(IO_Joy1) ; read left fire button LD B,A IN A,(IO_Joy2) ; read right fire button AND B ; OR the two sticks together AND 40H ; mask out the fire button bit JR NZ,MAIN ; exit if pressed CALL InitScrn LD HL,1800H ; clear the screen LD DE,0300H LD A,' ' LD BC,01C0H ; Unblank the screen CALL WriteReg CALL ClearXtra LD A,'O' LD (LSpin),A LD (RSpin),A ; LD DE,0000H ; display character set ;Loop LD A,E ; CALL WrScrnByte ; INC E ; LD A,E ; OR A ; JR NZ,Loop ;Loop ;+ wait for vert retrace (polled, not interrupt) ;+ update spinner count ;* read controls ;* draw directionals on screen ;* draw fire buttons on screen ;* draw keypad on screen ;+ draw spinner count on screen ; JR Loop Loop CALL ReadCtlRaw CALL UpdFire CALL UpdDir CALL UpdKpd CALL UpdSpin JR Loop ; JR $ ; that's all for today ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- VRTest LD A,':'+80H ; start with block on LD DE,0190H ; middle of the screen VRTest_a CALL WrScrnByte ; put block on screen VRTest_b LD B,60 ; count 60 frames CALL WaitVR ; wait for VR to go on and off CALL WaitVROff DJNZ VRTest_b ; loop for 60 frame count XOR 80H ; invert block JR VRTest_a ; loop to write new block WaitVR CALL VDP_Status ; Get VDP status OR A ; Test high bit (interrupt) JP M,WaitVR ; Loop if set RET WaitVROff CALL VDP_Status ; Get VDP status OR A ; Test high bit (interrupt) JP P,WaitVR ; Loop if set RET ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- ClearXtra LD HL,XTRA_TBL ClearXtra_a LD E,(HL) ; get next screen address INC HL LD D,(HL) INC HL LD A,D ; exit if address = FFFF AND E INC A RET Z LD B,(HL) ; get text length INC HL ClearXtra_b LD A,(HL) INC HL CALL WrScrnByte INC DE DJNZ ClearXtra_b JR ClearXtra_a ;----------------------------------------------------------------------- ; ; F1=018C F2=01CC F1=01AC F2=01EC ;----------------------------------------------------------------------- UpdFire LD H,0 ; left ctl LD DE,018CH ; screen position CALL UpdFire_a LD H,1 ; right ctl LD E,9CH ; screen position UpdFire_a LD L,0 ; left fire button LD B,F1 ; F1 character code CALL UpdFire_b LD L,1 ; right fire button LD A,E ; F2 screen position ADD A,40H LD E,A LD B,F2 ; F2 character code UpdFire_b PUSH BC CALL MyReadCtl ; read controller POP BC RLA ; convert 40H to 80H ADD A,B ; add in F1/F2 code JP WrScrnByte ; write to screen and return ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- UpdDir LD H,0 ; left ctl LD E,0 ; screen position CALL UpdDir_a LD H,1 ; right ctl LD E,10H ; screen position UpdDir_a LD L,0 ; select joystick mode CALL MyReadCtl ; read controller LD A,B ; get controller bits LD HL,DIR_TBL UpdDir_b LD C,(HL) ; get character code INC HL LD A,C OR A RET Z ; exit if end of table LD A,(HL) ; get direction bit INC HL PUSH DE PUSH AF LD A,(HL) ; get low byte of screen address INC HL ADD A,E LD E,A LD D,(HL) ; get high byte of screen address INC HL POP AF AND B ; test if direction bit is set LD A,C ; get character code JR Z,UpdDir_c ; branch if direction bit not set XOR 80H ; inverse video if set LD C,A UpdDir_c CALL WrScrnByte ; write to screen and return POP DE ; restore screen base JR UpdDir_b ; loop for next direction bit ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- UpdKpd LD H,0 ; left ctl LD E,0 ; screen position CALL UpdKpd_a LD H,1 ; right ctl LD E,10H ; screen position UpdKpd_a LD L,1 ; select keypad mode CALL MyReadCtl ; read controller LD A,B ; get keypad bits AND 0FH LD HL,KPD_TBL UpdKpd_b LD C,(HL) ; get character code INC HL LD A,C OR A RET Z ; exit if end of table LD A,(HL) ; get key code INC HL PUSH DE PUSH AF LD A,(HL) ; get low byte of screen address INC HL ADD A,E LD E,A LD D,(HL) ; get high byte of screen address INC HL POP AF CP B ; test key code LD A,C ; get character code JR NZ,UpdKpd_c ; branch if key doesn't match XOR 80H ; inverse video if set LD C,A UpdKpd_c CALL WrScrnByte ; write to screen and return POP DE ; restore screen base JR UpdKpd_b ; loop for next direction bit ;----------------------------------------------------------------------- ; ; ENTRY: H = 0 for left controller, 1 for right controller ; L = 0 for joystick/left fire/spinner, 1 for keypad/right fire ; EXIT: A = 40H if fire button set ; B = joystick directionals or raw key code ; C = spinner pulse counter if L = 0 ; ;----------------------------------------------------------------------- MyReadCtl PUSH DE PUSH HL CALL _ReadCtl LD A,H ; fire button bit AND 40H ; (exits with Z-flag set properly) LD B,L ; joystick directionals/raw key code LD C,E ; spinner pulse count (left only) POP HL POP DE RET ;*************************************** ; 1F79 ReadCtl ; ; Read a joystick or keypad controller and a fire button ; ; ENTRY H = 0 for left control, 1 for right ; L = 0 for joystick/left fire, 1 for keypad/right fire ; EXIT: H = fire button in 40H bit ; L = joystick directionals or key code ; E = old pulse counter (only if L=0) ;*************************************** _ReadCtl LD A,L ; Check if reading keypad CP 01H JR Z,_ReadCtl_b ; Branch if reading keypad LD BC,PulseCnt1 ; Point BC to pulse counter LD A,H OR A JR Z,_ReadCtl_a ; branch if left controller INC BC ; Point BC to PulseCnt2 _ReadCtl_a LD A,(BC) ; E = old pulse counter value LD E,A XOR A ; Clear pulse counter LD (BC),A LD A,H OR A LD A,(Joy1Shad) JR Z,L1148_a LD A,(Joy2Shad) L1148_a LD D,A ; Save port bits in D AND 0FH LD L,A ; L = directional bits JR _ReadCtl_c ; Read the keypad _ReadCtl_b LD A,H OR A LD A,(Key1Shad) JR Z,L1148_b LD A,(Key2Shad) L1148_b AND 0FH ; Mask off keypad bits LD HL,Keypad_Table ; Index into keypad table LD B,00H LD C,A ADD HL,BC LD L,(HL) ; L = key code (or 0FH if none) _ReadCtl_c LD A,D AND 40H LD H,A ; H = right fire button bit RET Keypad_Table DB 0FH,06H,01H,03H DB 09H,00H,0AH,0CH DB 02H,0BH,07H,0DH DB 05H,04H,08H,0FH ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- ;UpdSpin IN A,(IO_Joy1) ; LD DE,02A5H ; screen position ; CALL UpdSpin_a ; ; IN A,(IO_Joy2) ; LD E,B5H ; screen position ; ;UpdSpin_a LD C,A ; save flags ; LD A,10H ; test 10H bit ; LD B,'1' ; CALL UpdSpin_b ; ; INC E ; F2 screen position ; LD A,20H ; LD B,'2' ; ;UpdSpin_b AND C ; LD A,0 ; ; JR Z,UpdSpin_c ; LD A,80H ; ;UpdSpin_c ADD A,B ; JP WrScrnByte ; write to screen and return ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- UpdSpin LD A,(Joy1Shad) LD DE,02A7H ; screen position LD HL,LSpin CALL UpdSpin_a LD A,(Joy2Shad) LD E,B7H ; screen position INC HL UpdSpin_a LD C,A ; save flags AND 10H ; test 10H bit RET Z ; exit if no spinner motion LD A,C AND 20H JR Z,UpdSpin_b DEC (HL) JR UpdSpin_c UpdSpin_b INC (HL) UpdSpin_c LD A,(HL) JP WrScrnByte ; write to screen and return ;----------------------------------------------------------------------- ; ; DE = VRAM address ; A = byte to write ; ;----------------------------------------------------------------------- WrScrnByte PUSH AF PUSH BC PUSH DE PUSH HL PUSH AF ; add offset to name table base LD A,D ADD A,18H LD D,A POP AF EX DE,HL ; put screen address in HL LD DE,1 ; count = 1 CALL FillVRAM ; write byte, destroys AF, C, DE POP HL POP DE POP BC POP AF RET ;----------------------------------------------------------------------- ; ;----------------------------------------------------------------------- InitScrn XOR A ; Fill VRAM from address 0000H LD H,A ; with 00H LD L,A ; LD DE,4000H ; length 4000H CALL FillVRAM ; Do the fill CALL InitVDP ; Initialize the video chip LD HL,2000H ; Initialize color table to Wht/Blk LD A,0F0H LD DE,32 CALL FillVRam InitMyFont CALL InitFont ; Load normal ASCII bitmaps LD HL,A158B ; Point to main ASCII bitmaps LD DE,8*009DH ; Address of character code storage LD BC,8*0063H ; Length of data CALL NotWrtVRAM ; Copy inverse video data LD HL,CustomFont ; Write custom font characters LD DE,8*NE LD BC,8*8 CALL XWrtVRAM LD HL,CustomFont ; Write inverse custom font characters LD DE,8*(NE+80H) LD BC,8*8 JP NotWrtVRAM ; custom font characters CustomFont DB 090H,0D0H,0B0H,097H,004H,006H,004H,007H ; 01 = 'NE' DB 090H,0D0H,0B0H,090H,000H,011H,015H,00AH ; 02 = 'NW' DB 070H,040H,020H,017H,074H,006H,004H,007H ; 03 = 'SE' DB 070H,040H,020H,010H,070H,011H,015H,00AH ; 04 = 'SW' DB 078H,040H,070H,040H,040H,048H,008H,008H ; 05 = 'F1' DB 078H,040H,070H,040H,04CH,054H,008H,01CH ; 06 = 'F2' DB 078H,040H,070H,048H,054H,048H,004H,018H ; 07 = 'F3' DB 078H,040H,070H,044H,04CH,054H,03EH,004H ; 08 = 'F4' RET ;======================================= ; NotWrtVRAM ; ; Write inverted data to VRAM (such as for an inverse video font) ; ; ENTRY HL points to data to be written ; DE = VRAM address ; BC = byte count ; EXIT: HL = first byte after data that was written ; AF, BC destroyed ;======================================= NotWrtVRAM LD A,E ; Send LSB of address OUT (IO_VDP_Addr),A LD A,D ADD A,40H ; Send MSB of address + 40H OUT (IO_VDP_Addr),A NotWrtVRAM_a LD A,(HL) ; Get next byte CPL ; Invert the bits OUT (IO_VDP_Data),A ; Send it to VRAM INC HL DEC BC LD A,B OR C JR NZ,NotWrtVRAM_a RET ;----------------------------------------------------------------------- ; This is a wrapper around WrtVRAM to get around a bug which ; causes it to write 256 bytes too few if (B != 00H) && (C != 00H) ; ; (ReadVRAM has the same bug) ; ; ENTRY HL = data address ; DE = VRAM address ; BC = byte count ;----------------------------------------------------------------------- XWrtVRAM LD A,C ; no bug if C=00H OR A JR Z,XWrtVRAM_a INC B ; else account for the missing page XWrtVRAM_a JP WrtVRAM ;----------------------------------------------------------------------- DIR_TBL DB 'N',01H DW 0028H DB 'E',02H DW 00ACH DB 'S',04H DW 0128H DB 'W',08H DW 00A4H DB 00H ;----------------------------------------------------------------------- KPD_TBL DB '0',00H DW 0246H DB '1',01H DW 0183H DB '2',02H DW 0186H DB '3',03H DW 0189H DB '4',04H DW 01C3H DB '5',05H DW 01C6H DB '6',06H DW 01C9H DB '7',07H DW 0203H DB '8',08H DW 0206H DB '9',09H DW 0209H DB '*',0AH DW 0243H DB '#',0BH DW 0249H DB F3,0CH DW 020CH DB F4,0DH DW 024CH DB 00H ;----------------------------------------------------------------------- XTRA_TBL ; DW 018CH ; DB 1,F1 ; DW 01CCH ; DB 1,F2 ; DW 019CH ; DB 1,F1 ; DW 01DCH ; DB 1,F2 DW 00A8H DB 1,'+' DW 00B8H DB 1,'+' DW 0023H DB 2,'#1' DW 0033H DB 2,'#2' DW 02A4H DB 7,'< 0 >' DW 02B4H DB 7,'< 0 >' DW 02E4H DB 23,'Controller Tester V0.06' DW 0FFFFH ; this point should be less than 1105H END