Skip to content

Instantly share code, notes, and snippets.

@SelvinPL
Last active July 29, 2026 11:58
Show Gist options
  • Select an option

  • Save SelvinPL/60be43a40f9c14314d519840cf659bbf to your computer and use it in GitHub Desktop.

Select an option

Save SelvinPL/60be43a40f9c14314d519840cf659bbf to your computer and use it in GitHub Desktop.
Tiny Basic GB
SECTION "Font Data", ROM0
FontGraphics::
db $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $7E, $7E, $7E, $7E
db $7E, $7E, $81, $81, $A5, $A5, $81, $81, $BD, $BD, $99, $99, $81, $81, $7E, $7E
db $7E, $7E, $FF, $FF, $DB, $DB, $FF, $FF, $C3, $C3, $E7, $E7, $FF, $FF, $7E, $7E
db $6C, $6C, $FE, $FE, $FE, $FE, $FE, $FE, $7C, $7C, $38, $38, $10, $10, $00, $00
db $10, $10, $38, $38, $7C, $7C, $FE, $FE, $7C, $7C, $38, $38, $10, $10, $00, $00
db $38, $38, $7C, $7C, $38, $38, $FE, $FE, $FE, $FE, $7C, $7C, $38, $38, $7C, $7C
db $10, $10, $10, $10, $38, $38, $7C, $7C, $FE, $FE, $7C, $7C, $38, $38, $7C, $7C
db $00, $00, $00, $00, $18, $18, $3C, $3C, $3C, $3C, $18, $18, $00, $00, $00, $00
db $FF, $FF, $FF, $FF, $E7, $E7, $C3, $C3, $C3, $C3, $E7, $E7, $FF, $FF, $FF, $FF
db $00, $00, $3C, $3C, $66, $66, $42, $42, $42, $42, $66, $66, $3C, $3C, $00, $00
db $FF, $FF, $C3, $C3, $99, $99, $BD, $BD, $BD, $BD, $99, $99, $C3, $C3, $FF, $FF
db $0F, $0F, $07, $07, $0F, $0F, $7D, $7D, $CC, $CC, $CC, $CC, $CC, $CC, $78, $78
db $3C, $3C, $66, $66, $66, $66, $66, $66, $3C, $3C, $18, $18, $7E, $7E, $18, $18
db $3F, $3F, $33, $33, $3F, $3F, $30, $30, $30, $30, $70, $70, $F0, $F0, $E0, $E0
db $7F, $7F, $63, $63, $7F, $7F, $63, $63, $63, $63, $67, $67, $E6, $E6, $C0, $C0
db $99, $99, $5A, $5A, $3C, $3C, $E7, $E7, $E7, $E7, $3C, $3C, $5A, $5A, $99, $99
db $80, $80, $E0, $E0, $F8, $F8, $FE, $FE, $F8, $F8, $E0, $E0, $80, $80, $00, $00
db $02, $02, $0E, $0E, $3E, $3E, $FE, $FE, $3E, $3E, $0E, $0E, $02, $02, $00, $00
db $18, $18, $3C, $3C, $7E, $7E, $18, $18, $18, $18, $7E, $7E, $3C, $3C, $18, $18
db $66, $66, $66, $66, $66, $66, $66, $66, $66, $66, $00, $00, $66, $66, $00, $00
db $7F, $7F, $DB, $DB, $DB, $DB, $7B, $7B, $1B, $1B, $1B, $1B, $1B, $1B, $00, $00
db $3E, $3E, $63, $63, $38, $38, $6C, $6C, $6C, $6C, $38, $38, $CC, $CC, $78, $78
db $00, $00, $00, $00, $00, $00, $00, $00, $7E, $7E, $7E, $7E, $7E, $7E, $00, $00
db $18, $18, $3C, $3C, $7E, $7E, $18, $18, $7E, $7E, $3C, $3C, $18, $18, $FF, $FF
db $18, $18, $3C, $3C, $7E, $7E, $18, $18, $18, $18, $18, $18, $18, $18, $00, $00
db $18, $18, $18, $18, $18, $18, $18, $18, $7E, $7E, $3C, $3C, $18, $18, $00, $00
db $00, $00, $18, $18, $0C, $0C, $FE, $FE, $0C, $0C, $18, $18, $00, $00, $00, $00
db $00, $00, $30, $30, $60, $60, $FE, $FE, $60, $60, $30, $30, $00, $00, $00, $00
db $00, $00, $00, $00, $C0, $C0, $C0, $C0, $C0, $C0, $FE, $FE, $00, $00, $00, $00
db $00, $00, $24, $24, $66, $66, $FF, $FF, $66, $66, $24, $24, $00, $00, $00, $00
db $00, $00, $18, $18, $3C, $3C, $7E, $7E, $FF, $FF, $FF, $FF, $00, $00, $00, $00
db $00, $00, $FF, $FF, $FF, $FF, $7E, $7E, $3C, $3C, $18, $18, $00, $00, $00, $00
db $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
db $30, $30, $78, $78, $78, $78, $30, $30, $30, $30, $00, $00, $30, $30, $00, $00
db $6C, $6C, $6C, $6C, $6C, $6C, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
db $6C, $6C, $6C, $6C, $FE, $FE, $6C, $6C, $FE, $FE, $6C, $6C, $6C, $6C, $00, $00
db $30, $30, $7C, $7C, $C0, $C0, $78, $78, $0C, $0C, $F8, $F8, $30, $30, $00, $00
db $00, $00, $C6, $C6, $CC, $CC, $18, $18, $30, $30, $66, $66, $C6, $C6, $00, $00
db $38, $38, $6C, $6C, $38, $38, $76, $76, $DC, $DC, $CC, $CC, $76, $76, $00, $00
db $60, $60, $60, $60, $C0, $C0, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
db $18, $18, $30, $30, $60, $60, $60, $60, $60, $60, $30, $30, $18, $18, $00, $00
db $60, $60, $30, $30, $18, $18, $18, $18, $18, $18, $30, $30, $60, $60, $00, $00
db $00, $00, $66, $66, $3C, $3C, $FF, $FF, $3C, $3C, $66, $66, $00, $00, $00, $00
db $00, $00, $30, $30, $30, $30, $FC, $FC, $30, $30, $30, $30, $00, $00, $00, $00
db $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $30, $30, $30, $30, $60, $60
db $00, $00, $00, $00, $00, $00, $FC, $FC, $00, $00, $00, $00, $00, $00, $00, $00
db $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $30, $30, $30, $30, $00, $00
db $06, $06, $0C, $0C, $18, $18, $30, $30, $60, $60, $C0, $C0, $80, $80, $00, $00
db $7C, $7C, $C6, $C6, $CE, $CE, $DE, $DE, $F6, $F6, $E6, $E6, $7C, $7C, $00, $00
db $30, $30, $70, $70, $30, $30, $30, $30, $30, $30, $30, $30, $FC, $FC, $00, $00
db $78, $78, $CC, $CC, $0C, $0C, $38, $38, $60, $60, $CC, $CC, $FC, $FC, $00, $00
db $78, $78, $CC, $CC, $0C, $0C, $38, $38, $0C, $0C, $CC, $CC, $78, $78, $00, $00
db $1C, $1C, $3C, $3C, $6C, $6C, $CC, $CC, $FE, $FE, $0C, $0C, $1E, $1E, $00, $00
db $FC, $FC, $C0, $C0, $F8, $F8, $0C, $0C, $0C, $0C, $CC, $CC, $78, $78, $00, $00
db $38, $38, $60, $60, $C0, $C0, $F8, $F8, $CC, $CC, $CC, $CC, $78, $78, $00, $00
db $FC, $FC, $CC, $CC, $0C, $0C, $18, $18, $30, $30, $30, $30, $30, $30, $00, $00
db $78, $78, $CC, $CC, $CC, $CC, $78, $78, $CC, $CC, $CC, $CC, $78, $78, $00, $00
db $78, $78, $CC, $CC, $CC, $CC, $7C, $7C, $0C, $0C, $18, $18, $70, $70, $00, $00
db $00, $00, $30, $30, $30, $30, $00, $00, $00, $00, $30, $30, $30, $30, $00, $00
db $00, $00, $30, $30, $30, $30, $00, $00, $00, $00, $30, $30, $30, $30, $60, $60
db $18, $18, $30, $30, $60, $60, $C0, $C0, $60, $60, $30, $30, $18, $18, $00, $00
db $00, $00, $00, $00, $FC, $FC, $00, $00, $00, $00, $FC, $FC, $00, $00, $00, $00
db $60, $60, $30, $30, $18, $18, $0C, $0C, $18, $18, $30, $30, $60, $60, $00, $00
db $78, $78, $CC, $CC, $0C, $0C, $18, $18, $30, $30, $00, $00, $30, $30, $00, $00
db $7C, $7C, $C6, $C6, $DE, $DE, $DE, $DE, $DE, $DE, $C0, $C0, $78, $78, $00, $00
db $30, $30, $78, $78, $CC, $CC, $CC, $CC, $FC, $FC, $CC, $CC, $CC, $CC, $00, $00
db $FC, $FC, $66, $66, $66, $66, $7C, $7C, $66, $66, $66, $66, $FC, $FC, $00, $00
db $3C, $3C, $66, $66, $C0, $C0, $C0, $C0, $C0, $C0, $66, $66, $3C, $3C, $00, $00
db $F8, $F8, $6C, $6C, $66, $66, $66, $66, $66, $66, $6C, $6C, $F8, $F8, $00, $00
db $FE, $FE, $62, $62, $68, $68, $78, $78, $68, $68, $62, $62, $FE, $FE, $00, $00
db $FE, $FE, $62, $62, $68, $68, $78, $78, $68, $68, $60, $60, $F0, $F0, $00, $00
db $3C, $3C, $66, $66, $C0, $C0, $C0, $C0, $CE, $CE, $66, $66, $3E, $3E, $00, $00
db $CC, $CC, $CC, $CC, $CC, $CC, $FC, $FC, $CC, $CC, $CC, $CC, $CC, $CC, $00, $00
db $78, $78, $30, $30, $30, $30, $30, $30, $30, $30, $30, $30, $78, $78, $00, $00
db $1E, $1E, $0C, $0C, $0C, $0C, $0C, $0C, $CC, $CC, $CC, $CC, $78, $78, $00, $00
db $E6, $E6, $66, $66, $6C, $6C, $78, $78, $6C, $6C, $66, $66, $E6, $E6, $00, $00
db $F0, $F0, $60, $60, $60, $60, $60, $60, $62, $62, $66, $66, $FE, $FE, $00, $00
db $C6, $C6, $EE, $EE, $FE, $FE, $FE, $FE, $D6, $D6, $C6, $C6, $C6, $C6, $00, $00
db $C6, $C6, $E6, $E6, $F6, $F6, $DE, $DE, $CE, $CE, $C6, $C6, $C6, $C6, $00, $00
db $38, $38, $6C, $6C, $C6, $C6, $C6, $C6, $C6, $C6, $6C, $6C, $38, $38, $00, $00
db $FC, $FC, $66, $66, $66, $66, $7C, $7C, $60, $60, $60, $60, $F0, $F0, $00, $00
db $78, $78, $CC, $CC, $CC, $CC, $CC, $CC, $DC, $DC, $78, $78, $1C, $1C, $00, $00
db $FC, $FC, $66, $66, $66, $66, $7C, $7C, $6C, $6C, $66, $66, $E6, $E6, $00, $00
db $78, $78, $CC, $CC, $E0, $E0, $70, $70, $1C, $1C, $CC, $CC, $78, $78, $00, $00
db $FC, $FC, $B4, $B4, $30, $30, $30, $30, $30, $30, $30, $30, $78, $78, $00, $00
db $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $FC, $FC, $00, $00
db $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $78, $78, $30, $30, $00, $00
db $C6, $C6, $C6, $C6, $C6, $C6, $D6, $D6, $FE, $FE, $EE, $EE, $C6, $C6, $00, $00
db $C6, $C6, $C6, $C6, $6C, $6C, $38, $38, $38, $38, $6C, $6C, $C6, $C6, $00, $00
db $CC, $CC, $CC, $CC, $CC, $CC, $78, $78, $30, $30, $30, $30, $78, $78, $00, $00
db $FE, $FE, $C6, $C6, $8C, $8C, $18, $18, $32, $32, $66, $66, $FE, $FE, $00, $00
db $78, $78, $60, $60, $60, $60, $60, $60, $60, $60, $60, $60, $78, $78, $00, $00
db $C0, $C0, $60, $60, $30, $30, $18, $18, $0C, $0C, $06, $06, $02, $02, $00, $00
db $78, $78, $18, $18, $18, $18, $18, $18, $18, $18, $18, $18, $78, $78, $00, $00
db $10, $10, $38, $38, $6C, $6C, $C6, $C6, $00, $00, $00, $00, $00, $00, $00, $00
db $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $FF, $FF
db $30, $30, $30, $30, $18, $18, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
db $00, $00, $00, $00, $78, $78, $0C, $0C, $7C, $7C, $CC, $CC, $76, $76, $00, $00
db $E0, $E0, $60, $60, $60, $60, $7C, $7C, $66, $66, $66, $66, $DC, $DC, $00, $00
db $00, $00, $00, $00, $78, $78, $CC, $CC, $C0, $C0, $CC, $CC, $78, $78, $00, $00
db $1C, $1C, $0C, $0C, $0C, $0C, $7C, $7C, $CC, $CC, $CC, $CC, $76, $76, $00, $00
db $00, $00, $00, $00, $78, $78, $CC, $CC, $FC, $FC, $C0, $C0, $78, $78, $00, $00
db $38, $38, $6C, $6C, $60, $60, $F0, $F0, $60, $60, $60, $60, $F0, $F0, $00, $00
db $00, $00, $00, $00, $76, $76, $CC, $CC, $CC, $CC, $7C, $7C, $0C, $0C, $F8, $F8
db $E0, $E0, $60, $60, $6C, $6C, $76, $76, $66, $66, $66, $66, $E6, $E6, $00, $00
db $30, $30, $00, $00, $70, $70, $30, $30, $30, $30, $30, $30, $78, $78, $00, $00
db $0C, $0C, $00, $00, $0C, $0C, $0C, $0C, $0C, $0C, $CC, $CC, $CC, $CC, $78, $78
db $E0, $E0, $60, $60, $66, $66, $6C, $6C, $78, $78, $6C, $6C, $E6, $E6, $00, $00
db $70, $70, $30, $30, $30, $30, $30, $30, $30, $30, $30, $30, $78, $78, $00, $00
db $00, $00, $00, $00, $CC, $CC, $FE, $FE, $FE, $FE, $D6, $D6, $C6, $C6, $00, $00
db $00, $00, $00, $00, $F8, $F8, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $00, $00
db $00, $00, $00, $00, $78, $78, $CC, $CC, $CC, $CC, $CC, $CC, $78, $78, $00, $00
db $00, $00, $00, $00, $DC, $DC, $66, $66, $66, $66, $7C, $7C, $60, $60, $F0, $F0
db $00, $00, $00, $00, $76, $76, $CC, $CC, $CC, $CC, $7C, $7C, $0C, $0C, $1E, $1E
db $00, $00, $00, $00, $DC, $DC, $76, $76, $66, $66, $60, $60, $F0, $F0, $00, $00
db $00, $00, $00, $00, $7C, $7C, $C0, $C0, $78, $78, $0C, $0C, $F8, $F8, $00, $00
db $10, $10, $30, $30, $7C, $7C, $30, $30, $30, $30, $34, $34, $18, $18, $00, $00
db $00, $00, $00, $00, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $CC, $76, $76, $00, $00
db $00, $00, $00, $00, $CC, $CC, $CC, $CC, $CC, $CC, $78, $78, $30, $30, $00, $00
db $00, $00, $00, $00, $C6, $C6, $D6, $D6, $FE, $FE, $FE, $FE, $6C, $6C, $00, $00
db $00, $00, $00, $00, $C6, $C6, $6C, $6C, $38, $38, $6C, $6C, $C6, $C6, $00, $00
db $00, $00, $00, $00, $CC, $CC, $CC, $CC, $CC, $CC, $7C, $7C, $0C, $0C, $F8, $F8
db $00, $00, $00, $00, $FC, $FC, $98, $98, $30, $30, $64, $64, $FC, $FC, $00, $00
db $1C, $1C, $30, $30, $30, $30, $E0, $E0, $30, $30, $30, $30, $1C, $1C, $00, $00
db $18, $18, $18, $18, $18, $18, $00, $00, $18, $18, $18, $18, $18, $18, $00, $00
db $E0, $E0, $30, $30, $30, $30, $1C, $1C, $30, $30, $30, $30, $E0, $E0, $00, $00
db $76, $76, $DC, $DC, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
db $00, $00, $10, $10, $38, $38, $6C, $6C, $C6, $C6, $C6, $C6, $FE, $FE, $00, $00
.end::
SECTION "BASIC_CODE", ROMX
_1_helloworld:
dw 10
db "PRINT \"HELLO WORLD\"", $0D
dw 20
db "GOTO 10", $0D
_2_mario_theme:
dw 10
db "V.7:B=0:C=0", $0D
dw 20
db "IFB>0G.50", $0D
dw 30
db "READA,B:IFA=$FFFF G.100", $0D
dw 40
db "IFA=0S.2,0,0,0:G.50", $0D
dw 45
db "S.2,15,A,1", $0D
dw 50
db "IFC>0G.90", $0D
dw 60
db "READA,C:IFA=$FFFF G.100", $0D
dw 70
db "IFA=0S.1,0,0,0:G.90", $0D
dw 85
db "S.1,15,A,1", $0D
dw 90
db "B=B-1:C=C-1:W.1:G.20", $0D
dw 100
db "S.1,0,0,0:S.2,0,0,0:V.0:END", $0D
dw 200
db "DATA1849,3,$483,$3,1849,3,$483,$3,0,3,$0,$3,1849,3,$483,$3,0,3,$0,$3", $0D
dw 205
db "DATA1798,3,$483,$3,1849,6,$483,$6", $0D
dw 210
db "DATA1881,6,$563,$6,0,6,$0,$6,1714,6,$2C7,$6,0,6,$0,$6", $0D
dw 220
db "DATA1798,6,$563,$6,0,3,$0,$3,1714,6,$4E5,$6,0,3,$0,$3,1650,6,$416,$6", $0D
dw 230
db "DATA0,3,$0,$3,1750,6,$511,$6,1783,6,$563,$6,1767,3,$53B,$3,1750,6", $0D
dw 235
db "DATA$511,$6", $0D
dw 240
db "DATA1714,4,$4E5,$4,1849,4,$60B,$4,1881,4,$672,$4,1899,6,$689,$6", $0D
dw 245
db "DATA1860,3,$642,$3,1881,3,$672,$3", $0D
dw 250
db "DATA0,3,$0,$3,1849,6,$60B,$6,1798,3,$5AC,$3,1825,3,$5ED,$3,1783,6", $0D
dw 255
db "DATA$563,$6,0,3,$0,$3", $0D
dw 300
db "DATA0,6,$416,$6,1881,3,$0,$3,1871,3,$563,$3,1860,3,$0,$6,1837,6", $0D
dw 305
db "DATA$60B,$6,1849,3", $0D
dw 310
db "DATA0,3,$511,$6,1732,3,1750,3,$0,$3,1798,3,$60B,$3,0,3,$60B,$6", $0D
dw 315
db "DATA1750,3,1798,3,$511,$6,1825,3", $0D
dw 320
db "DATA0,6,$416,$6,1881,3,$0,$3,1871,3,$563,$3,1860,3,$0,$6,1837,6", $0D
dw 325
db "DATA$563,$3,1849,3,$60B,$3", $0D
dw 330
db "DATA0,3,$0,$3,1923,6,$6B2,$6,1923,3,$6B2,$3,1923,6,$6B2,$6,0,6", $0D
dw 335
db "DATA$563,$6", $0D
dw 340
db "DATA0,6,$416,$6,1881,3,$0,$3,1871,3,$563,$3,1860,3,$0,$6,1837,6", $0D
dw 345
db "DATA$60B,$6,1849,3", $0D
dw 350
db "DATA0,3,$511,$6,1732,3,1750,3,$0,$3,1798,3,$60B,$3,0,3,$60B,$6", $0D
dw 355
db "DATA1750,3,1798,3,$511,$6,1825,3", $0D
dw 360
db "DATA0,6,$416,$6,1837,6,$589,$6,0,3,$0,$3,1825,6,$5CE,$6,0,3,$0,$3", $0D
dw 370
db "DATA1798,6,$60B,$6,0,18,$0,$3,$563,$3,$563,$6,$416,$6", $0D
dw 460
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 465
db "DATA1825,6,$589,$6", $0D
dw 470
db "DATA1849,3,$563,$6,1798,3,0,3,$0,$3,1750,3,$416,$3,1714,12,$0,$6", $0D
dw 475
db "DATA$2C7,$6", $0D
dw 480
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 485
db "DATA1825,3,$589,$6,1849,3", $0D
dw 490
db "DATA0,24,$563,$6,$0,$3,$416,$3,$0,$6,$2C7,$6", $0D
dw 500
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 505
db "DATA1825,6,$589,$6", $0D
dw 510
db "DATA1849,3,$563,$6,1798,3,0,3,$0,$3,1750,3,$416,$3,1714,12,$0,$6", $0D
dw 515
db "DATA$2C7,$6", $0D
dw 520
db "DATA1849,3,$483,$3,1849,3,$483,$3,0,3,$0,$3,1849,3,$483,$3,0,3,$0,$3", $0D
dw 525
db "DATA1798,3,$483,$3,1849,6,$483,$6", $0D
dw 530
db "DATA1881,6,$563,$6,0,6,$0,$6,1714,6,$2C7,$6,0,6,$0,$6", $0D
dw 540
db "DATA1798,6,$563,$6,0,3,$0,$3,1714,6,$4E5,$6,0,3,$0,$3,1650,6,$416,$6", $0D
dw 550
db "DATA0,3,$0,$3,1750,6,$511,$6,1783,6,$563,$6,1767,3,$53B,$3,1750,6", $0D
dw 555
db "DATA$511,$6", $0D
dw 560
db "DATA1714,4,$4E5,$4,1849,4,$60B,$4,1881,4,$672,$4,1899,6,$689,$6", $0D
dw 565
db "DATA1860,3,$642,$3,1881,3,$672,$3", $0D
dw 570
db "DATA0,3,$0,$3,1849,6,$60B,$6,1798,3,$5AC,$3,1825,3,$5ED,$3,1783,6", $0D
dw 575
db "DATA$563,$6,0,3,$0,$3", $0D
dw 620
db "DATA1849,3,$416,$6,1798,6,$0,$3,1714,3,$53B,$3,0,6,$563,$6,1732,6", $0D
dw 625
db "DATA$60B,$6", $0D
dw 630
db "DATA1750,3,$511,$6,1860,6,$511,$6,1860,3,1750,6,$60B,$3,$60B,$3,0,6", $0D
dw 635
db "DATA$511,$6", $0D
dw 640
db "DATA1783,4,$483,$6,1899,4,$0,$3,1899,4,$511,$3,1899,4,$563,$6,1881,4", $0D
dw 645
db "DATA$5ED,$6,1860,4", $0D
dw 650
db "DATA1849,3,$511,$6,1798,6,$511,$6,1750,3,1714,6,$60B,$3,$60B,$3,0,6", $0D
dw 655
db "DATA$511,$6", $0D
dw 660
db "DATA1849,3,$416,$6,1798,6,$0,$3,1714,3,$53B,$3,0,6,$563,$6,1732,6", $0D
dw 665
db "DATA$60B,$6", $0D
dw 670
db "DATA1750,3,$511,$6,1860,6,$511,$6,1860,3,1750,6,$60B,$3,$60B,$3,0,6", $0D
dw 675
db "DATA$511,$6", $0D
dw 680
db "DATA1783,3,$563,$3,1860,6,$563,$6,1860,3,$563,$3,1860,4,$563,$4", $0D
dw 685
db "DATA1849,4,$5AC,$4,1825,4,$5ED,$4", $0D
dw 690
db "DATA1714,3,$60B,$6,1650,6,$563,$6,1650,3,1547,6,$416,$6,0,6,$0,$6", $0D
dw 780
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 785
db "DATA1825,6,$589,$6", $0D
dw 790
db "DATA1849,3,$563,$6,1798,3,0,3,$0,$3,1750,3,$416,$3,1714,12,$0,$6", $0D
dw 795
db "DATA$2C7,$6", $0D
dw 800
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 805
db "DATA1825,3,$589,$6,1849,3", $0D
dw 810
db "DATA0,6,$563,$6,1849,3,$0,$3,1881,3,$416,$3,1949,3,$0,$6,1923,3", $0D
dw 815
db "DATA1936,3,$2C7,$6,1964,3", $0D
dw 820
db "DATA1798,3,$312,$6,1798,3,0,3,$0,$3,1798,3,$4B5,$3,0,3,$0,$6,1798,3", $0D
dw 825
db "DATA1825,6,$589,$6", $0D
dw 830
db "DATA1849,3,$563,$6,1798,3,0,3,$0,$3,1750,3,$416,$3,1714,12,$0,$6", $0D
dw 835
db "DATA$2C7,$6", $0D
dw 840
db "DATA1849,3,$483,$3,1849,3,$483,$3,0,3,$0,$3,1849,3,$483,$3,0,3,$0,$3", $0D
dw 845
db "DATA1798,3,$483,$3,1849,6,$483,$6", $0D
dw 850
db "DATA1881,6,$563,$6,0,6,$0,$6,1714,6,$2C7,$6,0,6,$0,$6", $0D
dw 860
db "DATA1849,3,$416,$6,1798,6,$0,$3,1714,3,$53B,$3,0,6,$563,$6,1732,6", $0D
dw 865
db "DATA$60B,$6", $0D
dw 870
db "DATA1750,3,$511,$6,1860,6,$511,$6,1860,3,1750,6,$60B,$3,$60B,$3,0,6", $0D
dw 875
db "DATA$511,$6", $0D
dw 880
db "DATA1783,4,$483,$6,1899,4,$0,$3,1899,4,$511,$3,1899,4,$563,$6,1881,4", $0D
dw 885
db "DATA$5ED,$6,1860,4", $0D
dw 890
db "DATA1849,3,$511,$6,1798,6,$511,$6,1750,3,1714,6,$60B,$3,$60B,$3,0,6", $0D
dw 895
db "DATA$511,$6", $0D
dw 900
db "DATA1849,3,$416,$6,1798,6,$0,$3,1714,3,$53B,$3,0,6,$563,$6,1732,6", $0D
dw 905
db "DATA$60B,$6", $0D
dw 910
db "DATA1750,3,$511,$6,1860,6,$511,$6,1860,3,1750,6,$60B,$3,$60B,$3,0,6", $0D
dw 915
db "DATA$511,$6", $0D
dw 920
db "DATA1783,3,$563,$3,1860,6,$563,$6,1860,3,$563,$3,1860,4,$563,$4", $0D
dw 925
db "DATA1849,4,$5AC,$4,1825,4,$5ED,$4", $0D
dw 930
db "DATA1714,3,$60B,$6,1650,6,$563,$6,1650,3,1547,6,$416,$6,0,6,$0,$6", $0D
dw 1020
db "DATA1798,6,$563,$6,0,3,$0,$3,1714,6,$4E5,$6,0,3,$0,$3,1650,6", $0D
dw 1025
db "DATA$416,$6", $0D
dw 1030
db "DATA1750,4,$511,$C,1783,4,1750,4,1732,4,$44E,$C,1767,4,1732,4", $0D
dw 1040
db "DATA1650,3,$416,$18,1602,3,1650,18", $0D
dw 10000
db "DATA $FFFF,0", $0D
_3_sokoban:
dw 10
db "CLS", $0D
dw 20
db "W=20:I=0:D=0", $0D
dw 30
db "READ V:@(I)=V", $0D
dw 40
db "IF V=255 GOTO 150", $0D
dw 50
db "IF V=0 PRINT \" \",", $0D
dw 60
db "IF V=1 PRINT \"#\",", $0D
dw 70
db "IF V=2 PRINT \".\",:D=D+1", $0D
dw 80
db "IF V=3 PRINT \"$\",", $0D
dw 90
db "IF V=4 Y=I/W:X=I-Y*W:PRINT \"@\",", $0D
dw 100
db "I=I+1:GOTO 30", $0D
dw 150
db "IF D=0 PRINT \{0,15\},\" YOU WIN!\",:END", $0D
dw 155
db "WAIT 3", $0D
dw 160
db "A=PAD", $0D
dw 170
db "P=X:Q=Y", $0D
dw 180
db "IF A=16 T=X+1:U=Y:N=X+2:M=Y:GOTO 230", $0D
dw 190
db "IF A=32 T=X-1:U=Y:N=X-2:M=Y:GOTO 230", $0D
dw 200
db "IF A=64 T=X:U=Y-1:N=X:M=Y-2:GOTO 230", $0D
dw 210
db "IF A=128 T=X:U=Y+1:N=X:M=Y+2:GOTO 230", $0D
dw 220
db "GOTO 150", $0D
dw 230
db "O=U*W+T:Z=@(O)", $0D
dw 240
db "IF Z=0 GOTO 500", $0D
dw 250
db "IF Z=2 GOTO 500", $0D
dw 260
db "IF Z=3 GOTO 600", $0D
dw 270
db "IF Z=5 GOTO 600", $0D
dw 280
db "GOTO 150", $0D
dw 500
db "O=Q*W+P:V=@(O)", $0D
dw 510
db "IF V=4 PRINT \{P,Q\},\" \",:@(O)=0", $0D
dw 520
db "IF V=5 PRINT \{P,Q\},\".\",:@(O)=2", $0D
dw 530
db "X=T:Y=U:PRINT \{X,Y\},\"@\",", $0D
dw 540
db "O=Y*W+X:IF Z=0 @(O)=4", $0D
dw 550
db "IF Z=2 @(O)=5", $0D
dw 560
db "GOTO 150", $0D
dw 600
db "O=M*W+N:K=@(O)", $0D
dw 650
db "IF K=0 GOTO 700", $0D
dw 660
db "IF K=2 GOTO 700", $0D
dw 670
db "GOTO 150", $0D
dw 700
db "O=Q*W+P:V=@(O)", $0D
dw 710
db "IF V=4 PRINT \{P,Q\},\" \",:@(O)=0", $0D
dw 720
db "IF V=5 PRINT \{P,Q\},\".\",:@(O)=2", $0D
dw 725
db "IF V=0 PRINT \{P,Q\},\" \",:@(O)=0", $0D
dw 726
db "IF V=2 PRINT \{P,Q\},\".\",:@(O)=2", $0D
dw 730
db "X=T:Y=U:PRINT \{X,Y\},\"@\",", $0D
dw 740
db "O=Y*W+X:IF Z=3 @(O)=4", $0D
dw 750
db "IF Z=5 @(O)=5:D=D+1", $0D
dw 760
db "O=M*W+N:IF K=0 PRINT \{N,M\},\"$\",:@(O)=3", $0D
dw 770
db "IF K=2 PRINT \{N,M\},\"*\",:@(O)=5:D=D-1", $0D
dw 780
db "GOTO 150", $0D
dw 1000
db "DATA 0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0", $0D
dw 1010
db "DATA 0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0", $0D
dw 1020
db "DATA 0,0,0,0,1,3,0,0,1,0,0,0,0,0,0,0,0,0,0,0", $0D
dw 1030
db "DATA 0,0,1,1,1,0,0,3,1,1,0,0,0,0,0,0,0,0,0,0", $0D
dw 1040
db "DATA 0,0,1,0,0,3,0,3,0,1,0,0,0,0,0,0,0,0,0,0", $0D
dw 1050
db "DATA 1,1,1,0,1,0,1,1,0,1,0,0,0,1,1,1,1,1,1,0", $0D
dw 1060
db "DATA 1,0,0,0,1,0,1,1,0,1,1,1,1,1,0,0,2,2,1,0", $0D
dw 1070
db "DATA 1,0,3,0,0,3,0,0,0,0,0,0,0,0,0,0,2,2,1,0", $0D
dw 1080
db "DATA 1,1,1,1,1,0,1,1,1,0,1,4,1,1,0,0,2,2,1,0", $0D
dw 1090
db "DATA 0,0,0,0,1,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0", $0D
dw 1100
db "DATA 0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,255", $0D
_4_batnum:
dw 10
db "PRINT \"BATNUM\"", $0D
dw 20
db "PRINT \"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY\"", $0D
dw 30
db "PRINT", $0D
dw 110
db "PRINT \"THIS PROGRAM IS A 'BATTLE OF NUMBERS' GAME, WHERE THE\"", $0D
dw 120
db "PRINT \"COMPUTER IS YOUR OPPONENT.\"", $0D
dw 130
db "PRINT", $0D
dw 140
db "PRINT \"THE GAME STARTS WITH AN ASSUMED PILE OF OBJECTS. YOU\"", $0D
dw 150
db "PRINT \"AND YOUR OPPONENT ALTERNATELY REMOVE OBJECTS FROM THE PILE.\"", $0D
dw 160
db "PRINT \"WINNING IS DEFINED IN ADVANCE AS TAKING THE LAST OBJECT OR\"", $0D
dw 170
db "PRINT \"NOT. YOU CAN ALSO SPECIFY SOME OTHER BEGINNING CONDITIONS.\"", $0D
dw 180
db "PRINT \"DON'T USE ZERO, HOWEVER, IN PLAYING THE GAME.\"", $0D
dw 190
db "PRINT \"ENTER A NEGATIVE NUMBER FOR NEW PILE SIZE TO STOP PLAYING.\"", $0D
dw 200
db "PRINT", $0D
dw 210
db "GOTO 330", $0D
dw 220
db "FOR I=1 TO 10", $0D
dw 230
db "PRINT", $0D
dw 240
db "NEXT I", $0D
dw 330
db "INPUT \"ENTER PILE SIZE\"N", $0D
dw 340
db "IF N<0 GOTO 1080", $0D
dw 350
db "IF N>=1 GOTO 390", $0D
dw 360
db "GOTO 330", $0D
dw 390
db "INPUT \"ENTER WIN OPTION - 1 TO TAKE LAST, 2 TO AVOID LAST\"M", $0D
dw 410
db "IF M=1 GOTO 430", $0D
dw 420
db "IF M<>2 GOTO 390", $0D
dw 430
db "INPUT \"ENTER MIN PER TURN\"A,\"AND MAX\"B", $0D
dw 450
db "IF A>B GOTO 430", $0D
dw 460
db "IF A<1 GOTO 430", $0D
dw 490
db "INPUT \"ENTER START OPTION - 1 COMPUTER FIRST, 2 YOU FIRST\"S", $0D
dw 500
db "PRINT", $0D
dw 510
db "IF S=1 GOTO 530", $0D
dw 520
db "IF S<>2 GOTO 490", $0D
dw 530
db "C=A+B", $0D
dw 540
db "IF S=2 GOTO 570", $0D
dw 550
db "GOSUB 600", $0D
dw 560
db "IF W=1 GOTO 220", $0D
dw 570
db "GOSUB 810", $0D
dw 580
db "IF W=1 GOTO 220", $0D
dw 590
db "GOTO 550", $0D
dw 600
db "Q=N", $0D
dw 610
db "IF M=1 GOTO 630", $0D
dw 620
db "Q=Q-1", $0D
dw 630
db "IF M=1 GOTO 680", $0D
dw 640
db "IF N>A GOTO 720", $0D
dw 650
db "W=1", $0D
dw 660
db "PRINT \"COMPUTER TAKES\",N,\" AND LOSES.\"", $0D
dw 670
db "RETURN", $0D
dw 680
db "IF N>B GOTO 720", $0D
dw 690
db "W=1", $0D
dw 700
db "PRINT \"COMPUTER TAKES\",N,\" AND WINS.\"", $0D
dw 710
db "RETURN", $0D
dw 720
db "P=Q-C*(Q/C)", $0D
dw 730
db "IF P>=A GOTO 750", $0D
dw 740
db "P=A", $0D
dw 750
db "IF P<=B GOTO 770", $0D
dw 760
db "P=B", $0D
dw 770
db "N=N-P", $0D
dw 780
db "PRINT \"COMPUTER TAKES\",P,\" AND LEAVES\",N", $0D
dw 790
db "W=0", $0D
dw 800
db "RETURN", $0D
dw 810
db "PRINT", $0D
dw 820
db "INPUT \"YOUR MOVE\"P", $0D
dw 830
db "IF P<>0 GOTO 880", $0D
dw 840
db "PRINT \"I TOLD YOU NOT TO USE ZERO! COMPUTER WINS BY FORFEIT.\"", $0D
dw 850
db "W=1", $0D
dw 860
db "RETURN", $0D
dw 880
db "IF P>=A GOTO 910", $0D
dw 890
db "IF P=N GOTO 960", $0D
dw 900
db "GOTO 920", $0D
dw 910
db "IF P<=B GOTO 940", $0D
dw 920
db "PRINT \"ILLEGAL MOVE, REENTER IT!\"", $0D
dw 930
db "GOTO 820", $0D
dw 940
db "N=N-P", $0D
dw 950
db "IF N<>0 GOTO 1030", $0D
dw 960
db "IF M=1 GOTO 1000", $0D
dw 970
db "PRINT \"TOUGH LUCK, YOU LOSE.\"", $0D
dw 980
db "W=1", $0D
dw 990
db "RETURN", $0D
dw 1000
db "PRINT \"CONGRATULATIONS, YOU WIN.\"", $0D
dw 1010
db "W=1", $0D
dw 1020
db "RETURN", $0D
dw 1030
db "IF N>=0 GOTO 1060", $0D
dw 1040
db "N=N+P", $0D
dw 1050
db "GOTO 920", $0D
dw 1060
db "W=0", $0D
dw 1070
db "RETURN", $0D
dw 1080
db "END", $0D
_5_reverse:
dw 10
db "PRINT \"REVERSE\"", $0D
dw 30
db "PRINT \"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY\"", $0D
dw 100
db "PRINT \"REVERSE -- A GAME OF SKILL\"", $0D
dw 140
db "REM *** N=NUMBER OF NUMBERS", $0D
dw 150
db "N=9", $0D
dw 160
db "INPUT \"DO YOU WANT THE RULES (0=NO,1=YES)\"A", $0D
dw 180
db "IF A=0 GOTO 210", $0D
dw 190
db "GOSUB 710", $0D
dw 200
db "REM *** MAKE A RANDOM LIST @(1) TO @(N)", $0D
dw 210
db "@(1)=RND(N-1)+1", $0D
dw 220
db "FOR K=2 TO N", $0D
dw 230
db "@(K)=RND(N)", $0D
dw 240
db "FOR J=1 TO K-1", $0D
dw 250
db "IF @(K)=@(J) GOTO 230", $0D
dw 260
db "NEXT J", $0D
dw 270
db "NEXT K", $0D
dw 280
db "REM *** PRINT ORIGINAL LIST AND START GAME", $0D
dw 290
db "PRINT", $0D
dw 300
db "PRINT \"HERE WE GO ... THE LIST IS:\"", $0D
dw 310
db "T=0", $0D
dw 320
db "GOSUB 610", $0D
dw 330
db "INPUT \"HOW MANY SHALL I REVERSE\"R", $0D
dw 350
db "IF R=0 GOTO 520", $0D
dw 360
db "IF R<=N GOTO 390", $0D
dw 370
db "PRINT \"OOPS! TOO MANY! I CAN REVERSE AT MOST \",#2,N", $0D
dw 380
db "GOTO 330", $0D
dw 390
db "T=T+1", $0D
dw 400
db "REM *** REVERSE R NUMBERS AND PRINT NEW LIST", $0D
dw 410
db "FOR K=1 TO R/2", $0D
dw 420
db "Z=@(K)", $0D
dw 430
db "@(K)=@(R-K+1)", $0D
dw 440
db "@(R-K+1)=Z", $0D
dw 450
db "NEXT K", $0D
dw 460
db "GOSUB 610", $0D
dw 470
db "REM *** CHECK FOR A WIN", $0D
dw 480
db "FOR K=1 TO N", $0D
dw 490
db "IF @(K)<>K GOTO 330", $0D
dw 500
db "NEXT K", $0D
dw 510
db "PRINT \"YOU WON IT IN\",T,\" MOVES!!!\"", $0D
dw 520
db "PRINT", $0D
dw 530
db "INPUT \"TRY AGAIN (1=YES, 0=NO)\"A", $0D
dw 550
db "IF A=1 GOTO 210", $0D
dw 560
db "PRINT", $0D
dw 565
db "PRINT \"O.K. HOPE YOU HAD FUN!!\"", $0D
dw 570
db "GOTO 999", $0D
dw 600
db "REM *** SUBROUTINE TO PRINT LIST", $0D
dw 610
db "PRINT", $0D
dw 620
db "FOR K=1 TO N", $0D
dw 630
db "PRINT #2,@(K),", $0D
dw 640
db "NEXT K", $0D
dw 650
db "PRINT", $0D
dw 660
db "RETURN", $0D
dw 700
db "REM *** SUBROUTINE TO PRINT THE RULES", $0D
dw 710
db "PRINT \"THIS IS THE GAME OF 'REVERSE'. TO WIN, ALL YOU HAVE\"", $0D
dw 720
db "PRINT \"TO DO IS ARRANGE A LIST OF NUMBERS (1 THROUGH \",#2,N,\")\"", $0D
dw 730
db "PRINT \"IN NUMERICAL ORDER FROM LEFT TO RIGHT. TO MOVE, YOU\"", $0D
dw 740
db "PRINT \"TELL ME HOW MANY NUMBERS (COUNTING FROM THE LEFT) TO\"", $0D
dw 750
db "PRINT \"REVERSE. FOR EXAMPLE, IF THE CURRENT LIST IS:\"", $0D
dw 755
db "PRINT", $0D
dw 760
db "PRINT \" 2 3 4 5 1 6 7 8 9\"", $0D
dw 765
db "PRINT", $0D
dw 770
db "PRINT \"AND YOU REVERSE 4, THE RESULT WILL BE:\"", $0D
dw 775
db "PRINT", $0D
dw 780
db "PRINT \" 5 4 3 2 1 6 7 8 9\"", $0D
dw 785
db "PRINT", $0D
dw 790
db "PRINT \"NOW IF YOU REVERSE 5, YOU WIN!\"", $0D
dw 795
db "PRINT", $0D
dw 800
db "PRINT \" 1 2 3 4 5 6 7 8 9\"", $0D
dw 805
db "PRINT", $0D
dw 810
db "PRINT \"NO DOUBT YOU WILL LIKE THIS GAME, BUT\"", $0D
dw 820
db "PRINT \"IF YOU WANT TO QUIT, REVERSE 0 (ZERO).\"", $0D
dw 830
db "PRINT", $0D
dw 840
db "RETURN", $0D
dw 999
db "END", $0D
_6_tictac:
dw 2
db "PRINT \"TIC-TAC-TOE\"", $0D
dw 4
db "PRINT \"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY\"", $0D
dw 6
db "PRINT", $0D
dw 8
db "PRINT \"THE BOARD IS NUMBERED:\"", $0D
dw 10
db "PRINT \" 1 2 3\"", $0D
dw 12
db "PRINT \" 4 5 6\"", $0D
dw 14
db "PRINT \" 7 8 9\"", $0D
dw 16
db "PRINT", $0D
dw 20
db "FOR I=1 TO 9:@(I)=0:NEXT I", $0D
dw 50
db "INPUT\"DO YOU WANT 'X' OR 'O' (X=1,O=0)\"C", $0D
dw 55
db "IF C=1 GOTO 475", $0D
dw 60
db "P=0,Q=1", $0D
dw 100
db "G=-1,H=1:IF @(5)<>0 GOTO 103", $0D
dw 102
db "@(5)=-1:GOTO 195", $0D
dw 103
db "IF @(5)<>1 GOTO 106", $0D
dw 104
db "IF @(1)<>0 GOTO 110", $0D
dw 105
db "@(1)=-1:GOTO 195", $0D
dw 106
db "IF (@(2)=1)*(@(1)=0) GOTO 181", $0D
dw 107
db "IF (@(4)=1)*(@(1)=0) GOTO 181", $0D
dw 108
db "IF (@(6)=1)*(@(9)=0) GOTO 189", $0D
dw 109
db "IF (@(8)=1)*(@(9)=0) GOTO 189", $0D
dw 110
db "IF G=1 GOTO 112", $0D
dw 111
db "GOTO 118", $0D
dw 112
db "J=3*(M-1)/3+1", $0D
dw 113
db "IF J=M LET K=1", $0D
dw 114
db "IF J+1=M LET K=2", $0D
dw 115
db "IF J+2=M LET K=3", $0D
dw 116
db "GOTO 120", $0D
dw 118
db "FOR J=1 TO 7 STEP 3:FOR K=1 TO 3", $0D
dw 120
db "IF @(J)<>G GOTO 130", $0D
dw 122
db "IF @(J+2)<>G GOTO 135", $0D
dw 126
db "IF @(J+1)<>0 GOTO 150", $0D
dw 128
db "@(J+1)=-1:GOTO 195", $0D
dw 130
db "IF @(J)=H GOTO 150", $0D
dw 131
db "IF @(J+2)<>G GOTO 150", $0D
dw 132
db "IF @(J+1)<>G GOTO 150", $0D
dw 133
db "@(J)=-1:GOTO 195", $0D
dw 135
db "IF @(J+2)<>0 GOTO 150", $0D
dw 136
db "IF @(J+1)<>G GOTO 150", $0D
dw 138
db "@(J+2)=-1:GOTO 195", $0D
dw 150
db "IF @(K)<>G GOTO 160", $0D
dw 152
db "IF @(K+6)<>G GOTO 165", $0D
dw 156
db "IF @(K+3)<>0 GOTO 170", $0D
dw 158
db "@(K+3)=-1:GOTO 195", $0D
dw 160
db "IF @(K)=H GOTO 170", $0D
dw 161
db "IF @(K+6)<>G GOTO 170", $0D
dw 162
db "IF @(K+3)<>G GOTO 170", $0D
dw 163
db "@(K)=-1:GOTO 195", $0D
dw 165
db "IF @(K+6)<>0 GOTO 170", $0D
dw 166
db "IF @(K+3)<>G GOTO 170", $0D
dw 168
db "@(K+6)=-1:GOTO 195", $0D
dw 170
db "GOTO 450", $0D
dw 171
db "IF (@(3)=G)*(@(7)=0) GOTO 187", $0D
dw 172
db "IF (@(9)=G)*(@(1)=0) GOTO 181", $0D
dw 173
db "IF (@(7)=G)*(@(3)=0) GOTO 183", $0D
dw 174
db "IF (@(9)=0)*(@(1)=G) GOTO 189", $0D
dw 175
db "IF G=-1 LET G=1,H=-1:GOTO 110", $0D
dw 176
db "IF (@(9)=1)*(@(3)=0) GOTO 182", $0D
dw 177
db "FOR I=2 TO 9:IF @(I)<>0 GOTO 179", $0D
dw 178
db "@(I)=-1:GOTO 195", $0D
dw 179
db "NEXT I", $0D
dw 181
db "@(1)=-1:GOTO 195", $0D
dw 182
db "IF @(1)=1 GOTO 177", $0D
dw 183
db "@(3)=-1:GOTO 195", $0D
dw 187
db "@(7)=-1:GOTO 195", $0D
dw 189
db "@(9)=-1", $0D
dw 195
db "PRINT\"THE COMPUTER MOVES TO...\"", $0D
dw 202
db "GOSUB 1000", $0D
dw 205
db "GOTO 500", $0D
dw 450
db "IF G=1 GOTO 465", $0D
dw 455
db "IF (J=7)*(K=3) GOTO 465", $0D
dw 460
db "NEXT K:NEXT J", $0D
dw 465
db "IF @(5)=G GOTO 171", $0D
dw 467
db "GOTO 175", $0D
dw 475
db "P=1,Q=0", $0D
dw 500
db "INPUT\"WHERE DO YOU MOVE\"M", $0D
dw 502
db "IF M=0 PRINT\"THANKS FOR THE GAME.\":GOTO 2000", $0D
dw 503
db "IF M>9 GOTO 506", $0D
dw 505
db "IF @(M)=0 GOTO 510", $0D
dw 506
db "PRINT\"THAT SQUARE IS OCCUPIED.\":GOTO 500", $0D
dw 510
db "G=1,@(M)=1", $0D
dw 520
db "GOSUB 1000", $0D
dw 530
db "GOTO 100", $0D
dw 1000
db "FOR I=1 TO 9:PRINT\" \",:IF @(I)<>-1 GOTO 1014", $0D
dw 1011
db "IF Q=1 PRINT \"X \",", $0D
dw 1012
db "IF Q=0 PRINT \"O \",", $0D
dw 1013
db "GOTO 1020", $0D
dw 1014
db "IF @(I)<>0 GOTO 1016", $0D
dw 1015
db "PRINT\" \",:GOTO 1020", $0D
dw 1016
db "IF P=1 PRINT \"X \",", $0D
dw 1017
db "IF P=0 PRINT \"O \",", $0D
dw 1020
db "IF (I<>3)*(I<>6) GOTO 1050", $0D
dw 1030
db "PRINT\"\":PRINT\"---+---+---\"", $0D
dw 1040
db "GOTO 1080", $0D
dw 1050
db "IF I=9 GOTO 1080", $0D
dw 1060
db "PRINT\"!\",", $0D
dw 1080
db "NEXT I:PRINT", $0D
dw 1095
db "FOR I=1 TO 7 STEP 3", $0D
dw 1100
db "IF @(I)<>@(I+1) GOTO 1115", $0D
dw 1105
db "IF @(I)<>@(I+2) GOTO 1115", $0D
dw 1110
db "IF @(I)=-1 GOTO 1350", $0D
dw 1112
db "IF @(I)=1 GOTO 1200", $0D
dw 1115
db "NEXT I:FOR I=1 TO 3:IF @(I)<>@(I+3) GOTO 1150", $0D
dw 1130
db "IF @(I)<>@(I+6) GOTO 1150", $0D
dw 1135
db "IF @(I)=-1 GOTO 1350", $0D
dw 1137
db "IF @(I)=1 GOTO 1200", $0D
dw 1150
db "NEXT I:FOR I=1 TO 9:IF @(I)=0 GOTO 1155", $0D
dw 1152
db "NEXT I:GOTO 1400", $0D
dw 1155
db "IF @(5)<>G GOTO 1170", $0D
dw 1160
db "IF (@(1)=G)*(@(9)=G) GOTO 1180", $0D
dw 1165
db "IF (@(3)=G)*(@(7)=G) GOTO 1180", $0D
dw 1170
db "RETURN", $0D
dw 1180
db "IF G=-1 GOTO 1350", $0D
dw 1200
db "PRINT\"YOU BEAT ME!! GOOD GAME.\":GOTO 2000", $0D
dw 1350
db "PRINT\"I WIN, TURKEY!!!\":GOTO 2000", $0D
dw 1400
db "PRINT\"IT'S A DRAW. THANK YOU.\"", $0D
dw 2000
db "END", $0D
_7_mario_underground:
dw 10
db "V.7:B=0:C=0", $0D
dw 20
db "IFB>0G.50", $0D
dw 30
db "READA,B:IFA=$FFFF G.100", $0D
dw 40
db "IFA=0S.1,0,0,0:G.50", $0D
dw 45
db "S.1,15,A,2", $0D
dw 50
db "IFC>0G.90", $0D
dw 60
db "READA,C:IFA=$FFFF G.100", $0D
dw 70
db "IFA=0S.2,0,0,0:G.90", $0D
dw 85
db "S.2,15,A,1", $0D
dw 90
db "B=B-1:C=C-1:W.1:G.20", $0D
dw 100
db "S.1,0,0,0:S.2,0,0,0:V.0:END", $0D
dw 200
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 205
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 210
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 215
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 220
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 225
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,18,$0,$12", $0D
dw 230
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 233
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,12,$0,$C,1627,2,$4B5,$2,1602,2", $0D
dw 236
db "DATA$483,$2,1575,2,$44E,$2", $0D
dw 240
db "DATA1547,6,$416,$6,1627,6,$4B5,$6,1602,6,$483,$6,1417,6,$312,$6", $0D
dw 245
db "DATA1379,6,$2C7,$6,1575,6,$44E,$6", $0D
dw 250
db "DATA1547,2,$416,$2,1694,2,$53B,$2,1673,2,$511,$2,1650,2,$4E5,$2", $0D
dw 253
db "DATA1767,2,$5CE,$2,1750,2,$5AC,$2,1732,4,$589,$4,1627,4,$4B5,$4", $0D
dw 256
db "DATA1517,4,$3DA,$4,1486,4,$39B,$4,1452,4,$358,$4,1417,4,$312,$4", $0D
dw 260
db "DATA0,36,$0,$24", $0D
dw 1200
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 1205
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 1210
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 1215
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 1220
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 1225
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,18,$0,$12", $0D
dw 1230
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 1233
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,12,$0,$C,1627,2,$4B5,$2,1602,2", $0D
dw 1236
db "DATA$483,$2,1575,2,$44E,$2", $0D
dw 1240
db "DATA1547,6,$416,$6,1627,6,$4B5,$6,1602,6,$483,$6,1417,6,$312,$6", $0D
dw 1245
db "DATA1379,6,$2C7,$6,1575,6,$44E,$6", $0D
dw 1250
db "DATA1547,2,$416,$2,1694,2,$53B,$2,1673,2,$511,$2,1650,2,$4E5,$2", $0D
dw 1253
db "DATA1767,2,$5CE,$2,1750,2,$5AC,$2,1732,4,$589,$4,1627,4,$4B5,$4", $0D
dw 1256
db "DATA1517,4,$3DA,$4,1486,4,$39B,$4,1452,4,$358,$4,1417,4,$312,$4", $0D
dw 1260
db "DATA0,36,$0,$24", $0D
dw 2200
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 2205
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 2210
db "DATA1547,3,$416,$3,1798,3,$60B,$3,1452,3,$358,$3,1750,3,$5AC,$3", $0D
dw 2215
db "DATA1486,3,$39B,$3,1767,3,$5CE,$3,0,18,$0,$12", $0D
dw 2220
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 2225
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,18,$0,$12", $0D
dw 2230
db "DATA1297,3,$223,$3,1673,3,$511,$3,1155,3,$107,$3,1602,3,$483,$3", $0D
dw 2233
db "DATA1205,3,$16B,$3,1627,3,$4B5,$3,0,12,$0,$C,1627,2,$4B5,$2,1602,2", $0D
dw 2236
db "DATA$483,$2,1575,2,$44E,$2", $0D
dw 2240
db "DATA1547,6,$416,$6,1627,6,$4B5,$6,1602,6,$483,$6,1417,6,$312,$6", $0D
dw 2245
db "DATA1379,6,$2C7,$6,1575,6,$44E,$6", $0D
dw 2250
db "DATA1547,2,$416,$2,1694,2,$53B,$2,1673,2,$511,$2,1650,2,$4E5,$2", $0D
dw 2253
db "DATA1767,2,$5CE,$2,1750,2,$5AC,$2,1732,4,$589,$4,1627,4,$4B5,$4", $0D
dw 2256
db "DATA1517,4,$3DA,$4,1486,4,$39B,$4,1452,4,$358,$4,1417,4,$312,$4", $0D
dw 2260
db "DATA0,36,$0,$24", $0D
dw 10000
db "DATA $FFFF,0", $0D
ALIGN 8
basic_code::
dw _1_helloworld
dw _2_mario_theme
dw _3_sokoban
dw _4_batnum
dw _5_reverse
dw _6_tictac
dw _7_mario_underground
dw basic_code
dw basic_code
dw basic_code
dw basic_code
if !def(DEFS_INC)
def DEFS_INC equ 1
INCLUDE "hardware.inc"
def SCREEN_ADDRESS_START equ $9C00
def SCREEN_ADDRESS_END equ (SCREEN_ADDRESS_START + $400)
def LCDC_BG_START equ LCDC_BG_9C00
def CURSOR_TILE equ $00
def ctrlc equ $03
def bs equ $08
def lf equ $0a
def cr equ $0d
def ctrlo equ $0f
def ctrlu equ $15
def cls equ $0c
def PLATFORM equs "\"GB\""
def VERSION equs "\"0.6\""
;hFlags
def FLAGS_VBLANK_OCCURRED equ %00000001
endc ; DEFS_INC
INCLUDE "macros.inc"
INCLUDE "defs.inc"
IF !DEF(TARGET_MEGADUCK)
SECTION "FILESYSTEM", ROM0
FEXT:
db ".TBA", 0
MAGIC:
db "GBTB"
BANKS_FREE:
db " BANKS FREE", 0
initfilesystem::
ld a, RAMG_SRAM_ENABLE
ld [rRAMG], a
ld a, 15
.test_loop
ld [rRAMB], a
inc a
ld [fake_sram_test], a
dec a
srl a
jr nz, .test_loop
ld [rRAMB], a
ld [fake_sram_test], a
ld a, 15
ld [rRAMB], a
ld a, [fake_sram_test]
cp 1
adc a, 0
ldh [hRealBanks], a
dec a
ld b, a
ld hl, filesystem
.loop_banks
ldh a, [hRealBanks]
sub b
ld [rRAMB], a
push hl
ld hl, fs_magic
ld de, MAGIC
ld c, 4 ; check magic
.checkmagic
ld a, [de]
inc de
sub [hl]
jr nz, .not_a_file
inc hl
dec c
jr nz, .checkmagic
.is_a_file:
ld e, l
ld d, h
pop hl
ld c, 15
.read_name_and_size:
ld a, [de]
inc de
ld [hl+], a
dec c
jr nz, .read_name_and_size
inc hl
jr .continue_loop_banks
.not_a_file:
pop hl
ld [hl], 0
ld a, l
add $10
ld l, a
.continue_loop_banks
dec b
jr nz, .loop_banks
xor a
ld [rRAMB], a
ret
dir::
ld de, filesystem
ldh a, [hRealBanks]
dec a
ld b, a ;b-banks counter, c-free banks counter
ld c, 0 ;b-banks counter, c-free banks counter
.loop_filesystem
ld a, [de]
or a
jr nz, .not_free
ld a, e
add $10
ld e, a
inc c
jr .continue_loop_filesystem
.not_free:
push bc
push de
xor a
call printstr
pop de
ld a, e
add $0d
ld e, a
ld a, [de]
ld l, a
inc e
ld a, [de]
ld h, a
inc e
inc e
push de
ld c, 6
call printnum
ld a, cr
call outc
pop de
pop bc
.continue_loop_filesystem
dec b
jr nz, .loop_filesystem
ld h, 0
ld l, c
ld c, 6
call printnum
xor a
ld de, BANKS_FREE
call printstr
jp rstart
; in a - first nimble is from bank second to bank
; size is in bc
copyfile::
ldh [hTempBanksCfg], a ;store setup
ld hl, fs_begin
ld a, c
ldh [hTempSizeC], a
or a
jr nz, .copy_c_start
ld a, b
or a
jr nz, .copy_b_start
ret
.copy_c_start:
ldh a, [hTempBanksCfg]
swap a
and $f
ld [rRAMB], a
ld de, copybuffer
.copy_c
ld a, [hl+]
ld [de], a
inc de
dec c
jr nz, .copy_c
ldh a, [hTempSizeC]
ld c, a
ld hl, fs_begin
ld de, copybuffer
ldh a, [hTempBanksCfg]
and $f
ld [rRAMB], a
.copy_c_back
ld a, [de]
ld [hl+], a
inc de
dec c
jr nz, .copy_c_back
ld a, b
or b
ret z
.copy_b_start:
push hl
ldh a, [hTempBanksCfg]
swap a
and $f
ld [rRAMB], a
;c == 0
ld de, copybuffer
.copy_256
ld a, [hl+]
ld [de], a
inc de
dec c
jr nz, .copy_256
;c == 0
ld de, copybuffer
ldh a, [hTempBanksCfg]
and $f
ld [rRAMB], a
pop hl
.copy_256_back
ld a, [de]
ld [hl+], a
inc de
dec c
jr nz, .copy_256_back
dec b
jr nz, .copy_b_start
ret
; returns bank number with file or $fx if not found where x is a first free bank if x 0 there is no free banks
; also put file size to filesize
findfile:
ld de, filesystem
ldh a, [hRealBanks]
ld c, $f0 ;b-banks counter, c-free bank number
dec a
ld b, a
or a
jr nz, .loop_filesystem
ld a, c
ret
.loop_filesystem
ld a, [de]
or a
jr nz, .not_free
ld a, e
add $10
ld e, a
ld a, c
cp $f0
jr nz, .continue_loop_filesystem
ldh a, [hRealBanks]
sub b
or $f0
ld c, a
jr .continue_loop_filesystem
.not_free:
push bc
ld b, 13
ld hl, filename
.compare_filename
ld a, [de]
cp [hl]
jr nz, .not_same_filename
inc hl
inc de
dec b
jr nz, .compare_filename
ld a, [de] ;copy size
ld [hl+], a
inc de
ld a, [de]
ld [hl], a
pop bc
ldh a, [hRealBanks]
sub b
ret
.not_same_filename:
ld a, e
add b
add 3
ld e, a
pop bc
.continue_loop_filesystem
dec b
jr nz, .loop_filesystem
ld a, c
ret
_load::
call fname
call findfile
swap a
ld e, a
and $f
jp nz, qhow ; no file found
ld hl, filesize
ld a, [hl+]
ld c, a
ldh [textunfilled], a
ld a, [hl]
ld b, a
add HIGH(fs_begin)
ldh [textunfilled+1], a
ld a, e
call copyfile
jp rstart
del::
call fname
call findfile
ld e, a
and $f0
jp nz, qhow ; no file found
ld a, e
dec a
swap a
ld hl, filesystem
add l
ld l, a
xor a
ld [hl], a
ld a, e
ld [rRAMB], a
xor a
ld hl, fs_magic
ld [hl+], a
ld [hl+], a
ld [hl+], a
ld [hl], a
ld [rRAMB], a
jp rstart
save::
call fname
call findfile
cp $f0
jp z, qhow ; no file found and no more space
and $0f
push af
ld e, a
ld hl, fs_begin
ldh a, [textunfilled]
ld c, a
ldh a, [textunfilled+1]
sub h
ld b, a
ld a, e
push bc
call copyfile
pop bc
ld hl, filesize
ld a, c
ld [hl+], a
ld a, b
ld [hl], a
pop af
ld [rRAMB], a
ld hl, filesystem ; copy name and size to filesystem
dec a
swap a
add l
ld l, a
ld b, 15
ld de, filename
.fill_file_name_and_size_filesystem
ld a, [de]
ld [hl+], a
inc de
dec b
jr nz, .fill_file_name_and_size_filesystem
ld hl, fs_filename ; copy name and size to files itself
ld b, 15
ld de, filename
.fill_file_name_and_size
ld a, [de]
ld [hl+], a
inc de
dec b
jr nz, .fill_file_name_and_size
ld b, 4
ld hl, fs_magic
ld de, MAGIC
.fill_magic
ld a, [de]
ld [hl+], a
inc de
dec b
jr nz, .fill_magic
xor a ; return to bank 0
ld [rRAMB], a
jp rstart
; store filename from input in filename var
fname:
call_testc ; check filename
db $22 ; is first char a double quote
db fn4-@-1 ; no, so fail
ld hl, filename
ld b, $22
ld c, 8 ; max filename length
fn1:
ld a, [de]
inc de ; bump pointer
cp b ; double quote?
jr z, fn2
ld [hl], a ; copy into filename
inc hl
dec c ; check filename length
jp z, qhow ; too long
jr fn1
fn2:
call endchk
ld a, ' ' ; clear any remaining chars
ld [hl], a ; in filename
inc hl
dec c
jr nz, fn2
ld b, 5 ; set file type
ld de, FEXT
fn3:
ld a, [de]
ld [hl], a
inc hl
inc de
dec b
jr nz, fn3
ret
fn4:
jp qwhat
ENDC
;******************************************************************************
; Game Boy hardware constant definitions
; https://github.com/gbdev/hardware.inc
;******************************************************************************
; To the extent possible under law, the authors of this work have
; waived all copyright and related or neighboring rights to the work.
; See https://creativecommons.org/publicdomain/zero/1.0/ for details.
; SPDX-License-Identifier: CC0-1.0
; If this file was already included, don't do it again
if !def(HARDWARE_INC)
; Check for the minimum supported RGBDS version
if !def(__RGBDS_MAJOR__) || !def(__RGBDS_MINOR__) || !def(__RGBDS_PATCH__)
fail "This version of 'hardware.inc' requires RGBDS version 0.5.0 or later"
endc
if __RGBDS_MAJOR__ == 0 && __RGBDS_MINOR__ < 5
fail "This version of 'hardware.inc' requires RGBDS version 0.5.0 or later."
endc
; Define the include guard and the current hardware.inc version
; (do this after the RGBDS version check since the `def` syntax depends on it)
def HARDWARE_INC equ 1
def HARDWARE_INC_VERSION equs "5.3.0"
; Usage: rev_Check_hardware_inc <min_ver>
; Examples:
; rev_Check_hardware_inc 1.2.3
; rev_Check_hardware_inc 1.2 (equivalent to 1.2.0)
; rev_Check_hardware_inc 1 (equivalent to 1.0.0)
MACRO rev_Check_hardware_inc
if _NARG == 1 ; Actual invocation by the user
def hw_inc_cur_ver\@ equs strrpl("{HARDWARE_INC_VERSION}", ".", ",")
def hw_inc_min_ver\@ equs strrpl("\1", ".", ",")
rev_Check_hardware_inc {hw_inc_cur_ver\@}, {hw_inc_min_ver\@}, 0, 0
purge hw_inc_cur_ver\@, hw_inc_min_ver\@
else ; Recursive invocation
if \1 != \4 || (\2 < \5 || (\2 == \5 && \3 < \6))
fail "Version \1.\2.\3 of 'hardware.inc' is incompatible with requested version \4.\5.\6"
endc
endc
ENDM
;******************************************************************************
; Memory-mapped registers ($FFxx range)
;******************************************************************************
; -- JOYP / P1 ($FF00) --------------------------------------------------------
; Joypad face buttons
def rJOYP equ $FF00
def B_JOYP_GET_BUTTONS equ 5 ; 0 = reading buttons [r/w]
def B_JOYP_GET_CTRL_PAD equ 4 ; 0 = reading Control Pad [r/w]
def JOYP_GET equ %00_11_0000 ; select which inputs to read from the lower nybble
def JOYP_GET_BUTTONS equ %00_01_0000 ; reading A/B/Select/Start buttons
def JOYP_GET_CTRL_PAD equ %00_10_0000 ; reading Control Pad directions
def JOYP_GET_NONE equ %00_11_0000 ; reading nothing
def B_JOYP_START equ 3 ; 0 = Start is pressed (if reading buttons) [ro]
def B_JOYP_SELECT equ 2 ; 0 = Select is pressed (if reading buttons) [ro]
def B_JOYP_B equ 1 ; 0 = B is pressed (if reading buttons) [ro]
def B_JOYP_A equ 0 ; 0 = A is pressed (if reading buttons) [ro]
def B_JOYP_DOWN equ 3 ; 0 = Down is pressed (if reading Control Pad) [ro]
def B_JOYP_UP equ 2 ; 0 = Up is pressed (if reading Control Pad) [ro]
def B_JOYP_LEFT equ 1 ; 0 = Left is pressed (if reading Control Pad) [ro]
def B_JOYP_RIGHT equ 0 ; 0 = Right is pressed (if reading Control Pad) [ro]
def JOYP_INPUTS equ %0000_1111 ; bits equal to 0 indicate pressed (when reading inputs)
def JOYP_START equ 1 << B_JOYP_START
def JOYP_SELECT equ 1 << B_JOYP_SELECT
def JOYP_B equ 1 << B_JOYP_B
def JOYP_A equ 1 << B_JOYP_A
def JOYP_DOWN equ 1 << B_JOYP_DOWN
def JOYP_UP equ 1 << B_JOYP_UP
def JOYP_LEFT equ 1 << B_JOYP_LEFT
def JOYP_RIGHT equ 1 << B_JOYP_RIGHT
; SGB command packet transfer uses for JOYP bits
def B_JOYP_SGB_ONE equ 5 ; 0 = sending 1 bit
def B_JOYP_SGB_ZERO equ 4 ; 0 = sending 0 bit
def JOYP_SGB_START equ %00_00_0000 ; start SGB packet transfer
def JOYP_SGB_ONE equ %00_01_0000 ; send 1 bit
def JOYP_SGB_ZERO equ %00_10_0000 ; send 0 bit
def JOYP_SGB_FINISH equ %00_11_0000 ; finish SGB packet transfer
; Combined input byte, with Control Pad in high nybble (conventional order)
def B_PAD_DOWN equ 7
def B_PAD_UP equ 6
def B_PAD_LEFT equ 5
def B_PAD_RIGHT equ 4
def B_PAD_START equ 3
def B_PAD_SELECT equ 2
def B_PAD_B equ 1
def B_PAD_A equ 0
def PAD_CTRL_PAD equ %1111_0000
def PAD_BUTTONS equ %0000_1111
def PAD_DOWN equ 1 << B_PAD_DOWN
def PAD_UP equ 1 << B_PAD_UP
def PAD_LEFT equ 1 << B_PAD_LEFT
def PAD_RIGHT equ 1 << B_PAD_RIGHT
def PAD_START equ 1 << B_PAD_START
def PAD_SELECT equ 1 << B_PAD_SELECT
def PAD_B equ 1 << B_PAD_B
def PAD_A equ 1 << B_PAD_A
; Combined input byte, with Control Pad in low nybble (swapped order)
def B_PAD_SWAP_START equ 7
def B_PAD_SWAP_SELECT equ 6
def B_PAD_SWAP_B equ 5
def B_PAD_SWAP_A equ 4
def B_PAD_SWAP_DOWN equ 3
def B_PAD_SWAP_UP equ 2
def B_PAD_SWAP_LEFT equ 1
def B_PAD_SWAP_RIGHT equ 0
def PAD_SWAP_CTRL_PAD equ %0000_1111
def PAD_SWAP_BUTTONS equ %1111_0000
def PAD_SWAP_START equ 1 << B_PAD_SWAP_START
def PAD_SWAP_SELECT equ 1 << B_PAD_SWAP_SELECT
def PAD_SWAP_B equ 1 << B_PAD_SWAP_B
def PAD_SWAP_A equ 1 << B_PAD_SWAP_A
def PAD_SWAP_DOWN equ 1 << B_PAD_SWAP_DOWN
def PAD_SWAP_UP equ 1 << B_PAD_SWAP_UP
def PAD_SWAP_LEFT equ 1 << B_PAD_SWAP_LEFT
def PAD_SWAP_RIGHT equ 1 << B_PAD_SWAP_RIGHT
; -- SB ($FF01) ---------------------------------------------------------------
; Serial transfer data [r/w]
def rSB equ $FF01
; -- SC ($FF02) ---------------------------------------------------------------
; Serial transfer control
def rSC equ $FF02
def B_SC_START equ 7 ; reading 1 = transfer in progress, writing 1 = start transfer [r/w]
def B_SC_SPEED equ 1 ; (CGB only) 1 = use faster internal clock [r/w]
def B_SC_SOURCE equ 0 ; 0 = use external clock ("slave"), 1 = use internal clock ("master") [r/w]
def SC_START equ 1 << B_SC_START
def SC_SPEED equ 1 << B_SC_SPEED
def SC_SLOW equ 0 << B_SC_SPEED
def SC_FAST equ 1 << B_SC_SPEED
def SC_SOURCE equ 1 << B_SC_SOURCE
def SC_EXTERNAL equ 0 << B_SC_SOURCE
def SC_INTERNAL equ 1 << B_SC_SOURCE
; -- $FF03 is unused ----------------------------------------------------------
; -- DIV ($FF04) --------------------------------------------------------------
; Divider register [r/w]
def rDIV equ $FF04
; -- TIMA ($FF05) -------------------------------------------------------------
; Timer counter [r/w]
def rTIMA equ $FF05
; -- TMA ($FF06) --------------------------------------------------------------
; Timer modulo [r/w]
def rTMA equ $FF06
; -- TAC ($FF07) --------------------------------------------------------------
; Timer control
def rTAC equ $FF07
def B_TAC_START equ 2 ; enable incrementing TIMA [r/w]
def TAC_STOP equ 0 << B_TAC_START
def TAC_START equ 1 << B_TAC_START
def TAC_CLOCK equ %000000_11 ; the frequency at which TIMA increments [r/w]
def TAC_4KHZ equ %000000_00 ; every 256 M-cycles = ~4 KHz on DMG
def TAC_262KHZ equ %000000_01 ; every 4 M-cycles = ~262 KHz on DMG
def TAC_65KHZ equ %000000_10 ; every 16 M-cycles = ~65 KHz on DMG
def TAC_16KHZ equ %000000_11 ; every 64 M-cycles = ~16 KHz on DMG
; -- $FF08-$FF0E are unused ---------------------------------------------------
; -- IF ($FF0F) ---------------------------------------------------------------
; Pending interrupts
def rIF equ $FF0F
def B_IF_JOYPAD equ 4 ; 1 = joypad interrupt is pending [r/w]
def B_IF_SERIAL equ 3 ; 1 = serial interrupt is pending [r/w]
def B_IF_TIMER equ 2 ; 1 = timer interrupt is pending [r/w]
def B_IF_STAT equ 1 ; 1 = STAT interrupt is pending [r/w]
def B_IF_VBLANK equ 0 ; 1 = VBlank interrupt is pending [r/w]
def IF_JOYPAD equ 1 << B_IF_JOYPAD
def IF_SERIAL equ 1 << B_IF_SERIAL
def IF_TIMER equ 1 << B_IF_TIMER
def IF_STAT equ 1 << B_IF_STAT
def IF_VBLANK equ 1 << B_IF_VBLANK
; -- AUD1SWEEP / NR10 ($FF10) -------------------------------------------------
; Audio channel 1 sweep
if def(TARGET_MEGADUCK)
def rAUD1SWEEP equ $FF20
else
def rAUD1SWEEP equ $FF10
endc
def AUD1SWEEP_TIME equ %0_111_0000 ; how long between sweep iterations
; (in 128 Hz ticks, ~7.8 ms apart) [r/w]
def B_AUD1SWEEP_DIR equ 3 ; sweep direction [r/w]
def AUD1SWEEP_DIR equ 1 << B_AUD1SWEEP_DIR
def AUD1SWEEP_UP equ 0 << B_AUD1SWEEP_DIR
def AUD1SWEEP_DOWN equ 1 << B_AUD1SWEEP_DIR
def AUD1SWEEP_SHIFT equ %00000_111 ; how much the period increases/decreases per iteration [r/w]
; -- AUD1LEN / NR11 ($FF11) ---------------------------------------------------
; Audio channel 1 length timer and duty cycle
if def(TARGET_MEGADUCK)
def rAUD1LEN equ $FF22
else
def rAUD1LEN equ $FF11
endc
def AUD1LEN_DUTY equ %11_000000 ; ratio of time spent high vs. time spent low [r/w]
def AUD1LEN_DUTY_12_5 equ %00_000000 ; 12.5%
def AUD1LEN_DUTY_25 equ %01_000000 ; 25%
def AUD1LEN_DUTY_50 equ %10_000000 ; 50%
def AUD1LEN_DUTY_75 equ %11_000000 ; 75%
def AUD1LEN_TIMER equ %00_111111 ; initial length timer (0-63) [wo]
; -- AUD1ENV / NR12 ($FF12) ---------------------------------------------------
; Audio channel 1 volume and envelope
if def(TARGET_MEGADUCK)
def rAUD1ENV equ $FF21
else
def rAUD1ENV equ $FF12
endc
def AUD1ENV_INIT_VOLUME equ %1111_0000 ; initial volume [r/w]
def B_AUD1ENV_DIR equ 3 ; direction of volume envelope [r/w]
def AUD1ENV_DIR equ 1 << B_AUD1ENV_DIR
def AUD1ENV_DOWN equ 0 << B_AUD1ENV_DIR
def AUD1ENV_UP equ 1 << B_AUD1ENV_DIR
def AUD1ENV_PACE equ %00000_111 ; how long between envelope iterations
; (in 64 Hz ticks, ~15.6 ms apart) [r/w]
; -- AUD1LOW / NR13 ($FF13) ---------------------------------------------------
; Audio channel 1 period (low 8 bits) [wo]
if def(TARGET_MEGADUCK)
def rAUD1LOW equ $FF23
else
def rAUD1LOW equ $FF13
endc
; -- AUD1HIGH / NR14 ($FF14) --------------------------------------------------
; Audio channel 1 period (high 3 bits) and control
if def(TARGET_MEGADUCK)
def rAUD1HIGH equ $FF24
else
def rAUD1HIGH equ $FF14
endc
def B_AUD1HIGH_RESTART equ 7 ; 1 = restart the channel [wo]
def B_AUD1HIGH_LEN_ENABLE equ 6 ; 1 = reset the channel after the length timer expires [r/w]
def AUD1HIGH_RESTART equ 1 << B_AUD1HIGH_RESTART
def AUD1HIGH_LENGTH_OFF equ 0 << B_AUD1HIGH_LEN_ENABLE
def AUD1HIGH_LENGTH_ON equ 1 << B_AUD1HIGH_LEN_ENABLE
def AUD1HIGH_PERIOD_HIGH equ %00000_111 ; upper 3 bits of the channel's period [wo]
; -- $FF15 is unused ----------------------------------------------------------
; -- AUD2LEN / NR21 ($FF16) ---------------------------------------------------
; Audio channel 2 length timer and duty cycle
if def(TARGET_MEGADUCK)
def rAUD2LEN equ $FF25
else
def rAUD2LEN equ $FF16
endc
def AUD2LEN_DUTY equ %11_000000 ; ratio of time spent high vs. time spent low [r/w]
def AUD2LEN_DUTY_12_5 equ %00_000000 ; 12.5%
def AUD2LEN_DUTY_25 equ %01_000000 ; 25%
def AUD2LEN_DUTY_50 equ %10_000000 ; 50%
def AUD2LEN_DUTY_75 equ %11_000000 ; 75%
def AUD2LEN_TIMER equ %00_111111 ; initial length timer (0-63) [wo]
; -- AUD2ENV / NR22 ($FF17) ---------------------------------------------------
; Audio channel 2 volume and envelope
if def(TARGET_MEGADUCK)
def rAUD2ENV equ $FF27
else
def rAUD2ENV equ $FF17
endc
def AUD2ENV_INIT_VOLUME equ %1111_0000 ; initial volume [r/w]
def B_AUD2ENV_DIR equ 3 ; direction of volume envelope [r/w]
def AUD2ENV_DIR equ 1 << B_AUD2ENV_DIR
def AUD2ENV_DOWN equ 0 << B_AUD2ENV_DIR
def AUD2ENV_UP equ 1 << B_AUD2ENV_DIR
def AUD2ENV_PACE equ %00000_111 ; how long between envelope iterations
; (in 64 Hz ticks, ~15.6 ms apart) [r/w]
; -- AUD2LOW / NR23 ($FF18) ---------------------------------------------------
; Audio channel 2 period (low 8 bits) [wo]
if def(TARGET_MEGADUCK)
def rAUD2LOW equ $FF28
else
def rAUD2LOW equ $FF18
endc
; -- AUD2HIGH / NR24 ($FF19) --------------------------------------------------
; Audio channel 2 period (high 3 bits) and control
if def(TARGET_MEGADUCK)
def rAUD2HIGH equ $FF29
else
def rAUD2HIGH equ $FF19
endc
def B_AUD2HIGH_RESTART equ 7 ; 1 = restart the channel [wo]
def B_AUD2HIGH_LEN_ENABLE equ 6 ; 1 = reset the channel after the length timer expires [r/w]
def AUD2HIGH_RESTART equ 1 << B_AUD2HIGH_RESTART
def AUD2HIGH_LENGTH_OFF equ 0 << B_AUD2HIGH_LEN_ENABLE
def AUD2HIGH_LENGTH_ON equ 1 << B_AUD2HIGH_LEN_ENABLE
def AUD2HIGH_PERIOD_HIGH equ %00000_111 ; upper 3 bits of the channel's period [wo]
; -- AUD3ENA / NR30 ($FF1A) ---------------------------------------------------
; Audio channel 3 enable
if def(TARGET_MEGADUCK)
def rAUD3ENA equ $FF2A
else
def rAUD3ENA equ $FF1A
endc
def B_AUD3ENA_ENABLE equ 7 ; 1 = channel is active [r/w]
def AUD3ENA_OFF equ 0 << B_AUD3ENA_ENABLE
def AUD3ENA_ON equ 1 << B_AUD3ENA_ENABLE
; -- AUD3LEN / NR31 ($FF1B) ---------------------------------------------------
; Audio channel 3 length timer [wo]
if def(TARGET_MEGADUCK)
def rAUD3LEN equ $FF2B
else
def rAUD3LEN equ $FF1B
endc
; -- AUD3LEVEL / NR32 ($FF1C) -------------------------------------------------
; Audio channel 3 volume
if def(TARGET_MEGADUCK)
def rAUD3LEVEL equ $FF2C
else
def rAUD3LEVEL equ $FF1C
endc
def AUD3LEVEL_VOLUME equ %0_11_00000 ; volume level [r/w]
def AUD3LEVEL_MUTE equ %0_00_00000 ; 0% (muted)
if def(TARGET_MEGADUCK)
def AUD3LEVEL_100 equ %0_11_00000 ; 100%
def AUD3LEVEL_50 equ %0_10_00000 ; 50%
def AUD3LEVEL_25 equ %0_01_00000 ; 25%
else
def AUD3LEVEL_100 equ %0_01_00000 ; 100%
def AUD3LEVEL_50 equ %0_10_00000 ; 50%
def AUD3LEVEL_25 equ %0_11_00000 ; 25%
endc
; -- AUD3LOW / NR33 ($FF1D) ---------------------------------------------------
; Audio channel 3 period (low 8 bits) [wo]
if def(TARGET_MEGADUCK)
def rAUD3LOW equ $FF2E
else
def rAUD3LOW equ $FF1D
endc
; -- AUD3HIGH / NR34 ($FF1E) --------------------------------------------------
; Audio channel 3 period (high 3 bits) and control
if def(TARGET_MEGADUCK)
def rAUD3HIGH equ $FF2D
else
def rAUD3HIGH equ $FF1E
endc
def B_AUD3HIGH_RESTART equ 7 ; 1 = restart the channel [wo]
def B_AUD3HIGH_LEN_ENABLE equ 6 ; 1 = reset the channel after the length timer expires [r/w]
def AUD3HIGH_RESTART equ 1 << B_AUD3HIGH_RESTART
def AUD3HIGH_LENGTH_OFF equ 0 << B_AUD3HIGH_LEN_ENABLE
def AUD3HIGH_LENGTH_ON equ 1 << B_AUD3HIGH_LEN_ENABLE
def AUD3HIGH_PERIOD_HIGH equ %00000_111 ; upper 3 bits of the channel's period [wo]
; -- $FF1F is unused ----------------------------------------------------------
; -- AUD4LEN / NR41 ($FF20) ---------------------------------------------------
; Audio channel 4 length timer
if def(TARGET_MEGADUCK)
def rAUD4LEN equ $FF40
else
def rAUD4LEN equ $FF20
endc
def AUD4LEN_TIMER equ %00_111111 ; initial length timer (0-63) [wo]
; -- AUD4ENV / NR42 ($FF21) ---------------------------------------------------
; Audio channel 4 volume and envelope
if def(TARGET_MEGADUCK)
def rAUD4ENV equ $FF42
else
def rAUD4ENV equ $FF21
endc
def AUD4ENV_INIT_VOLUME equ %1111_0000 ; initial volume [r/w]
def B_AUD4ENV_DIR equ 3 ; direction of volume envelope [r/w]
def AUD4ENV_DIR equ 1 << B_AUD4ENV_DIR
def AUD4ENV_DOWN equ 0 << B_AUD4ENV_DIR
def AUD4ENV_UP equ 1 << B_AUD4ENV_DIR
def AUD4ENV_PACE equ %00000_111 ; how long between envelope iterations
; (in 64 Hz ticks, ~15.6 ms apart) [r/w]
; -- AUD4POLY / NR43 ($FF22) --------------------------------------------------
; Audio channel 4 period and randomness
if def(TARGET_MEGADUCK)
def rAUD4POLY equ $FF41
else
def rAUD4POLY equ $FF22
endc
def AUD4POLY_SHIFT equ %1111_0000 ; coarse control of the channel's period [r/w]
def B_AUD4POLY_WIDTH equ 3 ; controls the noise generator (LFSR)'s step width [r/w]
def AUD4POLY_15STEP equ 0 << B_AUD4POLY_WIDTH
def AUD4POLY_7STEP equ 1 << B_AUD4POLY_WIDTH
def AUD4POLY_DIV equ %00000_111 ; fine control of the channel's period [r/w]
; -- AUD4GO / NR44 ($FF23) ----------------------------------------------------
; Audio channel 4 control
if def(TARGET_MEGADUCK)
def rAUD4GO equ $FF43
else
def rAUD4GO equ $FF23
endc
def B_AUD4GO_RESTART equ 7 ; 1 = restart the channel [wo]
def B_AUD4GO_LEN_ENABLE equ 6 ; 1 = reset the channel after the length timer expires [r/w]
def AUD4GO_RESTART equ 1 << B_AUD4GO_RESTART
def AUD4GO_LENGTH_OFF equ 0 << B_AUD4GO_LEN_ENABLE
def AUD4GO_LENGTH_ON equ 1 << B_AUD4GO_LEN_ENABLE
; -- AUDVOL / NR50 ($FF24) ----------------------------------------------------
; Audio master volume and VIN mixer
if def(TARGET_MEGADUCK)
def rAUDVOL equ $FF44
else
def rAUDVOL equ $FF24
endc
def B_AUDVOL_VIN_LEFT equ 7 ; 1 = output VIN to left ear (SO2, speaker 2) [r/w]
def AUDVOL_VIN_LEFT equ 1 << B_AUDVOL_VIN_LEFT
def AUDVOL_LEFT equ %0_111_0000 ; 0 = barely audible, 7 = full volume [r/w]
def B_AUDVOL_VIN_RIGHT equ 3 ; 1 = output VIN to right ear (SO1, speaker 1) [r/w]
def AUDVOL_VIN_RIGHT equ 1 << B_AUDVOL_VIN_RIGHT
def AUDVOL_RIGHT equ %00000_111 ; 0 = barely audible, 7 = full volume [r/w]
; -- AUDTERM / NR51 ($FF25) ---------------------------------------------------
; Audio channel mixer
if def(TARGET_MEGADUCK)
def rAUDTERM equ $FF46
else
def rAUDTERM equ $FF25
endc
def B_AUDTERM_4_LEFT equ 7 ; 1 = output channel 4 to left ear [r/w]
def B_AUDTERM_3_LEFT equ 6 ; 1 = output channel 3 to left ear [r/w]
def B_AUDTERM_2_LEFT equ 5 ; 1 = output channel 2 to left ear [r/w]
def B_AUDTERM_1_LEFT equ 4 ; 1 = output channel 1 to left ear [r/w]
def B_AUDTERM_4_RIGHT equ 3 ; 1 = output channel 4 to right ear [r/w]
def B_AUDTERM_3_RIGHT equ 2 ; 1 = output channel 3 to right ear [r/w]
def B_AUDTERM_2_RIGHT equ 1 ; 1 = output channel 2 to right ear [r/w]
def B_AUDTERM_1_RIGHT equ 0 ; 1 = output channel 1 to right ear [r/w]
def AUDTERM_4_LEFT equ 1 << B_AUDTERM_4_LEFT
def AUDTERM_3_LEFT equ 1 << B_AUDTERM_3_LEFT
def AUDTERM_2_LEFT equ 1 << B_AUDTERM_2_LEFT
def AUDTERM_1_LEFT equ 1 << B_AUDTERM_1_LEFT
def AUDTERM_4_RIGHT equ 1 << B_AUDTERM_4_RIGHT
def AUDTERM_3_RIGHT equ 1 << B_AUDTERM_3_RIGHT
def AUDTERM_2_RIGHT equ 1 << B_AUDTERM_2_RIGHT
def AUDTERM_1_RIGHT equ 1 << B_AUDTERM_1_RIGHT
; -- AUDENA / NR52 ($FF26) ----------------------------------------------------
; Audio master enable
if def(TARGET_MEGADUCK)
def rAUDENA equ $FF45
else
def rAUDENA equ $FF26
endc
def B_AUDENA_ENABLE equ 7 ; 0 = disable the APU (resets all audio registers to 0!) [r/w]
def B_AUDENA_ENABLE_CH4 equ 3 ; 1 = channel 4 is running [ro]
def B_AUDENA_ENABLE_CH3 equ 2 ; 1 = channel 3 is running [ro]
def B_AUDENA_ENABLE_CH2 equ 1 ; 1 = channel 2 is running [ro]
def B_AUDENA_ENABLE_CH1 equ 0 ; 1 = channel 1 is running [ro]
def AUDENA_OFF equ 0 << B_AUDENA_ENABLE
def AUDENA_ON equ 1 << B_AUDENA_ENABLE
def AUDENA_CH4_OFF equ 0 << B_AUDENA_ENABLE_CH4
def AUDENA_CH4_ON equ 1 << B_AUDENA_ENABLE_CH4
def AUDENA_CH3_OFF equ 0 << B_AUDENA_ENABLE_CH3
def AUDENA_CH3_ON equ 1 << B_AUDENA_ENABLE_CH3
def AUDENA_CH2_OFF equ 0 << B_AUDENA_ENABLE_CH2
def AUDENA_CH2_ON equ 1 << B_AUDENA_ENABLE_CH2
def AUDENA_CH1_OFF equ 0 << B_AUDENA_ENABLE_CH1
def AUDENA_CH1_ON equ 1 << B_AUDENA_ENABLE_CH1
; -- $FF27-$FF2F are unused ---------------------------------------------------
; -- AUD3WAVE ($FF30-$FF3F) ---------------------------------------------------
; Audio channel 3 wave pattern RAM [r/w]
def rAUD3WAVE_0 equ $FF30
def rAUD3WAVE_1 equ $FF31
def rAUD3WAVE_2 equ $FF32
def rAUD3WAVE_3 equ $FF33
def rAUD3WAVE_4 equ $FF34
def rAUD3WAVE_5 equ $FF35
def rAUD3WAVE_6 equ $FF36
def rAUD3WAVE_7 equ $FF37
def rAUD3WAVE_8 equ $FF38
def rAUD3WAVE_9 equ $FF39
def rAUD3WAVE_A equ $FF3A
def rAUD3WAVE_B equ $FF3B
def rAUD3WAVE_C equ $FF3C
def rAUD3WAVE_D equ $FF3D
def rAUD3WAVE_E equ $FF3E
def rAUD3WAVE_F equ $FF3F
; -- LCDC ($FF40) -------------------------------------------------------------
; PPU graphics control
if def(TARGET_MEGADUCK)
def rLCDC equ $FF10
else
def rLCDC equ $FF40
endc
if def(TARGET_MEGADUCK)
def B_LCDC_ENABLE equ 7 ; whether the PPU (and LCD) are turned on [r/w]
def B_LCDC_WIN_MAP equ 3 ; which tilemap the Window reads from [r/w]
def B_LCDC_WINDOW equ 5 ; whether the Window is enabled [r/w]
def B_LCDC_BLOCKS equ 4 ; which "tile blocks" the BG and Window use [r/w]
def B_LCDC_BG_MAP equ 2 ; which tilemap the BG reads from [r/w]
def B_LCDC_OBJ_SIZE equ 1 ; how many pixels tall each OBJ is [r/w]
def B_LCDC_OBJS equ 0 ; whether OBJs are enabled [r/w]
def B_LCDC_BG equ 6 ; (DMG only) whether the BG is enabled [r/w]
def B_LCDC_PRIO equ 6 ; (CGB only) whether OBJ priority bits are enabled [r/w]
else
def B_LCDC_ENABLE equ 7 ; whether the PPU (and LCD) are turned on [r/w]
def B_LCDC_WIN_MAP equ 6 ; which tilemap the Window reads from [r/w]
def B_LCDC_WINDOW equ 5 ; whether the Window is enabled [r/w]
def B_LCDC_BLOCKS equ 4 ; which "tile blocks" the BG and Window use [r/w]
def B_LCDC_BG_MAP equ 3 ; which tilemap the BG reads from [r/w]
def B_LCDC_OBJ_SIZE equ 2 ; how many pixels tall each OBJ is [r/w]
def B_LCDC_OBJS equ 1 ; whether OBJs are enabled [r/w]
def B_LCDC_BG equ 0 ; (DMG only) whether the BG is enabled [r/w]
def B_LCDC_PRIO equ 0 ; (CGB only) whether OBJ priority bits are enabled [r/w]
endc
def LCDC_ENABLE equ 1 << B_LCDC_ENABLE
def LCDC_OFF equ 0 << B_LCDC_ENABLE
def LCDC_ON equ 1 << B_LCDC_ENABLE
def LCDC_WIN_MAP equ 1 << B_LCDC_WIN_MAP
def LCDC_WIN_9800 equ 0 << B_LCDC_WIN_MAP
def LCDC_WIN_9C00 equ 1 << B_LCDC_WIN_MAP
def LCDC_WINDOW equ 1 << B_LCDC_WINDOW
def LCDC_WIN_OFF equ 0 << B_LCDC_WINDOW
def LCDC_WIN_ON equ 1 << B_LCDC_WINDOW
def LCDC_BLOCKS equ 1 << B_LCDC_BLOCKS
def LCDC_BLOCK21 equ 0 << B_LCDC_BLOCKS
def LCDC_BLOCK01 equ 1 << B_LCDC_BLOCKS
def LCDC_BG_MAP equ 1 << B_LCDC_BG_MAP
def LCDC_BG_9800 equ 0 << B_LCDC_BG_MAP
def LCDC_BG_9C00 equ 1 << B_LCDC_BG_MAP
def LCDC_OBJ_SIZE equ 1 << B_LCDC_OBJ_SIZE
def LCDC_OBJ_8 equ 0 << B_LCDC_OBJ_SIZE
def LCDC_OBJ_16 equ 1 << B_LCDC_OBJ_SIZE
def LCDC_OBJS equ 1 << B_LCDC_OBJS
def LCDC_OBJ_OFF equ 0 << B_LCDC_OBJS
def LCDC_OBJ_ON equ 1 << B_LCDC_OBJS
def LCDC_BG equ 1 << B_LCDC_BG
def LCDC_BG_OFF equ 0 << B_LCDC_BG
def LCDC_BG_ON equ 1 << B_LCDC_BG
def LCDC_PRIO equ 1 << B_LCDC_PRIO
def LCDC_PRIO_OFF equ 0 << B_LCDC_PRIO
def LCDC_PRIO_ON equ 1 << B_LCDC_PRIO
; -- STAT ($FF41) -------------------------------------------------------------
; Graphics status and interrupt control
if def(TARGET_MEGADUCK)
def rSTAT equ $FF11
else
def rSTAT equ $FF41
endc
def B_STAT_LYC equ 6 ; 1 = LY match triggers the STAT interrupt [r/w]
def B_STAT_MODE_2 equ 5 ; 1 = OAM Scan triggers the PPU interrupt [r/w]
def B_STAT_MODE_1 equ 4 ; 1 = VBlank triggers the PPU interrupt [r/w]
def B_STAT_MODE_0 equ 3 ; 1 = HBlank triggers the PPU interrupt [r/w]
def B_STAT_LYCF equ 2 ; 1 = LY is currently equal to LYC [ro]
def B_STAT_BUSY equ 1 ; 1 = the PPU is currently accessing VRAM [ro]
def STAT_LYC equ 1 << B_STAT_LYC
def STAT_MODE_2 equ 1 << B_STAT_MODE_2
def STAT_MODE_1 equ 1 << B_STAT_MODE_1
def STAT_MODE_0 equ 1 << B_STAT_MODE_0
def STAT_LYCF equ 1 << B_STAT_LYCF
def STAT_BUSY equ 1 << B_STAT_BUSY
def STAT_MODE equ %000000_11 ; PPU's current status [ro]
def STAT_HBLANK equ %000000_00 ; waiting after a line's rendering (HBlank)
def STAT_VBLANK equ %000000_01 ; waiting between frames (VBlank)
def STAT_OAM equ %000000_10 ; checking which OBJs will be rendered on this line (OAM scan)
def STAT_LCD equ %000000_11 ; pushing pixels to the LCD
; -- SCY ($FF42) --------------------------------------------------------------
; Background Y scroll offset (in pixels) [r/w]
if def(TARGET_MEGADUCK)
def rSCY equ $FF12
else
def rSCY equ $FF42
endc
; -- SCX ($FF43) --------------------------------------------------------------
; Background X scroll offset (in pixels) [r/w]
if def(TARGET_MEGADUCK)
def rSCX equ $FF13
else
def rSCX equ $FF43
endc
; -- LY ($FF44) ---------------------------------------------------------------
; Y coordinate of the line currently processed by the PPU (0-153) [ro]
if def(TARGET_MEGADUCK)
def rLY equ $FF18
else
def rLY equ $FF44
endc
def LY_VBLANK equ 144 ; 144-153 is the VBlank period
; -- LYC ($FF45) --------------------------------------------------------------
; Value that LY is constantly compared to [r/w]
if def(TARGET_MEGADUCK)
def rLYC equ $FF19
else
def rLYC equ $FF45
endc
; -- DMA ($FF46) --------------------------------------------------------------
; OAM DMA start address (high 8 bits) and start [wo]
if def(TARGET_MEGADUCK)
def rDMA equ $FF1A
else
def rDMA equ $FF46
endc
; -- BGP ($FF47) --------------------------------------------------------------
; (DMG only) Background color mapping [r/w]
if def(TARGET_MEGADUCK)
def rBGP equ $FF1B
else
def rBGP equ $FF47
endc
def BGP_SGB_TRANSFER equ %11_10_01_00 ; set BGP to this value before SGB VRAM transfer
; -- OBP0 ($FF48) -------------------------------------------------------------
; (DMG only) OBJ color mapping #0 [r/w]
if def(TARGET_MEGADUCK)
def rOBP0 equ $FF14
else
def rOBP0 equ $FF48
endc
; -- OBP1 ($FF49) -------------------------------------------------------------
; (DMG only) OBJ color mapping #1 [r/w]
if def(TARGET_MEGADUCK)
def rOBP1 equ $FF15
else
def rOBP1 equ $FF49
endc
; -- WY ($FF4A) ---------------------------------------------------------------
; Y coordinate of the Window's top-left pixel (0-143) [r/w]
if def(TARGET_MEGADUCK)
def rWY equ $FF16
else
def rWY equ $FF4A
endc
; -- WX ($FF4B) ---------------------------------------------------------------
; X coordinate of the Window's top-left pixel, plus 7 (7-166) [r/w]
if def(TARGET_MEGADUCK)
def rWX equ $FF17
else
def rWX equ $FF4B
endc
def WX_OFS equ 7 ; subtract this to get the actual Window X coordinate
; -- SYS / KEY0 ($FF4C) -------------------------------------------------------
; (CGB boot ROM only) CPU mode select
def rSYS equ $FF4C
; This is known as the "CPU mode register" in Fig. 11 of this patent:
; https://patents.google.com/patent/US6322447B1/en?oq=US6322447bi
; "OBJ priority mode designating register" in the same patent
; Credit to @mattcurrie for this finding!
def SYS_MODE equ %0000_11_00 ; current system mode [r/w]
def SYS_CGB equ %0000_00_00 ; CGB mode
def SYS_DMG equ %0000_01_00 ; DMG compatibility mode
def SYS_PGB1 equ %0000_10_00 ; LCD is driven externally, CPU is stopped
def SYS_PGB2 equ %0000_11_00 ; LCD is driven externally, CPU is running
; -- SPD / KEY1 ($FF4D) -------------------------------------------------------
; (CGB only) Double-speed mode control
def rSPD equ $FF4D
def B_SPD_DOUBLE equ 7 ; current clock speed [ro]
def B_SPD_PREPARE equ 0 ; 1 = next `stop` instruction will switch clock speeds [r/w]
def SPD_SINGLE equ 0 << B_SPD_DOUBLE
def SPD_DOUBLE equ 1 << B_SPD_DOUBLE
def SPD_PREPARE equ 1 << B_SPD_PREPARE
; -- $FF4E is unused ----------------------------------------------------------
; -- VBK ($FF4F) --------------------------------------------------------------
; (CGB only) VRAM bank number (0 or 1)
def rVBK equ $FF4F
def VBK_BANK equ %0000000_1 ; mapped VRAM bank [r/w]
; -- BANK ($FF50) -------------------------------------------------------------
; (boot ROM only) Boot ROM mapping control
def rBANK equ $FF50
def B_BANK_ON equ 0 ; whether the boot ROM is mapped [wo]
def BANK_ON equ 0 << B_BANK_ON
def BANK_OFF equ 1 << B_BANK_ON
; -- VDMA_SRC_HIGH / HDMA1 ($FF51) --------------------------------------------
; (CGB only) VRAM DMA source address (high 8 bits) [wo]
def rVDMA_SRC_HIGH equ $FF51
; -- VDMA_SRC_LOW / HDMA2 ($FF52) ---------------------------------------------
; (CGB only) VRAM DMA source address (low 8 bits) [wo]
def rVDMA_SRC_LOW equ $FF52
; -- VDMA_DEST_HIGH / HDMA3 ($FF53) -------------------------------------------
; (CGB only) VRAM DMA destination address (high 8 bits) [wo]
def rVDMA_DEST_HIGH equ $FF53
; -- VDMA_DEST_LOW / HDMA4 ($FF54) --------------------------------------------
; (CGB only) VRAM DMA destination address (low 8 bits) [wo]
def rVDMA_DEST_LOW equ $FF54
; -- VDMA_LEN / HDMA5 ($FF55) -------------------------------------------------
; (CGB only) VRAM DMA length, mode, and start
def rVDMA_LEN equ $FF55
def B_VDMA_LEN_MODE equ 7 ; on write: VRAM DMA mode [wo]
def VDMA_LEN_MODE equ 1 << B_VDMA_LEN_MODE
def VDMA_LEN_MODE_GENERAL equ 0 << B_VDMA_LEN_MODE ; GDMA (general-purpose)
def VDMA_LEN_MODE_HBLANK equ 1 << B_VDMA_LEN_MODE ; HDMA (HBlank)
def B_VDMA_LEN_BUSY equ 7 ; on read: is a VRAM DMA active?
def VDMA_LEN_BUSY equ 1 << B_VDMA_LEN_BUSY
def VDMA_LEN_NO equ 0 << B_VDMA_LEN_BUSY
def VDMA_LEN_YES equ 1 << B_VDMA_LEN_BUSY
def VDMA_LEN_SIZE equ %0_1111111 ; how many 16-byte blocks (minus 1) to transfer [r/w]
; -- RP ($FF56) ---------------------------------------------------------------
; (CGB only) Infrared communications port
def rRP equ $FF56
def RP_READ equ %11_000000 ; whether the IR read is enabled [r/w]
def RP_DISABLE equ %00_000000
def RP_ENABLE equ %11_000000
def B_RP_DATA_IN equ 1 ; 0 = IR light is being received [ro]
def B_RP_LED_ON equ 0 ; 1 = IR light is being sent [r/w]
def RP_DATA_IN equ 1 << B_RP_DATA_IN
def RP_LED_ON equ 1 << B_RP_LED_ON
def RP_WRITE_LOW equ 0 << B_RP_LED_ON
def RP_WRITE_HIGH equ 1 << B_RP_LED_ON
; -- $FF57-$FF67 are unused ---------------------------------------------------
; -- BGPI / BCPS ($FF68) ------------------------------------------------------
; (CGB only) Background palette I/O index
def rBGPI equ $FF68
def B_BGPI_AUTOINC equ 7 ; whether the index field is incremented after each write to BCPD [r/w]
def BGPI_AUTOINC equ 1 << B_BGPI_AUTOINC
def BGPI_INDEX equ %00_111111 ; the index within Palette RAM accessed via BCPD [r/w]
; -- BGPD / BCPD ($FF69) ------------------------------------------------------
; (CGB only) Background palette I/O access [r/w]
def rBGPD equ $FF69
; -- OBPI / OCPS ($FF6A) ------------------------------------------------------
; (CGB only) OBJ palette I/O index
def rOBPI equ $FF6A
def B_OBPI_AUTOINC equ 7 ; whether the index field is incremented after each write to OBPD [r/w]
def OBPI_AUTOINC equ 1 << B_OBPI_AUTOINC
def OBPI_INDEX equ %00_111111 ; the index within Palette RAM accessed via OBPD [r/w]
; -- OBPD / OCPD ($FF6B) ------------------------------------------------------
; (CGB only) OBJ palette I/O access [r/w]
def rOBPD equ $FF6B
; -- OPRI ($FF6C) -------------------------------------------------------------
; (CGB boot ROM only) OBJ draw priority mode
def rOPRI equ $FF6C
def B_OPRI_PRIORITY equ 0 ; which drawing priority is used for OBJs [r/w]
def OPRI_PRIORITY equ 1 << B_OPRI_PRIORITY
def OPRI_OAM equ 0 << B_OPRI_PRIORITY ; CGB mode default: earliest OBJ in OAM wins
def OPRI_COORD equ 1 << B_OPRI_PRIORITY ; DMG mode default: leftmost OBJ wins
; -- $FF6D-$FF6F are unused ---------------------------------------------------
; -- WBK / SVBK ($FF70) -------------------------------------------------------
; (CGB only) WRAM bank number
def rWBK equ $FF70
def WBK_BANK equ %00000_111 ; mapped WRAM bank (0-7) [r/w]
; -- PSW ($FF71) --------------------------------------------------------------
; (CGB boot ROM's DMG mode only) Palette Selection Window and NMI control. [r/w]
; Bits 1-6 are always 1.
; In CGB mode, reads return $FF and writes are ignored.
def rPSW equ $FF71
def B_PSW_WINDOW equ 7 ; whether the Palette Selection Window is enabled [r/w]
def B_PSW_NMI equ 0 ; whether the NMI is enabled [r/w]
def PSW_WINDOW equ 1 << B_PSW_WINDOW
def PSW_WIN_OFF equ 0 << B_PSW_WINDOW
def PSW_WIN_ON equ 1 << B_PSW_WINDOW
def PSW_NMI equ 1 << B_PSW_NMI
def PSW_NMI_DISABLE equ 0 << B_PSW_NMI
def PSW_NMI_ENABLE equ 1 << B_PSW_NMI
; -- PSWX ($FF72) -------------------------------------------------------------
; (CGB boot ROM only) X coordinate of the Palette Selection Window's top-left pixel, plus 7 (7-166) [r/w]
; Readable and writable in both CGB and DMG mode.
def rPSWX equ $FF72
; -- PSWY ($FF73) -------------------------------------------------------------
; (CGB boot ROM only) Y coordinate of the Palette Selection Window's top-left pixel (0-143) [r/w]
; Readable and writable in both CGB and DMG mode.
def rPSWY equ $FF73
; -- PSM ($FF74) --------------------------------------------------------------
; (CGB boot ROM only) Set the Palette Selection Window button mask (triggers NMI when pressed) [r/w]
; Readable and writable in both CGB and DMG mode.
def rPSM equ $FF74
def B_PSM_START equ 7
def B_PSM_SELECT equ 6
def B_PSM_B equ 5
def B_PSM_A equ 4
def B_PSM_DOWN equ 3
def B_PSM_UP equ 2
def B_PSM_LEFT equ 1
def B_PSM_RIGHT equ 0
def PSM_START equ 1 << B_PSM_START
def PSM_SELECT equ 1 << B_PSM_SELECT
def PSM_B equ 1 << B_PSM_B
def PSM_A equ 1 << B_PSM_A
def PSM_DOWN equ 1 << B_PSM_DOWN
def PSM_UP equ 1 << B_PSM_UP
def PSM_LEFT equ 1 << B_PSM_LEFT
def PSM_RIGHT equ 1 << B_PSM_RIGHT
; -- $FF75 is unused ----------------------------------------------------------
; -- PCM12 ($FF76) ------------------------------------------------------------
; Audio channels 1 and 2 output
def rPCM12 equ $FF76
def PCM12_CH2 equ %1111_0000 ; audio channel 2 output [ro]
def PCM12_CH1 equ %0000_1111 ; audio channel 1 output [ro]
; -- PCM34 ($FF77) ------------------------------------------------------------
; Audio channels 3 and 4 output
def rPCM34 equ $FF77
def PCM34_CH4 equ %1111_0000 ; audio channel 4 output [ro]
def PCM34_CH3 equ %0000_1111 ; audio channel 3 output [ro]
; -- $FF78-$FF7F are unused ---------------------------------------------------
; -- IE ($FFFF) ---------------------------------------------------------------
; Interrupt enable
def rIE equ $FFFF
def B_IE_JOYPAD equ 4 ; 1 = joypad interrupt is enabled [r/w]
def B_IE_SERIAL equ 3 ; 1 = serial interrupt is enabled [r/w]
def B_IE_TIMER equ 2 ; 1 = timer interrupt is enabled [r/w]
def B_IE_STAT equ 1 ; 1 = STAT interrupt is enabled [r/w]
def B_IE_VBLANK equ 0 ; 1 = VBlank interrupt is enabled [r/w]
def IE_JOYPAD equ 1 << B_IE_JOYPAD
def IE_SERIAL equ 1 << B_IE_SERIAL
def IE_TIMER equ 1 << B_IE_TIMER
def IE_STAT equ 1 << B_IE_STAT
def IE_VBLANK equ 1 << B_IE_VBLANK
;******************************************************************************
; Cartridge registers (MBC)
;******************************************************************************
; Note that these "registers" are each actually accessible at an entire address range;
; however, one address for each of these ranges is considered the "canonical" one, and
; these addresses are what's provided here.
; ** Common to most MBCs ******************************************************
; -- RAMG ($0000-$1FFF) -------------------------------------------------------
; Whether SRAM can be accessed [wo]
def rRAMG equ $0000
; Common values (not for HuC1 or HuC-3)
def RAMG_SRAM_DISABLE equ $00
def RAMG_SRAM_ENABLE equ $0A ; some MBCs accept any value whose low nybble is $A
; (HuC-3 only) switch SRAM to map cartridge RAM, RTC, or IR
def RAMG_CART_RAM_RO equ $00 ; select cartridge RAM [ro]
def RAMG_CART_RAM equ $0A ; select cartridge RAM [r/w]
def RAMG_RTC_IN equ $0B ; select RTC command/argument [wo]
def RAMG_RTC_IN_CMD equ %0_111_0000 ; command
def RAMG_RTC_IN_ARG equ %0_000_1111 ; argument
def RAMG_RTC_OUT equ $0C ; select RTC command/response [ro]
def RAMG_RTC_OUT_CMD equ %0_111_0000 ; command
def RAMG_RTC_OUT_RESULT equ %0_000_1111 ; result
def RAMG_RTC_SEMAPHORE equ $0D ; select RTC semaphore [r/w]
def RAMG_IR equ $0E ; (HuC1 and HuC-3 only) select IR [r/w]
; -- ROMB ($2000-$3FFF) -------------------------------------------------------
; ROM bank number (not for MBC5 or MBC6) [wo]
if def(TARGET_MEGADUCK)
def rROMB equ $0001
else
def rROMB equ $2000
endc
; -- RAMB ($4000-$5FFF) -------------------------------------------------------
; SRAM bank number (not for MBC2, MBC6, or MBC7) [wo]
def rRAMB equ $4000
; (MBC3 only) Special RAM bank numbers that actually map values into RTCREG
def RAMB_RTC_S equ $08 ; seconds counter (0-59)
def RAMB_RTC_M equ $09 ; minutes counter (0-59)
def RAMB_RTC_H equ $0A ; hours counter (0-23)
def RAMB_RTC_DL equ $0B ; days counter, low byte (0-255)
def RAMB_RTC_DH equ $0C ; days counter, high bit and other flags
def B_RAMB_RTC_DH_CARRY equ 7 ; 1 = days counter overflowed [wo]
def B_RAMB_RTC_DH_HALT equ 6 ; 0 = run timer, 1 = stop timer [wo]
def B_RAMB_RTC_DH_HIGH equ 0 ; days counter, high bit (bit 8) [wo]
def RAMB_RTC_DH_CARRY equ 1 << B_RAMB_RTC_DH_CARRY
def RAMB_RTC_DH_HALT equ 1 << B_RAMB_RTC_DH_HALT
def RAMB_RTC_DH_HIGH equ 1 << B_RAMB_RTC_DH_HIGH
def B_RAMB_RUMBLE equ 3 ; (MBC5 and MBC7 only) enable the rumble motor (if any)
def RAMB_RUMBLE equ 1 << B_RAMB_RUMBLE
def RAMB_RUMBLE_OFF equ 0 << B_RAMB_RUMBLE
def RAMB_RUMBLE_ON equ 1 << B_RAMB_RUMBLE
; ** MBC1 and MMM01 only ******************************************************
; -- BMODE ($6000-$7FFF) ------------------------------------------------------
; Banking mode select [wo]
def rBMODE equ $6000
def BMODE_SIMPLE equ $00 ; locks ROMB and RAMB to bank 0
def BMODE_ADVANCED equ $01 ; allows bank-switching with RAMB
; ** MBC2 only ****************************************************************
; -- ROM2B ($0000-$3FFF with bit 8 set) ---------------------------------------
; ROM bank number [wo]
def rROM2B equ $2100
; ** MBC3 only ****************************************************************
; -- RTCLATCH ($6000-$7FFF) ---------------------------------------------------
; RTC latch clock data [wo]
def rRTCLATCH equ $6000
; Write $00 then $01 to latch the current time into RTCREG
def RTCLATCH_START equ $00
def RTCLATCH_FINISH equ $01
; -- RTCREG ($A000-$BFFF) -----------------------------------------------------
; RTC register [r/w]
def rRTCREG equ $A000
; ** MBC5 only ****************************************************************
; -- ROMB0 ($2000-$2FFF) ------------------------------------------------------
; ROM bank number low byte (bits 0-7) [wo]
def rROMB0 equ $2000
; -- ROMB1 ($3000-$3FFF) ------------------------------------------------------
; ROM bank number high bit (bit 8) [wo]
def rROMB1 equ $3000
; ** MBC6 only ****************************************************************
; -- RAMBA ($0400-$07FF) ------------------------------------------------------
; RAM bank A number [wo]
def rRAMBA equ $0400
; -- RAMBB ($0800-$0BFF) ------------------------------------------------------
; RAM bank B number [wo]
def rRAMBB equ $0800
; -- FLASH ($0C00-$0FFF) ------------------------------------------------------
; Whether the flash chip can be accessed [wo]
def rFLASH equ $0C00
; -- FMODE ($1000) ------------------------------------------------------------
; Write mode select for the flash chip
def rFMODE equ $1000
; -- ROMBA ($2000-$27FF) ------------------------------------------------------
; ROM/Flash bank A number [wo]
def rROMBA equ $2000
; -- FLASHA ($2800-$2FFF) -----------------------------------------------------
; ROM/Flash bank A select [wo]
def rFLASHA equ $2800
; -- ROMBB ($3000-$37FF) ------------------------------------------------------
; ROM/Flash bank B number [wo]
def rROMBB equ $3000
; -- FLASHB ($3800-$3FFF) -----------------------------------------------------
; ROM/Flash bank B select [wo]
def rFLASHB equ $3800
; ** MBC7 only ****************************************************************
; -- RAMREG ($4000-$5FFF) -----------------------------------------------------
; Enable RAM register access [wo]
def rRAMREG equ $4000
def RAMREG_ENABLE equ $40
; -- ACCLATCH0 ($Ax0x) --------------------------------------------------------
; Latch accelerometer start [wo]
def rACCLATCH0 equ $A000
; Write $55 to ACCLATCH0 to erase the latched data
def ACCLATCH0_START equ $55
; -- ACCLATCH1 ($Ax1x) --------------------------------------------------------
; Latch accelerometer finish [wo]
def rACCLATCH1 equ $A010
; Write $AA to ACCLATCH1 to latch the accelerometer and update ACCEL*
def ACCLATCH1_FINISH equ $AA
; -- ACCELX0 ($Ax2x) ----------------------------------------------------------
; Accelerometer X value low byte [ro]
def rACCELX0 equ $A020
; -- ACCELX1 ($Ax3x) ----------------------------------------------------------
; Accelerometer X value high byte [ro]
def rACCELX1 equ $A030
; -- ACCELY0 ($Ax4x) ----------------------------------------------------------
; Accelerometer Y value low byte [ro]
def rACCELY0 equ $A040
; -- ACCELY1 ($Ax5x) ----------------------------------------------------------
; Accelerometer Y value high byte [ro]
def rACCELY1 equ $A050
; -- EEPROM ($Ax8x) -----------------------------------------------------------
; EEPROM access [r/w]
def rEEPROM equ $A080
; ** HuC1 only ****************************************************************
; -- IRREG ($A000-$BFFF) ------------------------------------------------------
; IR register [r/w]
def rIRREG equ $A000
; whether the IR transmitter sees light
def IR_LED_OFF equ $C0
def IR_LED_ON equ $C1
;******************************************************************************
; Screen-related constants
;******************************************************************************
def SCREEN_WIDTH_PX equ 160 ; width of screen in pixels
def SCREEN_HEIGHT_PX equ 144 ; height of screen in pixels
def SCREEN_WIDTH equ 20 ; width of screen in bytes
def SCREEN_HEIGHT equ 18 ; height of screen in bytes
def SCREEN_AREA equ SCREEN_WIDTH * SCREEN_HEIGHT ; size of screen in bytes
def TILEMAP_WIDTH_PX equ 256 ; width of tilemap in pixels
def TILEMAP_HEIGHT_PX equ 256 ; height of tilemap in pixels
def TILEMAP_WIDTH equ 32 ; width of tilemap in bytes
def TILEMAP_HEIGHT equ 32 ; height of tilemap in bytes
def TILEMAP_AREA equ TILEMAP_WIDTH * TILEMAP_HEIGHT ; size of tilemap in bytes
def TILE_WIDTH equ 8 ; width of tile in pixels
def TILE_HEIGHT equ 8 ; height of tile in pixels
def TILE_SIZE equ 16 ; size of tile in bytes (2 bits/pixel)
def COLOR_SIZE equ 2 ; size of color in bytes (little-endian BGR555)
def PAL_COLORS equ 4 ; colors per palette
def PAL_SIZE equ COLOR_SIZE * PAL_COLORS ; size of palette in bytes
def COLOR_CH_WIDTH equ 5 ; bits per RGB color channel
def COLOR_CH_MAX equ (1 << COLOR_CH_WIDTH) - 1
def B_COLOR_RED equ COLOR_CH_WIDTH * 0 ; bits 4-0
def B_COLOR_GREEN equ COLOR_CH_WIDTH * 1 ; bits 9-5
def B_COLOR_BLUE equ COLOR_CH_WIDTH * 2 ; bits 14-10
def COLOR_RED equ %000_11111 ; for the low byte
def COLOR_GREEN_LOW equ %111_00000 ; for the low byte
def COLOR_GREEN_HIGH equ %0_00000_11 ; for the high byte
def COLOR_BLUE equ %0_11111_00 ; for the high byte
; (DMG only) grayscale shade indexes for BGP, OBP0, and OBP1
def SHADE_WHITE equ %00
def SHADE_LIGHT equ %01
def SHADE_DARK equ %10
def SHADE_BLACK equ %11
; Tilemaps the BG or Window can read from (controlled by LCDC)
def TILEMAP0 equ $9800 ; $9800-$9BFF
def TILEMAP1 equ $9C00 ; $9C00-$9FFF
; (CGB only) BG tile attribute fields
def B_BG_PRIO equ 7 ; whether the BG tile colors 1-3 are drawn above OBJs
def B_BG_YFLIP equ 6 ; whether the whole BG tile is flipped vertically
def B_BG_XFLIP equ 5 ; whether the whole BG tile is flipped horizontally
def B_BG_BANK1 equ 3 ; which VRAM bank the BG tile is taken from
def BG_PALETTE equ %00000_111 ; which palette the BG tile uses
def BG_PRIO equ 1 << B_BG_PRIO
def BG_YFLIP equ 1 << B_BG_YFLIP
def BG_XFLIP equ 1 << B_BG_XFLIP
def BG_BANK0 equ 0 << B_BG_BANK1
def BG_BANK1 equ 1 << B_BG_BANK1
;******************************************************************************
; OBJ-related constants
;******************************************************************************
; OAM attribute field offsets
rsreset
def OAMA_Y rb ; 0
def OAM_Y_OFS equ 16 ; subtract 16 from what's written to OAM to get the real Y position
def OAMA_X rb ; 1
def OAM_X_OFS equ 8 ; subtract 8 from what's written to OAM to get the real X position
def OAMA_TILEID rb ; 2
def OAMA_FLAGS rb ; 3
def B_OAM_PRIO equ 7 ; whether the OBJ is drawn below BG colors 1-3
def B_OAM_YFLIP equ 6 ; whether the whole OBJ is flipped vertically
def B_OAM_XFLIP equ 5 ; whether the whole OBJ is flipped horizontally
def B_OAM_PAL1 equ 4 ; (DMG only) which of the two palettes the OBJ uses
def B_OAM_BANK1 equ 3 ; (CGB only) which VRAM bank the OBJ takes its tile(s) from
def OAM_PALETTE equ %00000_111 ; (CGB only) which palette the OBJ uses
def OAM_PRIO equ 1 << B_OAM_PRIO
def OAM_YFLIP equ 1 << B_OAM_YFLIP
def OAM_XFLIP equ 1 << B_OAM_XFLIP
def OAM_PAL0 equ 0 << B_OAM_PAL1
def OAM_PAL1 equ 1 << B_OAM_PAL1
def OAM_BANK0 equ 0 << B_OAM_BANK1
def OAM_BANK1 equ 1 << B_OAM_BANK1
def OBJ_SIZE rb 0 ; size of OBJ in bytes = 4
def OAM_COUNT equ 40 ; how many OBJs there are room for in OAM
def OAM_SIZE equ OBJ_SIZE * OAM_COUNT
;******************************************************************************
; Audio channel RAM addresses
;******************************************************************************
def AUD1RAM equ $FF10 ; $FF10-$FF14
def AUD2RAM equ $FF15 ; $FF15-$FF19
def AUD3RAM equ $FF1A ; $FF1A-$FF1E
def AUD4RAM equ $FF1F ; $FF1F-$FF23
def AUDRAM_SIZE equ 5 ; size of each audio channel RAM in bytes
def _AUD3WAVERAM equ $FF30 ; $FF30-$FF3F
def AUD3WAVE_SIZE equ 16 ; size of wave pattern RAM in bytes
;******************************************************************************
; Interrupt vector addresses
;******************************************************************************
def INT_HANDLER_VBLANK equ $0040 ; VBlank interrupt handler address
def INT_HANDLER_STAT equ $0048 ; STAT interrupt handler address
def INT_HANDLER_TIMER equ $0050 ; timer interrupt handler address
def INT_HANDLER_SERIAL equ $0058 ; serial interrupt handler address
def INT_HANDLER_JOYPAD equ $0060 ; joypad interrupt handler address
;******************************************************************************
; Boot-up register values
;******************************************************************************
; Register A = CPU type
def BOOTUP_A_DMG equ $01
def BOOTUP_A_CGB equ $11 ; CGB or AGB
def BOOTUP_A_MGB equ $FF
def BOOTUP_A_SGB equ BOOTUP_A_DMG
def BOOTUP_A_SGB2 equ BOOTUP_A_MGB
; Register B = CPU qualifier (if A is BOOTUP_A_CGB)
def B_BOOTUP_B_AGB equ 0
def BOOTUP_B_CGB equ 0 << B_BOOTUP_B_AGB
def BOOTUP_B_AGB equ 1 << B_BOOTUP_B_AGB
; Register C = CPU qualifier
def BOOTUP_C_DMG equ $13
def BOOTUP_C_SGB equ $14
def BOOTUP_C_CGB equ $00 ; CGB or AGB
; Register D = color qualifier
def BOOTUP_D_MONO equ $00 ; DMG, MGB, SGB, or CGB or AGB in DMG mode
def BOOTUP_D_COLOR equ $FF ; CGB or AGB
; Register E = CPU qualifier (distinguishes DMG variants)
def BOOTUP_E_DMG0 equ $C1
def BOOTUP_E_DMG equ $C8
def BOOTUP_E_SGB equ $00
def BOOTUP_E_CGB_DMGMODE equ $08 ; CGB or AGB in DMG mode
def BOOTUP_E_CGB equ $56 ; CGB or AGB
;******************************************************************************
; Aliases
;******************************************************************************
; Prefer the standard names to these aliases, which may be official but are
; less directly meaningful or human-readable.
def rP1 equ rJOYP
def rNR10 equ rAUD1SWEEP
def rNR11 equ rAUD1LEN
def rNR12 equ rAUD1ENV
def rNR13 equ rAUD1LOW
def rNR14 equ rAUD1HIGH
def rNR21 equ rAUD2LEN
def rNR22 equ rAUD2ENV
def rNR23 equ rAUD2LOW
def rNR24 equ rAUD2HIGH
def rNR30 equ rAUD3ENA
def rNR31 equ rAUD3LEN
def rNR32 equ rAUD3LEVEL
def rNR33 equ rAUD3LOW
def rNR34 equ rAUD3HIGH
def rNR41 equ rAUD4LEN
def rNR42 equ rAUD4ENV
def rNR43 equ rAUD4POLY
def rNR44 equ rAUD4GO
def rNR50 equ rAUDVOL
def rNR51 equ rAUDTERM
def rNR52 equ rAUDENA
def rKEY0 equ rSYS
def rKEY1 equ rSPD
def rHDMA1 equ rVDMA_SRC_HIGH
def rHDMA2 equ rVDMA_SRC_LOW
def rHDMA3 equ rVDMA_DEST_HIGH
def rHDMA4 equ rVDMA_DEST_LOW
def rHDMA5 equ rVDMA_LEN
def rBCPS equ rBGPI
def rBCPD equ rBGPD
def rOCPS equ rOBPI
def rOCPD equ rOBPD
def rSVBK equ rWBK
endc ; HARDWARE_INC
IF !DEF(TARGET_MEGADUCK)
INCLUDE "hardware.inc"
SECTION "HASCHAR", ROM0
init_serial::
xor a
ldh [hSerialKey], a
ldh [hInputMode], a
ldh [rSB], a
ld a, SC_START | SC_EXTERNAL
ldh [rSC], a
ret
; z - no key available; nz - haschar and char should be in a
haschar::
ldh a, [hKeyPressed] ; check on-screen keyboard buffer
or a
jr z, .check_serial ; no key? check serial
push af
xor a
ldh [hKeyPressed], a ; prepare on-screen keyboard buffer for next use
pop af
ret
.check_serial:
ldh a, [hSerialKey] ; check serial keyboard buffer
or a
jr z, .wait ; no key? check serial wait
push af
xor a
ldh [hSerialKey], a ; prepare serial keyboard buffer for next use
pop af
ret
.wait:
ldh a, [hInputMode] ; hInputMode indicates we are in input mode
or a
ret z ; not input mode? return
halt ; wait for timer or whatever IRQ we get
xor a
ret
SECTION "SERIAL_HANDLER", ROM0[INT_HANDLER_SERIAL]
push af
ldh a, [rSB]
ldh [hSerialKey], a
ld a, SC_START | SC_EXTERNAL ; reenable reading
ldh [rSC], a
pop af
reti
SECTION "HRAM_HASCHAR", HRAM
hSerialKey: db
ENDC
IF DEF(TARGET_MEGADUCK)
INCLUDE "hardware.inc"
INCLUDE "defs.inc"
INCLUDE "macros.inc"
SECTION "HASCHAR", ROM0
DEF DUCK_IO_CMD_INIT_START EQU 0x00
DEF DUCK_IO_CMD_GET_KEYS EQU 0x00
DEF DUCK_IO_CMD_DONE_OR_OK EQU 0x01
DEF DUCK_IO_CMD_ABORT_OR_FAIL EQU 0x04
DEF DUCK_IO_CMD_PRINT_INIT_EXT_IO EQU 0x09
DEF DUCK_IO_REPLY_BOOT_OK EQU 0x01
DEF DUCK_IO_KEY_FLAG_SHIFT EQU 0x04
DEF SERIAL_STATE_SIZE EQU 2
RSRESET
DEF SERIAL_STATE_IDLE RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_SEND RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_LEN RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_FLAGS RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_KEY RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_CHKSUM RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_OK RB SERIAL_STATE_SIZE
DEF SERIAL_STATE_READY RB SERIAL_STATE_SIZE
DEF NO_KEY EQU 0x00
DEF KEY_AUP EQU 0x00
DEF KEY_ADOWN EQU 0x00
DEF KEY_ARIGHT EQU 0x00
DEF KEY_ALEFT EQU 0x00
DEF KEY_HELP EQU '#'
DEF KEY_PRTSC EQU 0x00
; Use ascii values for these keys
DEF KEY_BKSPC EQU bs
DEF KEY_ENTER EQU cr
DEF KEY_ESCAPE EQU ctrlc
DEF KEY_DELETE EQU 0x00
io_write_sync:
ldh [rSB], a
ld a, SC_START | SC_INTERNAL
ldh [rSC], a
.write_wait:
ldh a, [rSC]
and a, SC_START
jr nz, .write_wait
ret
io_read_sync:
ld a, SC_START | SC_EXTERNAL
ldh [rSC], a
.read_wait:
ldh a, [rSC]
and a, SC_START
jr nz, .read_wait
ldh a, [rSB]
ret
init_serial::
ld a, $c3 ; jp
ldh [hSerialTrampoline], a
ld a, HIGH(serial_handlers)
ldh [hSerialStateHigh], a
xor a
ldh [hSerialTimer], a
ldh [hSerialState], a
ldh [rSB], a
ldh [rSC], a
ldh [hInputMode], a
ld b, a
ld de, init_duck_keyboard_init_write_error
.init_write: ; write 0-255
DELAY_US c, 122
ld a, b
call io_write_sync
inc b
jr nz, .init_write
call io_read_sync
cp a, DUCK_IO_REPLY_BOOT_OK ; this should be response
jr nz, .error
xor a ; DUCK_IO_CMD_INIT_START = 0
ld b, a ; we also need 0 in b for counter
ld de, init_duck_keyboard_init_read_error
DELAY_US c, 122
call io_write_sync
.init_read: ; read 255-0
dec b
call io_read_sync
cp a, b
jr nz, .error
or a
jr nz, .init_read ; not 0?, read again
DELAY_US c, 122
inc a ; a = 0 DUCK_IO_CMD_DONE_OR_OK = 1
call io_write_sync ; tell peripheral everything is ok
DELAY_US c, 122
ld a, DUCK_IO_CMD_PRINT_INIT_EXT_IO ; try init printer
call io_write_sync
call io_read_sync ; consume whatever printer returns
DELAY_US c, 122 ; to be on the safe side
ret
.error:
ld a, DUCK_IO_CMD_ABORT_OR_FAIL ; tell peripheral we are doomed
call io_write_sync
xor a
call printstr
ld a, LCDC_ON | LCDC_BLOCK01 | LCDC_BG_START | LCDC_BG_ON
ldh [rLCDC], a
.stop
halt
nop
jr .stop
init_duck_keyboard_init_write_error:
db "init write failed! stopped", 0
init_duck_keyboard_init_read_error:
db "init read failed! stopped", 0
duck_keyboard_read_error:
db "wrong length! stopped", 0
; z - no key available; nz - haschar and char should be in a
haschar::
ldh a, [hKeyPressed] ; check on-screen keyboard buffer
or a
jr z, .check_serial ; no key? check serial
push af
xor a
ldh [hKeyPressed], a ; prepare on-screen keyboard buffer for next use
pop af
ret
.check_serial:
ldh a, [hSerialState] ; check serial state
.state_readed:
or a ; is SERIAL_STATE_IDLE ?
jr z, .start_reading
cp a, SERIAL_STATE_READY
jr nz, .no_key
xor a ; SERIAL_STATE_IDLE
ldh [hSerialState], a ; zero next use
ld a, 2 ; wait N vblanks
ldh [hSerialTimer], a
ldh a, [hSerialKey] ; check serial key
or a
ret
.start_reading:
ldh a, [hSerialTimer]
or a
jr nz, .no_key
ld a, SERIAL_STATE_SEND ; next state
ldh [hSerialState], a
xor a ; DUCK_IO_CMD_GET_KEYS
ldh [rSB], a
ld a, SC_START | SC_INTERNAL ; write
ldh [rSC], a
.no_key
ldh a, [hInputMode] ; hInputMode indicates we are in input mode
or a
ret z ; not input mode? return
halt ; wait any IRQ to continue
xor a
ret
SECTION "SERIAL_HANDLER_LUT", ROM0, ALIGN[8]
serial_handlers:
jr serial_handler_return
jr serial_handler_send
jr serial_handler_len
jr serial_handler_flags
jr serial_handler_key
jr serial_handler_chksum
serial_handler_ok:
ld a, SERIAL_STATE_READY
jr serial_handler_return
serial_handler_send:
ld a, SERIAL_STATE_LEN
jr serial_handler_return
serial_handler_len:
ldh a, [rSB]
cp a, 4
jr nz, serial_error
ld a, SERIAL_STATE_FLAGS
jr serial_handler_return
serial_handler_flags:
ldh a, [rSB]
ldh [hSerialKeyFlag], a
and DUCK_IO_KEY_FLAG_SHIFT
jr z, .skip
ld a, $80
.skip:
ldh [hSerialKeyFlag], a
ld a, SERIAL_STATE_KEY
jr serial_handler_return
serial_handler_key:
ldh a, [rSB]
or a
jr z, .skip
ld h, HIGH(duck_keys_to_ascii)
ld l, a
ldh a, [hSerialKeyFlag]
add a, l
ld l, a
ld a, [hl]
.skip:
ldh [hSerialKey], a
ld a, SERIAL_STATE_CHKSUM
serial_handler_return:
ldh [hSerialState], a
ld a, SC_START | SC_EXTERNAL
ldh [rSC], a
pop hl
pop af
reti
serial_handler_chksum:
DELAY_US a, 122
pop hl
ld a, SERIAL_STATE_OK
ldh [hSerialState], a
ld a, DUCK_IO_CMD_DONE_OR_OK
ldh [rSB], a
ld a, SC_START | SC_INTERNAL
ldh [rSC], a
pop af
reti
serial_error:
ld de, duck_keyboard_read_error
call printstr
.error_loop:
halt
nop
jr .error_loop
SECTION "HRAM_HASCHAR", HRAM
hSerialKey: db
hSerialKeyFlag: db
hSerialTimer:: db
SECTION "HRAM_HASCHAR_TRAMPOLINE", HRAM
hSerialTrampoline: db ; Room for `jp`
hSerialState:: db ; low address
hSerialStateHigh: db ; high address
ALIGN 16, $FFFF
SECTION "SERIAL_HANDLER", ROM0[INT_HANDLER_SERIAL]
push af
push hl
jr hSerialTrampoline
SECTION "SERIAL_HANDLER_KEYS", ROM0, ALIGN[8]
duck_keys_to_ascii:
db NO_KEY ; 0x80
db NO_KEY ; 0x81
db NO_KEY ; 0x82
db NO_KEY ; 0x83
db NO_KEY ; 0x84
db '!' ; 0x85 Shift alt: !
db 'Q' ; 0x86 Shift alt: Q
db 'A' ; 0x87 Shift alt: A
db NO_KEY ; 0x88
db '"' ; 0x89 Shift alt: "
db 'W' ; 0x8A Shift alt: W
db 'S' ; 0x8B Shift alt: S
db NO_KEY ; 0x8C
db '#' ; 0x8D Shift alt: · (Spanish, mid-dot) | § (German, legal section)
db 'E' ; 0x8E Shift alt: E
db 'D' ; 0x8F Shift alt: D
db NO_KEY ; 0x90
db '$' ; 0x91 Shift alt: $
db 'R' ; 0x92
db 'F' ; 0x93
db NO_KEY ; 0x94
db '%' ; 0x95 Shift alt: %
db 'T' ; 0x96
db 'G' ; 0x97
db NO_KEY ; 0x98
db '&' ; 0x99 Shift alt: &
db 'Y' ; 0x9A
db 'H' ; 0x9B
db NO_KEY ; 0x9C
db '/' ; 0x9D Shift alt: /
db 'U' ; 0x9E
db 'J' ; 0x9F
db NO_KEY ; 0xA0
db '(' ; 0xA1 Shift alt: (
db 'I' ; 0xA2
db 'K' ; 0xA3
db NO_KEY ; 0xA4
db ')' ; 0xA5 Shift alt: )
db 'O' ; 0xA6
db 'L' ; 0xA7
db NO_KEY ; 0xA8
db '\\', ; 0xA9 Shift alt: "\"
db 'P' ; 0xAA
db NO_KEY ; 0xAB
db NO_KEY ; 0xAC
db '?' ; 0xAD Shift alt: ?
db '[' ; 0xAE Shift alt: [ (Spanish, only shift mode works) | German version: Ü
db NO_KEY ; 0xAF
db NO_KEY ; 0xB0
db NO_KEY ; 0xB1 Shift alt: ¿ (Spanish) | ` (German) ; German version: ' (single quote?)
db '*' ; 0xB2 Shift alt: * | German version: · (mid-dot)
db NO_KEY ; 0xB3 Shift alt: Feminine Ordinal [A over line] (Spanish) | ^ (German)
db NO_KEY ; 0xB4
db NO_KEY ; 0xB5
db NO_KEY ; 0xB6
db NO_KEY ; 0xB7
db 'Z' ; 0xB8 ; German version : 'Y'
db NO_KEY ; 0xB9
db NO_KEY ; 0xBA
db NO_KEY ; 0xBB
db 'X' ; 0xBC
db '>' ; 0xBD Shift alt: >
db NO_KEY ; 0xBE
db NO_KEY ; 0xBF
db 'C' ; 0xC0
db NO_KEY ; 0xC1
db NO_KEY ; 0xC2
db NO_KEY ; 0xC3
db 'V' ; 0xC4
db NO_KEY ; 0xC5
db NO_KEY ; 0xC6
db NO_KEY ; 0xC7
db 'B' ; 0xC8
db NO_KEY ; 0xC9
db NO_KEY ; 0xCA
db NO_KEY ; 0xCB
db 'N' ; 0xCC
db NO_KEY ; 0xCD
db NO_KEY ; 0xCE
db NO_KEY ; 0xCF
db 'M' ; 0xD0
db NO_KEY ; 0xD1
db NO_KEY ; 0xD2
db NO_KEY ; 0xD3
db ';' ; 0xD4 ; Shift alt: ;
db NO_KEY ; 0xD5
db NO_KEY ; 0xD6
db NO_KEY ; 0xD7
db ':' ; 0xD8 ; Shift alt: :
db NO_KEY ; 0xD9
db NO_KEY ; 0xDA
db NO_KEY ; 0xDB
db '_' ; 0xDC ; Shift alt: _ | German version: @
db NO_KEY ; 0xDD
db NO_KEY ; 0xDE
db NO_KEY ; 0xDF
db NO_KEY ; 0xE0
db NO_KEY ; 0xE1
db NO_KEY ; 0xE2
db NO_KEY ; 0xE3
db NO_KEY ; 0xE4
db NO_KEY ; 0xE5
db NO_KEY ; 0xE6
db NO_KEY ; 0xE7
db NO_KEY ; 0xE8
db NO_KEY ; 0xE9
db NO_KEY ; 0xEA
db NO_KEY ; 0xEB
db NO_KEY ; 0xEC
db NO_KEY ; 0xED
db NO_KEY ; 0xEE
db NO_KEY ; 0xEF
db NO_KEY ; 0xF0
db NO_KEY ; 0xF1
db NO_KEY ; 0xF2
db NO_KEY ; 0xF3
db NO_KEY ; 0xF4
db NO_KEY ; 0xF5
db NO_KEY ; 0xF6
db NO_KEY ; 0xF7
db NO_KEY ; 0xF8
db NO_KEY ; 0xF9
db NO_KEY ; 0xFA
db NO_KEY ; 0xFB
db NO_KEY ; 0xFC
db NO_KEY ; 0xFD
db NO_KEY ; 0xFE
db NO_KEY ; 0xFF
; == Start of actual scan code range (0x80 through 0xFF) ==
db $80 ; 0x80 SYS_KBD_CODE_F1
db KEY_ESCAPE, ; 0x81 SYS_KBD_CODE_ESCAPE
db KEY_HELP ; 0x82 SYS_KBD_CODE_HELP
db NO_KEY ; 0x83
db $81 ; 0x84 SYS_KBD_CODE_F2
db '1' ; 0x85 SYS_KBD_CODE_1
db 'q' ; 0x86 SYS_KBD_CODE_Q
db 'a' ; 0x87 SYS_KBD_CODE_A
db $82 ; 0x88 SYS_KBD_CODE_F3
db '2' ; 0x89 SYS_KBD_CODE_2
db 'w' ; 0x8A SYS_KBD_CODE_W
db 's' ; 0x8B SYS_KBD_CODE_S
db $83 ; 0x8C SYS_KBD_CODE_F4
db '3' ; 0x8D SYS_KBD_CODE_3
db 'e' ; 0x8E SYS_KBD_CODE_E
db 'd' ; 0x8F SYS_KBD_CODE_D
db $84 ; 0x90 SYS_KBD_CODE_F5
db '4' ; 0x91 SYS_KBD_CODE_4
db 'r' ; 0x92 SYS_KBD_CODE_R
db 'f' ; 0x93 SYS_KBD_CODE_F
db $85 ; 0x94 SYS_KBD_CODE_F6
db '5' ; 0x95 SYS_KBD_CODE_5
db 't' ; 0x96 SYS_KBD_CODE_T
db 'g' ; 0x97 SYS_KBD_CODE_G
db $86 ; 0x98 SYS_KBD_CODE_F7
db '6' ; 0x99 SYS_KBD_CODE_6
db 'y' ; 0x9A SYS_KBD_CODE_Y
db 'h' ; 0x9B SYS_KBD_CODE_H
db $87 ; 0x9C SYS_KBD_CODE_F8
db '7' ; 0x9D SYS_KBD_CODE_7
db 'u' ; 0x9E SYS_KBD_CODE_U
db 'j' ; 0x9F SYS_KBD_CODE_J
db $88 ; 0xA0 SYS_KBD_CODE_F9
db '8' ; 0xA1 SYS_KBD_CODE_8
db 'i' ; 0xA2 SYS_KBD_CODE_I
db 'k' ; 0xA3 SYS_KBD_CODE_K
db $89 ; 0xA4 SYS_KBD_CODE_F10
db '9' ; 0xA5 SYS_KBD_CODE_9
db 'o' ; 0xA6 SYS_KBD_CODE_O
db 'l' ; 0xA7 SYS_KBD_CODE_L
db NO_KEY ; 0xA8 SYS_KBD_CODE_F11
db '0' ; 0xA9 SYS_KBD_CODE_0
db 'p' ; 0xAA SYS_KBD_CODE_P
db NO_KEY ; 0xAB SYS_KBD_CODE_N_TILDE
db NO_KEY ; 0xAC SYS_KBD_CODE_F12
db '\'', ; 0xAD SYS_KBD_CODE_SINGLE_QUOTE
db '`' ; 0xAE SYS_KBD_CODE_BACKTICK
db NO_KEY ; 0xAF SYS_KBD_CODE_U_UMLAUT
db NO_KEY ; 0xB0
db NO_KEY ; 0xB1 SYS_KBD_CODE_EXCLAMATION_FLIPPED
db ']' ; 0xB2 SYS_KBD_CODE_RIGHT_SQ_BRACKET
db NO_KEY ; 0xB3 SYS_KBD_CODE_O_OVER_LINE Masculine Ordinal
db NO_KEY ; 0xB4
db KEY_BKSPC ; 0xB5 SYS_KBD_CODE_BACKSPACE
db KEY_ENTER ; 0xB6 SYS_KBD_CODE_ENTER
db NO_KEY ; 0xB7
db 'z' ; 0xB8 SYS_KBD_CODE_Z ; German version : 'y'
db ' ' ; 0xB9 SYS_KBD_CODE_SPACE
db NO_KEY ; 0xBA SYS_KBD_CODE_PIANO_DO_SHARP
db NO_KEY ; 0xBB SYS_KBD_CODE_PIANO_DO
db 'x' ; 0xBC SYS_KBD_CODE_X
db '<' ; 0xBD SYS_KBD_CODE_LESS_THAN
db NO_KEY ; 0xBE SYS_KBD_CODE_PIANO_RE_SHARP
db NO_KEY ; 0xBF SYS_KBD_CODE_PIANO_RE
db 'c' ; 0xC0 SYS_KBD_CODE_C
db NO_KEY ; 0xC1 SYS_KBD_CODE_PAGE_UP
db NO_KEY ; 0xC2
db NO_KEY ; 0xC3 SYS_KBD_CODE_PIANO_MI
db 'v' ; 0xC4 SYS_KBD_CODE_V
db NO_KEY ; 0xC5 SYS_KBD_CODE_PAGE_DOWN
db NO_KEY ; 0xC6 SYS_KBD_CODE_PIANO_FA_SHARP
db NO_KEY ; 0xC7 SYS_KBD_CODE_PIANO_FA
db 'b' ; 0xC8 SYS_KBD_CODE_B
db NO_KEY ; 0xC9 SYS_KBD_CODE_MEMORY_MINUS
db NO_KEY ; 0xCA SYS_KBD_CODE_PIANO_SOL_SHARP
db NO_KEY ; 0xCB SYS_KBD_CODE_PIANO_SOL
db 'n' ; 0xCC SYS_KBD_CODE_N
db NO_KEY ; 0xCD SYS_KBD_CODE_MEMORY_PLUS
db NO_KEY ; 0xCE SYS_KBD_CODE_PIANO_LA_SHARP
db NO_KEY ; 0xCF SYS_KBD_CODE_PIANO_LA
db 'm' ; 0xD0 SYS_KBD_CODE_M
db NO_KEY ; 0xD1 SYS_KBD_CODE_MEMORY_RECALL
db NO_KEY ; 0xD2
db NO_KEY ; 0xD3 SYS_KBD_CODE_PIANO_SI
db ',' ; 0xD4 SYS_KBD_CODE_COMMA
db NO_KEY ; 0xD5 SYS_KBD_CODE_SQUAREROOT
db NO_KEY ; 0xD6 SYS_KBD_CODE_PIANO_DO_2_SHARP
db NO_KEY ; 0xD7 SYS_KBD_CODE_PIANO_DO_2
db '.' ; 0xD8 SYS_KBD_CODE_PERIOD
db '*' ; 0xD9 SYS_KBD_CODE_MULTIPLY
db NO_KEY ; 0xDA SYS_KBD_CODE_PIANO_RE_2_SHARP
db NO_KEY ; 0xDB SYS_KBD_CODE_PIANO_RE_2
db '-' ; 0xDC SYS_KBD_CODE_DASH
db KEY_ADOWN ; 0xDD SYS_KBD_CODE_ARROW_DOWN ; TODO: Temporary
db KEY_PRTSC, ; 0xDE SYS_KBD_CODE_PRINTSCREEN_RIGHT ; TODO: Temporary
db NO_KEY ; 0xDF
db KEY_DELETE, ; 0xE0 SYS_KBD_CODE_DELETE
db '-' ; 0xE1 SYS_KBD_CODE_MINUS
db NO_KEY ; 0xE2 SYS_KBD_CODE_PIANO_FA_2_SHARP
db NO_KEY ; 0xE3 SYS_KBD_CODE_PIANO_FA_2
db '/' ; 0xE4 SYS_KBD_CODE_DIVIDE
db KEY_ALEFT ; 0xE5 SYS_KBD_CODE_ARROW_LEFT ; TODO: Temporary
db NO_KEY ; 0xE6 SYS_KBD_CODE_PIANO_SOL_2_SHARP
db NO_KEY ; 0xE7 SYS_KBD_CODE_PIANO_SOL_2
db KEY_AUP ; 0xE8 SYS_KBD_CODE_ARROW_UP ; TODO: Temporary
db '=' ; 0xE9 SYS_KBD_CODE_EQUALS
db NO_KEY ; 0xEA SYS_KBD_CODE_PIANO_LA_2_SHARP
db NO_KEY ; 0xEB SYS_KBD_CODE_PIANO_LA_2
db '+' ; 0xEC SYS_KBD_CODE_PLUS
db KEY_ARIGHT ; 0xED SYS_KBD_CODE_ARROW_RIGHT ; TODO: Temporary
db NO_KEY ; 0xEE
db NO_KEY ; 0xEF SYS_KBD_CODE_PIANO_MI_2
db 't' ; 0xF0 SYS_KBD_CODE_MAYBE_SYST_CODES_START
db NO_KEY ; 0xF1
db NO_KEY ; 0xF2
db NO_KEY ; 0xF3
db NO_KEY ; 0xF4
db NO_KEY ; 0xF5
db NO_KEY ; 0xF6 SYS_KBD_CODE_MAYBE_RX_NOT_A_KEY
db NO_KEY ; 0xF7
db NO_KEY ; 0xF8
db NO_KEY ; 0xF9
db NO_KEY ; 0xFA
db NO_KEY ; 0xFB
db NO_KEY ; 0xFC
db NO_KEY ; 0xFD
db NO_KEY ; 0xFE
db NO_KEY ; 0xFF
.end:
static_assert duck_keys_to_ascii.end - duck_keys_to_ascii == 256, \
STRFMT("duck_keys_to_ascii should be 256 (%d)!", duck_keys_to_ascii.end - duck_keys_to_ascii)
ENDC
if !def(MACROS_INC)
def MACROS_INC equ 1
INCLUDE "hardware.inc"
DEF CALLJP_ORG EQU $08
DEF TESTC_ORG EQU $10
DEF SKIPSPACE_ORG EQU $30
;call jp
MACRO call_jp
rst CALLJP_ORG
ENDM
;call testc
MACRO call_testc
rst TESTC_ORG
ENDM
;call skipspace
MACRO call_skipspace
rst SKIPSPACE_ORG
ENDM
MACRO WAIT_VRAM ; destroys a
.wait\@:
ldh a, [rSTAT]
and STAT_BUSY
jr nz, .wait\@
ENDM
MACRO EX_DE_HL ; destroys a
ld a, d
ld d, h
ld h, a
ld a, e
ld e, l
ld l, a
ENDM
MACRO LD_TO_HL ; destroys a
ldh a, [\1]
ld l, a
ldh a, [\1+1]
ld h, a
ENDM
MACRO ST_HL_TO ; destroys a
ld a, l
ldh [\1], a
ld a, h
ldh [\1+1], a
ENDM
MACRO LD_TO_DE ; destroys a
ldh a, [\1]
ld e, a
ldh a, [\1+1]
ld d, a
ENDM
MACRO ST_DE_TO ; destroys a
ld a, e
ldh [\1], a
ld a, d
ldh [\1+1], a
ENDM
; ex de,hl ex (sp),hl ex de,hl
MACRO EX_SP_DE ; destroys a
ld a, l
ldh [hTempR], a
ld a, h
pop hl
push de
ld d, h
ld e, l
ld h, a
ldh a, [hTempR]
ld l, a
ENDM
; ex (sp),hl
MACRO EX_SP_HL ; destroys a
ld a, l
ldh [hTempR], a
ld a, h
ldh [hTempR+1], a
ld hl, sp+0
ld a, [hl+]
ld h, [hl]
ld l, a
push hl
ld hl, sp+2
ldh a, [hTempR]
ld [hl+], a
ldh a, [hTempR+1]
ld [hl], a
pop hl
ENDM
; ex de, hl ex (sp), hl
; after all this z80's shenanigans (sp)=de, de=hl, hl=(sp)
MACRO EX_SP_IDER ; destroys a
ld a, l
ldh [hTempR], a
ld a, h
pop hl
push de
ld d, a
ldh a, [hTempR]
ld e, a
ENDM
; \1 - counter register
; \2 - time in uS
MACRO DELAY_US
DEF _DELAY_US_CYCLES = ((\2 * 1048576) / 1000000)
DEF _DELAY_US_ITERS = (_DELAY_US_CYCLES - 2) / 4
STATIC_ASSERT _DELAY_US_ITERS >= 1 && _DELAY_US_ITERS <= 255, "Wrong time"
ld \1, _DELAY_US_ITERS
.loop\@:
dec \1
jr nz, .loop\@
PURGE _DELAY_US_CYCLES, _DELAY_US_ITERS
ENDM
MACRO GBC_COLOR
dw ((\3) << 10) | ((\2) << 5) | (\1)
ENDM
endc ; MACROS_INC
INCLUDE "macros.inc"
INCLUDE "defs.inc"
SECTION "TASTYBASIC_RST1", ROM0[$0000]
di
ld a, $ff ; megaduck a == 255
jp entry_point
SECTION "CALL_HL", ROM0[CALLJP_ORG]
jp hl
SECTION "VBLANK_HANDLER", ROM0[INT_HANDLER_VBLANK]
jp vblank_handler
SECTION "HEADER", ROM0[$100]
di
jp entry_point
ds $150 - @, 0
SECTION FRAGMENT "ENTR_POINT", ROM0[$150]
entry_point::
IF !DEF(TARGET_MEGADUCK)
cp $11
jr nz, .is_dmg
sub $10
jr .gbc_check_end
ENDC
.is_dmg:
xor a
.gbc_check_end:
ldh [hIsGBC], a
ld sp, stack
call stop_lcd
ld hl, FontGraphics
ld de, $8000
ld bc, FontGraphics.end - FontGraphics
call memcpy
ld hl, SCREEN_ADDRESS_START
ld bc, $400
ld a, ' '
call memset
ldh a, [hIsGBC]
dec a
IF !DEF(TARGET_MEGADUCK)
call z, set_gbc_palette
ENDC
ld a, LOW(SCREEN_ADDRESS_START)
ld [hCursorPtr], a
ld a, HIGH(SCREEN_ADDRESS_START)
ld [hCursorPtr + 1], a
ld a, 22
ldh [hKeybdChar], a
ld a, 33
ldh [hKeybdPos], a
ld a, %11_10_01_00
ldh [rBGP], a
xor a
ldh [rSCY], a
ldh [hLine], a
ldh [hCurKeys], a
ldh [hNewKeys], a
ldh [hKeyPressed], a
ldh [hKeybdState], a
ldh [rTAC], a
ldh [rTMA], a
ldh [hFlags], a
ldh [hVBlankTimer], a
ldh [hOldChar], a
ldh [hOldCursorPtr], a
ldh [hOldCursorPtr+1], a
call init_serial
xor a
ldh [rIF], a
ld a, IE_VBLANK | IE_SERIAL
ldh [rIE], a
ld a, LCDC_ON | LCDC_BLOCK01 | LCDC_BG_START | LCDC_BG_ON
ldh [rLCDC], a
ei
jp start
vblank_handler:
push af
push hl
IF DEF(TARGET_MEGADUCK)
ldh a, [hSerialTimer]
sub a, 1
adc a, 0
ldh [hSerialTimer], a
IF DEF(DEBUG)
ldh a, [hSerialState] ; debug
srl a
add a, '0'
ld hl, $9c13
ld [hl], a
ENDC
ENDC
ldh a, [hFlags]
or a, FLAGS_VBLANK_OCCURRED
ldh [hFlags], a
ld hl, hVBlankTimer
inc [hl]
ldh a, [hInputMode] ; hInputMode indicates we are in input mode
or a
jr nz, .cursor ; not input mode?
call readpad
ldh a, [hNewKeys]
bit B_JOYP_SELECT, a ; SELECT ...
jr z, .fast_end
ld a, $03 ; ... ctrl+c
ld [hKeyPressed], a
ldh a, [hOldCursorPtr + 1]
or a
jr z, .fast_end
ld h, a
ldh a, [hOldCursorPtr]
ld l, a
ldh a, [hOldChar]
ld [hl], a
xor a
ldh [hOldCursorPtr + 1], a
.fast_end:
pop hl
pop af
reti
.cursor
call keystate
ld hl, hVBlankTimer
ld a, [hl]
and %00001111
jr nz, .end
bit 4, [hl]
jr z, .cursorOn
.cursorOff:
ldh a, [hOldCursorPtr + 1]
or a
jr z, .end
ld h, a
ldh a, [hOldCursorPtr]
ld l, a
ldh a, [hOldChar]
ld [hl], a
xor a
ldh [hOldCursorPtr + 1], a
jr .end
.cursorOn:
ldh a, [hCursorPtr]
ld l, a
ldh [hOldCursorPtr], a
ldh a, [hCursorPtr + 1]
ld h, a
ldh [hOldCursorPtr + 1], a
ld a, [hl]
ld [hOldChar], a
ldh a, [hKeybdState]
or a
jr nz, .keyboard_char ; CURSOR_TILE = 0
.set_char:
ld [hl], a
.end:
pop hl
pop af
reti
.keyboard_char
ldh a, [hKeybdChar]
jr .set_char
keystate:
call readpad
ldh a, [hNewKeys]
bit B_JOYP_SELECT, a ; SELECT ...
jr z, .enter
ld a, $03 ; ... ctrl+c
jr .ret
.enter:
bit B_JOYP_A, a ; BUTTON A ...
jr z, .backspace
ldh a, [hKeybdState]
or a
jr z, .enter_enter
ldh a, [hKeybdChar] ; ... selected char or ...
jr .ret
.enter_enter
ld a, $0d ; ... enter
jr .ret
.backspace:
bit B_JOYP_B, a ; BUTTON B ...
jr z, .keyboard
ld a, $08 ; ... backspace
.ret
ld [hKeyPressed], a
ret
.keyboard:
bit B_JOYP_START, a ; START ...
jr z, .dpad
ldh a, [hKeybdState]
cpl
ldh [hKeybdState], a
or a
jr nz, .keyboard_enable ; ... enable/disable keyboard
ld a, 22
ldh [hKeybdChar], a
ret
.keyboard_enable:
ldh a, [hKeybdPos]
add a, 32
ldh [hKeybdChar], a
ret
.dpad: ; dpad move in virtual keyboard if keyboard is enabled
swap a
ld h, a
ldh a, [hKeybdState]
or a
ret z
ld a, h
bit B_JOYP_RIGHT, a
jr z, .dpad_left
ld l, $10
jr .save_left_right
.dpad_left:
bit B_JOYP_LEFT, a
jr z, .dpad_up
ld l, -$10
jr .save_left_right
.save_left_right:
ldh a, [hKeybdPos]
add a, l
and $3f
ldh [hKeybdPos], a
add a, 32
ldh [hKeybdChar], a
ret
.dpad_up:
bit B_JOYP_UP, a
jr z, .dpad_down
ld l, -1
jr .save_up_down
.dpad_down:
bit B_JOYP_DOWN, a
ret z
ld l, 1
.save_up_down:
ldh a, [hKeybdPos]
add a, l
and $0f
ld l, a
ldh a, [hKeybdPos]
and $f0
or l
ldh [hKeybdPos], a
add a, 32
ldh [hKeybdChar], a
ret
memcpy:: ; hl-source, de-dest, bc-length
inc b
inc c
dec c
jr z, .dec_b
.loop
ld a, [hl+]
ld [de], a
inc de
dec c
jr nz, .loop
.dec_b
dec b
jr nz, .loop
ret
memset:: ; hl-dest, a-value, bc-length
inc b
inc c
dec c
jr z, .dec_b
.loop
ld [hl+], a
dec c
jr nz, .loop
.dec_b
dec b
jr nz, .loop
ret
wait_vblank:: ; destroys a
ldh a, [hFlags]
and a, ~FLAGS_VBLANK_OCCURRED
ldh [hFlags], a
.loop:
halt
ldh a, [hFlags]
and a, FLAGS_VBLANK_OCCURRED
jr z, .loop
ret
stop_lcd:
ld a, [rLCDC]
bit B_LCDC_ENABLE, a
ret z
.wait_vblank:
ld a, [rLY]
cp 144
jr c, .wait_vblank
ld a, [rLCDC]
res B_LCDC_ENABLE, a
ld [rLCDC], a
ret
IF !DEF(TARGET_MEGADUCK)
set_gbc_palette:
ld a, BGPI_AUTOINC
ldh [rBGPI], a
ld hl, gbc_palette
ld c, 8
.palette_loop:
ld a, [hl+]
ldh [rBGPD], a
dec c
jr nz, .palette_loop
ret
gbc_palette:
GBC_COLOR 1, 6, 16
GBC_COLOR 0, 0, 0
GBC_COLOR 0, 0, 0
GBC_COLOR 12, 23, 28
ENDC
SECTION "HRAM_MAIN", HRAM
hVBlankTimer:: db
hFlags: db ; in defs.inc
hKeyPressed:: db
hKeybdState: db
hKeybdChar: db
hKeybdPos: db
hInputMode:: db
hOldChar:: db
hOldCursorPtr:: dw
INCLUDE "hardware.inc"
SECTION "PAD", ROM0
readpad::
ld a, JOYP_GET_BUTTONS
call .onenibble
ld h, a
ld a, JOYP_GET_CTRL_PAD
call .onenibble
swap a
xor a, h
ld h, a
ld a, JOYP_GET_NONE
ldh [rJOYP], a
ldh a, [hCurKeys]
xor a, h
and a, h
ldh [hNewKeys], a
ld a, h
ldh [hCurKeys], a
ret
.onenibble:
ldh [rJOYP], a
call .knownret
ldh a, [rJOYP]
ldh a, [rJOYP]
ldh a, [rJOYP]
or a, $F0
.knownret:
ret
pad::
ld h, 0
ldh a, [hCurKeys]
ld l, a
ret
SECTION "HRAM_PAD", HRAM
hNewKeys:: db
hCurKeys:: db
INCLUDE "macros.inc"
INCLUDE "defs.inc"
def SPACE_TILE equ ' '
SECTION "PUTCHAR_IO_TABLE", ROM0, ALIGN[8]
io_jump_table:
dw putchar.ignore ; 00 - NULL
dw putchar.ignore ; 01 - SOH
dw putchar.ignore ; 02 - STX
dw putchar.ignore ; 03 - ETX
dw putchar.ignore ; 04 - EOT
dw putchar.ignore ; 05 - ENQ
dw putchar.ignore ; 06 - ACK
dw putchar.ignore ; 07 - BELL
dw putchar.handle_bs ; 08 - BACKSPACE
dw putchar.ignore ; 09 - TAB
dw putchar.handle_lf ; 0A - LINE FEED
dw putchar.ignore ; 0B - VT
dw putchar.handle_clear ; 0C - CLS / FORM FEED
dw putchar.handle_cr ; 0D - CARRIAGE RETURN
dw putchar.ignore ; 0E - SO
dw putchar.ignore ; 0F - SI
dw putchar.ignore ; 10 - DLE
dw putchar.ignore ; 11 - DC1 (XON)
dw putchar.ignore ; 12 - DC2
dw putchar.ignore ; 13 - DC3 (XOFF)
dw putchar.ignore ; 14 - DC4
dw putchar.ignore ; 15 - NAK
dw putchar.ignore ; 16 - SYN
dw putchar.ignore ; 17 - ETB
dw putchar.ignore ; 18 - CAN
dw putchar.ignore ; 19 - EM
dw putchar.ignore ; 1A - SUB
dw putchar.ignore ; 1B - ESCAPE
dw putchar.ignore ; 1C - FS
dw putchar.ignore ; 1D - GS
dw putchar.ignore ; 1E - RS
dw putchar.ignore ; 1F - US
SECTION "PUTCHAR", ROM0
putchar::
push af
push hl
push bc
di
ld c, a
ldh a, [hOldCursorPtr + 1]
or a
jr z, .skip
ld h, a
ldh a, [hOldCursorPtr]
ld l, a
ldh a, [hOldChar]
ld b, a
WAIT_VRAM
ld a, b
ld [hl], a
xor a
ldh [hOldCursorPtr + 1], a
.skip:
ld a, c
cp ' ' ; first printable
jr nc, .print_char ; print_char: a - char to print
add a, a
ld l, a
ld h, HIGH(io_jump_table) ; functions in jump table must save de if used
ld a, [hl+]
ld h, [hl]
ld l, a
jp hl
.handle_cr:
ldh a, [hCursorPtr]
and %11100000
ld l, a
ldh a, [hCursorPtr + 1]
ld h, a
.save_cursor:
ld a, l
ldh [hCursorPtr], a
ld a, h
ldh [hCursorPtr + 1], a
.ignore:
.exit:
ei
pop bc
pop hl
pop af
ret
.print_char
ld b, a
ldh a, [hCursorPtr]
ld l, a
ldh a, [hCursorPtr + 1]
ld h, a
WAIT_VRAM
ld a, b
ld [hl+], a
ld a, l ; check if in column 20 - end of the screen
and %00011111
cp 20
jr nz, .save_cursor ; no? then just save cursor position
ld a, l
add 12
.guard_wrap_screen:
ld l, a
jr nc, .is_scroll_needed
inc h
ld a, h
cp HIGH(SCREEN_ADDRESS_END)
jr c, .is_scroll_needed
ld h, HIGH(SCREEN_ADDRESS_START)
.is_scroll_needed:
ldh a, [hLine]
add 8
ldh [hLine], a
ld b, a
ldh a, [rSCY]
ld c, a
ld a, b
sub c
cp (18*8) ; scroll only if we are at line 17
jr c, .save_cursor ; no need to scroll
.clear_line:
push hl
ld a, l
and %11100000
ld l, a
ld b, 4
.clear_line_loop:
WAIT_VRAM
ld a, SPACE_TILE
ld [hl+], a
ld [hl+], a
ld [hl+], a
ld [hl+], a
ld [hl+], a
dec b
jr nz, .clear_line_loop
pop hl
ldh a, [rSCY]
add 8
ldh [rSCY], a
jr .save_cursor
.handle_lf:
ldh a, [hCursorPtr + 1]
ld h, a
ldh a, [hCursorPtr]
and %11100000
add 32
jr .guard_wrap_screen
.handle_bs:
ldh a, [hCursorPtr]
ld l, a
ldh a, [hCursorPtr + 1]
ld h, a
WAIT_VRAM
ld a, SPACE_TILE ; clear cursor
ld [hl], a
ld a, l
and %00011111 ; check if same line
jr z, .handle_bs_different_line
dec l ; if the same decrement l
ld a, SPACE_TILE ; clear cursor
ld [hl], a
jp .save_cursor
.handle_bs_different_line:
ldh a, [hLine]
sub 8
ldh [hLine], a
dec hl
ld a, h
cp HIGH(SCREEN_ADDRESS_START)
jr nc, .handle_bs_no_warp
ld h, HIGH(SCREEN_ADDRESS_END) - 1 ; we cross screen memory boundry
.handle_bs_no_warp:
ld a, l
sub a, 12
ld l, a
jp .save_cursor
.handle_clear:
ld hl, SCREEN_ADDRESS_START
ld b, 18
push de
ld de, 12
.handle_clear_clear_line:
REPT 4
WAIT_VRAM
ld a, SPACE_TILE
ld [hl+], a
ld [hl+], a
ld [hl+], a
ld [hl+], a
ld [hl+], a
ENDR
add hl, de
dec b
jr nz, .handle_clear_clear_line
xor a
ldh [hLine], a
ldh [rSCY], a
pop de
ld hl, SCREEN_ADDRESS_START
jp .save_cursor
; h - y, l - x
set_position::
ldh a, [rSCY]
ld c, a
ld a, h
add a, a
add a, a
add a, a
add a, c
ld [hLine], a
ldh a, [rSCY]
and $f8
ld b, a
ld a, h
add a, a
add a, a
add a, a
add a, b
ld h, 0
rl h
add a, a
rl h
add a, a
rl h
add a, l
ldh [hCursorPtr], a
ld a, h
adc a, 0
or $9c
ldh [hCursorPtr+1], a
ret
SECTION "HRAM_PUTCHAR", HRAM
hCursorPtr:: dw
hLine:: db
INCLUDE "macros.inc"
INCLUDE "defs.inc"
SECTION "SOUND", ROM0
sound::
.channel:
call expr
inc h
dec h
jp nz, qhow
ld a, l
cp 5
jp nc, qhow
ld b, a
call_testc
db ','
db .err1-@-1
.volume:
push bc ; expr may destroy bc
call expr
pop bc ; restore bc
inc h
dec h
jp nz, qhow
ld a, l
cp 16
jp nc, qhow
swap a
ld c, a
call_testc
db ','
db .err1-@-1
.freq:
push bc ; expr may destroy bc
call expr ; we don't need bc until .combine
ld a, h
and %11111000
jp nz, qhow
push hl ; push freq
call_testc
db ','
db .err1-@-1
.sweep:
call expr
bit 7, h
jr nz, .fade_in
ld a, l
cp 8
jp nc, qhow
jr .combine
.fade_in:
ld a, l
cpl
inc a
and AUD1HIGH_PERIOD_HIGH
set 3, a
.combine:
pop hl ; pop freq
pop bc ; pop channel and volume
or c
dec b
jr z, .ch1
dec b
jr z, .ch2
jp qhow
.ch1:
if def(TARGET_MEGADUCK)
swap a
endc
ldh [rAUD1ENV], a
ld a, l
ldh [rAUD1LOW], a
ld a, h
or AUD1HIGH_RESTART
ldh [rAUD1HIGH], a
call finish
.ch2:
if def(TARGET_MEGADUCK)
swap a
endc
ldh [rAUD2ENV], a
ld a, l
ldh [rAUD2LOW], a
ld a, h
or AUD2HIGH_RESTART
ldh [rAUD2HIGH], a
call finish
.err1: ; note: qwhat resets stack so we don't care about it
jp qwhat ; the only caveat is de must point command buffer
volume::
call expr
inc h
dec h
jp nz, qhow
ld a, l
cp 8
jp nc, qhow
or a
jr z, .mute
.set_volume:
ld c, a
ld a, $80
ldh [rAUDENA], a
ld a, $bf
ldh [rAUD1LEN], a
ld a, $bf
ldh [rAUD2LEN], a
ld a, c
swap a
or c
ldh [rAUDVOL], a
ld a, $FF
ldh [rAUDTERM], a
call finish
.mute:
xor a
ldh [rAUDVOL], a
ldh [rAUDTERM], a
ldh [rAUDENA], a
call finish
; -----------------------------------------------------------------------------
; Copyright 2018 Dimitri Theulings
;
; This file is part of Tasty Basic.
;
; Tasty Basic is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; Tasty Basic is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with Tasty Basic. If not, see <https://www.gnu.org/licenses/>.
; -----------------------------------------------------------------------------
; Tasty Basic is derived from earlier works by Li-Chen Wang, Peter Rauskolb,
; and Doug Gabbard. Refer to the source code repository for details
; <https://github.com/dimitrit/tastybasic/>.
; -----------------------------------------------------------------------------
; GameBoy port Selvin
; -----------------------------------------------------------------------------
INCLUDE "macros.inc"
INCLUDE "defs.inc"
SECTION "TASTYBASIC_RST2", ROM0[TESTC_ORG]
testc:
;ex (sp), hl ; ** TestC **
;we don't need old hl 'til next ex (sp), hl so just store it in hram
ST_HL_TO hTempR
pop hl
;
call_skipspace ; ignore spaces
cp [hl] ; test character
inc hl ; compare the byte that follows the
jr z,.tc1 ; call instruction with the text pointer
push bc
ld c, [hl] ; if not equal, ad the second byte
ld b, 0 ; that follows the call to the old pc
add hl, bc
pop bc
dec de
.tc1
inc de ; if equal, skip those bytes
inc hl ; and continue
;ex (sp), hl
push hl
LD_TO_HL hTempR
ret
SECTION "TASTYBASIC_RST3", ROM0[SKIPSPACE_ORG]
skipspace:
ld a, [de] ; ** SkipSpace **
cp ' ' ; ignore spaces
ret nz ; in text (where de points)
inc de ; and return the first non-blank
jr skipspace ; character in A
SECTION "TASTYBASIC", ROM0
start::
ld sp, (stack + 1) ; ** Cold Start **
if !def(TARGET_MEGADUCK)
call initfilesystem
endc
ld a, $ff
jp init
expr::
call expr2 ; ** Expr **
push hl ; evaluate expression
jp expr1
comp:
ld a, h ; ** Compare **
cp d ; compare hl with de
ret nz ; return c and z flags
ld a, l ; old a is lost
cp e
ret
finish::
pop af ; ** Finish **
call fin ; check end of command
jp qwhat
;*************************************************************
;
; ** REM ** IF ** INPUT ** & LET (& DEFLT) ** DATA ** READ **
;
; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
;
; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
; EXECUTION CONTINUES AT THE NEXT LINE.
;
; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
;
; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
; THIS IS HANDLED IN 'INPERR'.
;
; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
; THIS IS DONE BY 'DEFLT'.
;
; 'DATA' ALLOWS CONSTANT VALUES TO BE STORED IN CODE. TREATED
; AS A REMARK ('REM') WHEN PROGRAM IS EXECUTED.
;
; 'READ' ASSIGNS THE NEXT AVAILABLE DATA VALUE TO A VARIABLE.
;*************************************************************
rem:
data:
ld hl, 0 ; ** Rem ** Data **
jr if1 ; this is like 'IF 0'
iff:
call expr ; ** If **
if1:
ld a,h ; is the expr = 0?
or l
jp nz, runsml ; no, continue
call findskip ; yes, skip rest of line
jp nc, runtsl ; and run the next line
jp rstart ; if no, restart
inputerror:
;ld hl, [stkinp] ; ** InputError **
LD_TO_HL stkinp
ld sp, hl ; restore old sp and old current
pop hl
;ld [current], hl
ST_HL_TO current
pop de ; and old text pointer
pop de ; redo current
input:
push de ; ** Input **
call qtstg ; is next item a string?
;jp ip2 ; no
jr ip2
call testvar ; yes and followed by a variable?
jr c, ip4 ; no
jr ip3 ; yes, input variable
ip2:
push de ; save for printstr
call testvar ; must be variable
jp c, qwhat ; no, what?
ld a, [de] ; prepare for printstr
ld c, a
sub a
ld [de], a
pop de
call printstr ; print string as prompt
ld a, c ; restore text
dec de
ld [de], a
ip3:
push de ; save text pointer
;ex de,hl
ld d, h ; selvin: no need we destroy hl right after
ld e, l ; this is enough
;ld hl, (current) ; also save current
LD_TO_HL current
push hl
ld hl, input
;ld (current), hl
ST_HL_TO current
ld hl, 0
add hl, sp
;ld (stkinp), hl
ST_HL_TO stkinp
push de
ld a, 1
ldh [hInputMode], a
ld a, ':'
call getline
xor a
ldh [hInputMode], a
ld de, buffer
call expr
; nop
; nop
; nop
pop de
;ex de,hl
EX_DE_HL
ld [hl], e
inc hl
ld [hl], d
pop hl
;ld (current),hl
ST_HL_TO current
pop de
ip4:
pop af ; purge stack
call_testc ; is next character ','?
db ','
db ip5-@-1
jr input ; yes, more items
ip5:
call finish
deflt:
ld a, [de] ; ** DEFLT **
cp cr ; empty line is fine
jr z, lt1 ; else it's 'LET'
let:
call setval ; ** Let **
call_testc ; set value to var
db ','
db lt1-@-1
jr let ; item by item
lt1:
call finish
restore:
call rstreadptr
call finish
rstreadptr:
ld hl,0
;ld (readptr),hl
ST_HL_TO readptr
ret
read:
push de ; ** Read **
;ld hl,(readptr) ; has read pointer been initialised?
LD_TO_HL readptr
ld a,h
or a
jr nz, rd2 ; yes, find next data value
call findline ; no, find first line
jr nc, rd1 ; found first line
pop de ; nothing found, so how?
jp qhow
rd1:
call finddata
jr rd4
rd2:
;ex de,hl
EX_DE_HL
call_skipspace ; skip over spaces
call_testc ; have we hit a comma?
db ','
db rd3-@-1
jr rd5
rd3:
call nextdata
rd4:
jr z, rd5 ; found a data statement
pop de
jp qhow ; nothing found, so how to read?
rd5:
;ld (readptr),de ; update read pointer
ST_DE_TO readptr
pop de
call testvar
jp c,qwhat ; no variable
push hl ; save address of variable
push de ; and text pointer
;ld de,(readptr) ; point to next data value
LD_TO_DE readptr
call parsenum ; parse the constant
jr nc, rd6
pop de ; spmething bad happened when
jp qhow ; parsing the number
rd6:
;ld (readptr),de ; update read pointer
ST_DE_TO readptr
pop de ; and restore text pointer
ld b, h ; move value to bc
ld c, l
pop hl ; get address of variable
ld [hl], c ; assign value
inc hl
ld [hl], b
call_testc ; do we have more variables?
db ','
db rd7-@-1
jr read ; yes, read next
rd7:
call finish ; all done
finddata:
inc de ; skip over line no.
inc de
call_skipspace
ld hl, datastmt
ld b, 4
fd1:
ld a, [de]
cp [hl]
jr nz,nextdata ; not what we're looking for
dec b ; are we done comparing
jr z, fd2 ; yes
inc de
inc hl
jr fd1
fd2:
inc de ; first char past statement
ret ; nc,z:found; nc,nz:no
nextdata:
ld hl, 0
call findskip ; find the next line
jr nc, finddata ; and try there
or 1 ; no more lines
ret ; nc,nz: not found!
;*************************************************************
;
; *** PEEK *** POKE *** IN *** & OUT ***
;
; 'PEEK(<EXPR>)' RETURNS THE VALUE OF THE BYTE AT THE GIVEN
; ADDRESS.
; 'POKE <expr1>,<expr2>' SETS BYTE AT ADDRESS <expr1> TO
; VALUE <expr2>
; 'IN(<EXPR)' READS THE GIVEN PORT.
; 'OUT <expr1>,<expr2>' WRITES VALUE <expr2> TO PORT <expr1>.
;
;*************************************************************
peek:
call parn ; ** Peek(expr) **
;ld a, h ; expression must be positive
;or a
;jp m, qhow
; positive address is good ... but what if we wana address whole 64kb?
; bit 7, h
; jp nz, qhow
; uncomment above to not allow negative numbers
ld a, [hl] ; peek address
ld h, 0
ld l, a
ret
; no inp on GB
; inp:
; call parn ; ** In(expr) **
; ld a, 0 ; is port > 255?
; cp h
; jp nz, qhow ; yes, so not a valid port
; ld c, l
; in l, (c) ; read port
; ld h, 0
; ret
poke:
call expr ; ** Poke **
;ld a, h ; address must be positive
;or a
;jp m, qhow
; positive address is good ... but what if we wana address whole 64kb?
; bit 7, h
; jp nz, qhow
; uncomment above to not allow negative numbers
push hl
call_testc ; is next char a comma?
db ','
db ot1-@-1 ; what, no?
call expr ; get value to store
xor a ; is it > 255?
cp h
jr z, pk1 ; no, all good
pop hl
jp qhow
pk1:
ld a, l ; save value
pop hl
ld [hl], a
call finish
; no outp on GB
; outp:
; call expr ; ** Out **
; ld a, 0 ; is port > 255?
; cp h
; jp nz, qhow ; yes, so not a valid port
; push hl
; call testc ; is next char a comma?
; db ','
; db ot1-@-1 ; what, no?
; call expr ; get value to write
; ld a, 0 ; is it > 255?
; cp h
; jp z, ot2 ; no, all good
; pop hl
; jp qhow
; ot2:
; ld a, l ; output value
; pop hl
; ld c, l
; out (c), a
; call finish
ot1:
pop hl
jp qwhat
usrexec:
call parn ; ** Usr(expr) **
push de
;ex de,hl
ld d, h ; selvin: no need we destroy hl right after
ld e, l ; this is enough
ld hl, ue1
push hl
;ld ix,(usrptr)
;jp (ix)
LD_TO_HL usrptr
jp hl
ue1:
;ex de,hl
ld h, d ; selvin: no need we destroy de right after
ld l, e ; this is enough
pop de
ret
;*************************************************************
;
; *** EXPR ***
;
; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
; <EXPR>::<EXPR2>
; <EXPR2><REL.OP.><EXPR2>
; WHERE <REL.OP.> IS ONE OF THE OPERATORS IN TAB8 AND THE
; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
; <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
; <EXPR3>::=<EXPR4>(* OR /><EXPR4>)(....)
; <EXPR4>::=<VARIABLE>
; <FUNCTION>
; (<EXPR>)
; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
; AS INDEX, FUNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
; <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
;*************************************************************
expr1:
ld hl, tab8-1 ; look up rel.op
jp exec ; go do it
xp11:
call xp18 ; rel.op.'>='
ret c ; no, return hl=0
ld l, a ; yes, return hl=1
ret
xp12:
call xp18 ; rel.op.'#' selvin: it's '<>'
ret z ; no, return hl=0
ld l, a ; yes, return hl=1
ret
xp13:
call xp18 ; rel.op.'>'
ret z ; no
ret c ; also, no
ld l, a ; yes, return hl=1
ret
xp14:
call xp18 ; rel.op.'<='
ld l, a ; set hl=1
ret z ; yes, return hl=1
ret c
ld l, h ; else set hl=0
ret
xp15:
call xp18 ; rel.op.'='
ret nz ; no, return hl=0
ld l, a ; else hl=1
ret
xp16:
call xp18 ; rel.op.'<'
ret nc ; no, return hl=0
ld l, a ; else hl=1
ret
xp17:
pop hl ; not rel.op
ret ; return hl=<expr2>
xp18:
ld a, c ; routine for all rel.ops
pop hl
pop bc
push hl
push bc ; reverse top of stack
ld c, a
call expr2 ; get second <expr2>
;ex de, hl ; value now in de
;ex (sp), hl ; first <expr2> in hl
EX_SP_IDER
call ckhlde ; compare them
pop de ; restore text pointer
ld hl, 0 ; set hl=0, a=1
ld a, 1
ret
expr2:
call_testc ; is it minus sign?
db '-'
db xp21-@-1
ld hl, 0 ; yes, fake 0 -
jr xp26 ; treat like subtract
xp21:
call_testc ; is it plus sign?
db '+'
db xp22-@-1
xp22:
call expr3 ; first <expr3>
xp23:
call_testc ; addition?
db '+'
db xp25-@-1
push hl ; yes, save value
call expr3 ; get second <expr3>
xp24:
;ex de, hl ; 2nd in de
;ex (sp), hl ; 1st in hl
EX_SP_IDER
ld a, h ; compare sign
xor d
ld a, d
add hl, de
pop de ; restore text pointer
;jp m, xp23 ; first and second sign differ
bit 7, h
jr nz, xp23
xor h ; first and second sign are equal
;jp p, xp23 ; so is the result
bit 7, h
jr z, xp23
jp qhow ; else we have overflow
xp25:
call_testc ; subtract?
db '-'
db xp42-@-1
xp26:
push hl ; yes, save first <expr3>
call expr3 ; get second <expr3>
call changesign ; negate
jr xp24 ; and add them
expr3:
call expr4 ; get first expr4
xp31:
call_testc ; multiply?
db '*'
db xp34-@-1
push hl ; yes, save first and get second
call expr4 ; <expr4>
ld b, 0 ; clear b for sign
call checksign
;ex (sp),hl ; first in hl
;fock ... you cannot do it better :(
EX_SP_HL
call checksign ; check sign of first
;ex de,hl
;ex (sp),hl
EX_SP_IDER
ld a, h ; is hl > 255?
or a
jr z, xp32 ; no
ld a, d ; yes, what about de
or d
;ex de,hl
EX_DE_HL
jp nz, ahow
xp32:
ld a, l
ld hl, 0
or a
jr z, xp35
xp33:
add hl, de
jp c, ahow
dec a
jr nz, xp33
jr xp35
xp34:
call_testc ; divide
db '/'
db xp42-@-1
push hl ; yes, save first <expr4>
call expr4 ; and get the second one
ld b, 0 ; clear b for sign
call checksign ; check sign of the second
;ex (sp),hl ; get the first in hl
EX_SP_HL
call checksign ; check sign of first
;ex de,hl
;ex (sp),hl
;ex de,hl
;final result (sp)=de de=(sp) hl=hl
;lets call it EX_SP_DE
EX_SP_DE
ld a, d ; divide by 0?
or e
jp z, ahow ; err...how?
push bc ; else save sign
call divide
ld h, b
ld l, c
pop bc ; retrieve sign
xp35:
pop de ; and text pointer
;ld a, h ; hl must be positive
;or a
;jp m, qhow ; else it's overflow
bit 7, h
jp nz, qhow
;ld a, b
;or a
;call m, changesign ; change sign if needed
bit 7, b
call nz, changesign
jp xp31 ; look for more terms
expr4:
ld hl, tab4-1 ; find function in tab4
jp exec ; and execute it
xp40:
call testvar
jr c, xp41 ; nor a variable
ld a, [hl+]
;inc hl
ld h, [hl] ; value in hl
ld l, a
ret
xp41:
call testnum ; or is it a number
ld a, b ; number of digits
or a
ret nz ; ok
parn:
call_testc
db '('
db xp43-@-1
call expr ; "(expr)"
call_testc
db ')'
db xp43-@-1
xp42:
ret
xp43:
jp qwhat ; what?
rnd:
call parn ; ** Rnd(expr) **
ld a, h ; expression must be positive
;or a
;jp m, qhow
bit 7, a
jp nz, qhow
or l ; and non-zero
jp z, qhow
push de ; save de and hl
push hl
;ld hl, (rndptr) ; get memory as random number
LD_TO_HL rndptr
ld de, LST_ROM
call comp
jr c, ra1 ; wrap around if last
ld hl, start
ra1:
ld e, [hl]
inc hl
ld d, [hl]
;ld (rndptr),hl
ST_HL_TO rndptr
pop hl
;ex de,hl
EX_DE_HL
push bc
call divide ; rnd(n)=mod(m,n)+1
pop bc
pop de
inc hl
ret
abs:
call parn ; ** Abs (expr) **
dec de
call checksign
inc de
ret
size:
;ld hl,(textunfilled) ; ** Size **
;push de ; get the number of free bytes between
;ex de,hl ; and varbegin
push de
LD_TO_DE textunfilled
ld hl, varbegin
call subde
pop de
ret
clrvars:
;ld hl,(textunfilled) ; ** ClearVars**
;push de ; get the number of bytes available
;ex de,hl ; for variable storge
push de
LD_TO_DE textunfilled
ld hl, varend
call subde
ld b, h ; and save in bc
ld c, l
; ld hl, (textunfilled) ; clear the first byte
; ld d, h
; ld e, l
; inc de
; ld [hl], 0
; ldir ; and repeat for all the others
LD_TO_HL textunfilled
xor a
call memset
pop de
ret
;*************************************************************
;
; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
;
; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
;
; 'SUBDE' SUBSTRACTS DE FROM HL
;
; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
; SIGN AND FLIP SIGN OF B.
;
; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
;
; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
;*************************************************************
divide:
push hl ; ** Divide **
ld l, h ; divide h by de
ld h, 0
call dv1
ld b, c ; save result in b
ld a, l ; (remainder + l) / de
pop hl
ld h, a
dv1:
ld c, $ff ; result in c
dv2:
inc c ; dumb routine
call subde ; divide using subtract and count
jr nc, dv2
add hl, de
ret
subde:
ld a, l ; ** subde **
sub e ; subtract de from hl
ld l, a
ld a, h
sbc a, d
ld h, a
ret
checksign:
; ld a,h ; ** CheckSign **
; or a ; check sign of hl
; ret p
bit 7, h
ret z
changesign:
ld a,h ; ** ChangeSign **
or l ; check if hl is zero
jr nz, cs1 ; no, try to change sign
ret ; yes, return
cs1:
ld a, h ; change sign of hl
push af
cpl
ld h, a
ld a, l
cpl
ld l, a
inc hl
pop af
xor h
; jp p, qhow
bit 7, a
jp z, qhow
ld a, b ; and also flip b
xor $80
ld b, a
ret
ckhlde:
ld a, h ; same sign?
xor d ; yes, compare
;jp p,ck1 ; no, exchange and compare
bit 7, a
jr z, ck1
;ex de,hl
EX_DE_HL
ck1:
call comp
ret
;*************************************************************
;
; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
;
; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
; TO THAT VALUE.
;
; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ":",
; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
; NEXT LINE AND CONTINUE FROM THERE.
;
; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
;
; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
; NOT TERMINATED BUT CONTINUED AT 'INPERR'.
;
; RELATED TO 'ERROR' ARE THE FOLLOWING:
; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
;*************************************************************
setval:
call testvar ; ** SetVal **
jp c, qwhat ; no variable
push hl ; save address of var
call_testc ; do we have =?
db '='
db sv1-@-1
call expr ; evaluate expression
ld b, h ; value is in bc now
ld c, l
pop hl ; get address
ld [hl], c ; save value
inc hl
ld [hl], b
ret
sv1:
jr qwhat
fin:
call_testc ; test for ':'
db ':'
db fi1-@-1
pop af ; yes, purge return address
jp runsml ; continue on same line
fi1:
call_testc ; not ':', is it cr
db cr
db fi2-@-1
pop af ; yes, purge return address
jp runnxl ; run next line
fi2:
ret ; else return to caller
endchk::
call skipspace ; ** EndChk **
cp cr ; ends with cr?
ret z ; ok, otherwise say 'what?'
qwhat::
push de ; ** QWhat **
awhat:
ld de, what ; ** AWhat **
handleerror:
sub a ; ** Error **
call printstr ; print error message
pop de
ld a, [de] ; save the character
push af ; at where old de points
sub a ; and put a 0 (zero) there
ld [de],a
;ld hl,(current) ; get the current line number
LD_TO_HL current
push hl
ld a, [hl+] ; check the value
;inc hl
or [hl]
pop de
jp z, rstart ; if zero, just rerstart
; ld a, [hl] ; if negative
; or a
; jp m, inputerror ; then redo input
bit 7, [hl]
jp nz, inputerror
call printline ; else print the line
dec de ; up to where the 0 is
pop af ; restore the character
ld [de], a
ld a, '?' ; print a ?
call outc
sub a ; and the rest of the line
call printstr
jp rstart
qsorry:
push de ; ** Sorry **
asorry:
ld de, sorry
jr handleerror
;*************************************************************
;
; *** GETLN *** FNDLN (& FRIENDS) ***
;
; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
;
; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
; LINE, FLAGS ARE C & NZ.
; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
;*************************************************************
getline:
call outc ; ** GetLine **
ld de, buffer ; prompt and initalise pointer
gl1:
call chkio ; check keyboard
jr z, gl1 ; no input, so wait
cp $80
jr nc, gl5
cp bs ; erase last character?
jr z, gl3 ; yes
call outc ; echo character
cp lf ; ignore lf
jr z, gl1
cp cls ; selvin: ignore cls
jr z, gl1
or a ; ignore null
jr z, gl1
cp ctrlu ; erase the whole line?
jr z, gl4 ; yes
ld [de], a ; save the input
inc de ; and increment pointer
cp cr ; was it cr?
ret z ; yes, end of line
ld a, e ; any free space left?
cp bufend & $ff
jr nz, gl1 ; yes, get next char
gl3:
ld a, e ; delete last character
cp buffer & $ff ; if there are any?
jr z, gl1 ; no, redo whole line - selvin's change: no, get next char
dec de ; yes, back pointer
ld a, bs ; and echo a backspace
call outc
jr gl1 ; and get next character
gl4:
call crlf ; redo entire line
ld a, '>'
jr getline
gl5:
push de
sub $80
ld h, HIGH(basic_code)
add a, a
ld l, a
ld a, [hl+]
ld c, a
ld a, [hl+]
ld b, a
ld a, [hl+]
ld e, a
ld a, [hl+]
ld d, a
ld l, c
ld h, b
ld a, e
sub l
ld c, a
ld a, d
sbc a, h
ld b, a
pop de
or c
jr z, gl1
ld de, textbegin
call memcpy
ST_DE_TO textunfilled
call crlf
call rstreadptr
xor a
ldh [hInputMode], a
ld de, textbegin
jp runnxl
findline:
; ld a, h ; ** FindLine **
; or a ; check the sign of hl
; jp m, qhow ; it cannot be negative
bit 7, h
jp nz, qhow
ld de, textbegin ; initialise the text pointer
findlineptr:
fl1:
push hl ; save line number
;ld hl,(textunfilled) ; check if we passed end
LD_TO_HL textunfilled
dec hl
call comp
pop hl ; retrieve line number
ret c ; c,nz passed end
ld a, [de] ; we didn't; get first byte
sub l ; is this the line?
ld b, a ; compare low order
inc de
ld a, [de] ; get second byte
sbc a, h ; compare high order
jr c, fl2 ; no, not there yet
dec de ; else we either found it
or b ; or it's not there
ret ; nc,z:found; nc,nz:no
findnext:
inc de ; find next line
fl2:
inc de ; just passed first and second byte
findskip:
ld a, [de] ; ** FindSkip **
cp cr ; try to find cr
jr nz, fl2 ; keep looking
inc de ; found cr, skip over
jr fl1 ; check if end of text
;*************************************************************
;
; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
;
; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
;
; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
; OVER (USUALLY A JUMP INSTRUCTION.
;
; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
;
; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
;*************************************************************
printstr::
ld b, a
ps1:
ld a, [de] ; get a character
inc de ; bump pointer
cp b ; same as old A?
ret z ; yes, return
call outc ; no, show character
cp cr ; was it a cr?
jr nz, ps1 ; no, next character
ret ; yes, returns
qtstg:
call_testc ; ** Qtstg **
db $22 ; is it a double quote
db qt3-@-1
ld a, $22
qt1:
call printstr ; print until another
cp cr
pop hl
jp z, runnxl
qt2:
inc hl ; skip 3 bytes on return
inc hl
;inc hl ; selvin: 2 bytes since jr not jp
jp hl ; return
qt3:
call_testc ; is it a single quote
db $27
db qt4-@-1
ld a, $27
jr qt1
qt4:
call_testc ; is it back-arrow
db '_'
db qt5-@-1
ld a, $8d ; yes, cr without lf
call outc
call outc
pop hl ; return address
jr qt2
qt5:
ret ; none of the above
printnum::
ld b, 0 ; ** PrintNum **
call checksign ; check sign
;jp p,pn1 ; no sign
jr z, pn1
ld b, '-'
dec c
pn1:
push de ; save
ld de, $000a ; decimal
push de ; save as flag
dec c ; c=spaces
push bc ; save sign & space
pn2:
call divide ; divide hl by 10
ld a, b ; result 0?
or c
jr z, pn3 ; yes, we got all
;ex (sp),hl ; no, save remainder
EX_SP_HL
dec l ; and count space
push hl ; hl is old bc
ld h, b ; moved result to bc
ld l, c
jr pn2 ; and divide by 10
pn3:
pop bc ; we got all digits
pn4:
dec c
; ld a, c ; look at space count
; or a
; jp m, pn5 ; no leading spaces
bit 7, c
jr nz, pn5
ld a, ' ' ; print a leading space
call outc
jr pn4 ; any more?
pn5:
ld a, b ; print sign
or a
call nz, outc
ld e, l ; last remainder in e
pn6:
ld a, e ; check digit in e
cp lf ; lf is flag for no more
pop de
ret z ; if yes, return
add a, $30 ; else convert to ascii
call outc ; and print the digit
jr pn6 ; next digit
printhex:
ld c,h ; ** PrintHex **
call ph1 ; first hex byte
printhex8::
ld c, l ; then second
ph1:
ld a, c ; get left nibble into position
; rra
; rra
; rra
; rra
swap a
call ph2 ; and turn into hex digit
ld a, c ; then convert right nibble
ph2:
and $0f ; mask right nibble
add a, $90 ; and convert to ascii character
daa
adc a, $40
daa
call outc ; print character
ret
printline:
ld a, [de] ; ** PrintLine **
ld l, a ; low order line number
inc de
ld a, [de] ; high order
ld h, a
inc de
ld c, $0 ; print 4 digit line number
call printnum
ld a, ' ' ; followed by a space
call outc
sub a ; and the the rest
call printstr
ret
;*************************************************************
;
; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
;
; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
; DE = HL
;
; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
; UNTIL DE = BC
;
; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
; STACK
;
; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
; STACK
;*************************************************************
mvup:
call comp ; ** mvup **
ret z ; de = hl, return
ld a, [de] ; get one byte
ld [bc], a ; then copy it
inc de ; increase both pointers
inc bc
jr mvup ; until done
mvdown:
ld a, b ; ** mvdown **
sub d ; check if de = bc
jr nz, md1 ; no, go move
ld a, c ; maybe, other byte
sub e
ret z ; yes, return
md1:
dec de ; else move a byte
dec hl ; but first decrease both pointers
ld a, [de] ; and then do it
ld [hl], a
jr mvdown ; loop back
popa:
pop bc ; bc = return address
pop hl ; restore loopvar
;ld (loopvar),hl
ST_HL_TO loopvar
ld a, h
or l
jr z, pp1 ; all done, so return
pop hl
;ld (loopinc),hl
ST_HL_TO loopinc
pop hl
;ld (looplmt),hl
ST_HL_TO looplmt
pop hl
;ld (loopln),hl
ST_HL_TO loopln
pop hl
;ld (loopptr),hl
ST_HL_TO loopptr
pp1:
push bc ; bc = return address
ret
pusha:
ld hl, stacklimit ; ** PushA **
call changesign
pop bc ; bc = return address
add hl, sp ; is stack near the top?
jp nc, qsorry ; yes, sorry
;ld hl,(loopvar) ; else save loop variables
LD_TO_HL loopvar
ld a, h
or l
jr z, pu1 ; only when loopvar not 0
;ld hl,(loopptr)
LD_TO_HL loopptr
push hl
;ld hl,(loopln)
LD_TO_HL loopln
push hl
;ld hl,(looplmt)
LD_TO_HL looplmt
push hl
;ld hl,(loopinc)
LD_TO_HL loopinc
push hl
;ld hl,(loopvar)
LD_TO_HL loopvar
pu1:
push hl
push bc ; bc = return address
ret
testvar:
call_skipspace ; ** testvar **
sub '@' ; test variables
ret c ; not a variable
jr nz, tv1 ; not @ array
inc de ; is is the @ array
call parn ; @ should be followed by (expr)
add hl, hl ; as its index
jr c, qhow ; is index too big?
push de ; will it override text?
;ex de,hl
EX_DE_HL
call size ; find the size of free
call comp
jp c, asorry ; yes, sorry
ld hl, varbegin ; no, get address of @(expr) and
call subde ; put it in hl
pop de
ret
tv1:
cp $1b ; not @, is it A to Z
ccf
ret c
inc de ; if A through Z
ld hl, varbegin ; calculate address of that variable
rlca ; and return it in hl
add a, l ; with the c flag cleared
ld l, a
ld a, 0
adc a, h
ld h, a
ret
testnum::
call parsenum ; ** TestNum **
ret nc ; if not a number, return nc and 0 in b and hl
jr qhow ; carry set, so overflowed
parsenum:
ld hl, 0 ; try to parse text as a number
ld b, h ; if not a number, return 0 in b and hl
call_skipspace
cp '$' ; selvin: '$'?
jr z, tn1hex ; then hex
tn1:
cp '0'
jr nc, tn2
ccf ; reset carry
ret
tn2:
cp ':' ; if a digit, convert to binary in
ret nc ; b and hl
ld a, $f0 ; set b to number of digits
and h ; if h>255, there is no room for
jr z, tn3 ; next digit, so set carry
scf
ret
tn3:
inc b ; b counts number of digits
push bc
ld b, h ; hl=10*hl+(new digit)
ld c, l
add hl, hl ; where 10* is done by shift and add
add hl, hl
add hl, bc
add hl, hl
ld a, [de] ; and (digit) is by stripping the
inc de ; ascii code
and $0f
add a, l
ld l, a
ld a, 0
adc a, h
ld h, a
pop bc
ld a, [de]
;jp p, tn1
bit 7, a
jr z, tn1
scf
ret
qhow::
push de ; ** Error How? **
ahow:
ld de,how
jp handleerror
tn1hex:
inc de ; skip '$'
ld b, 5 ; set limit
tn2hex:
ld a, [de]
sub '0'
jr c, tn4hex
cp 10
jr c, tn3hex
cp ('A' - '0')
jr c, tn4hex
sub ('A' - '9' - 1)
cp 16
jr nc, tn4hex
tn3hex:
inc de
dec b
jr z, tn5hex
add hl, hl
add hl, hl
add hl, hl
add hl, hl
add a, l
ld l, a
jr tn2hex
tn4hex:
ld a, 5
sub b
ld b, a
and a
ret
tn5hex:
scf
ret
welcome:
db PLATFORM, " ", "TASTY BASIC (", VERSION, ")", cr
free:
db " BYTES FREE", cr
how:
db "HOW?", cr
ok:
db "OK", cr
what:
db "WHAT?", cr
sorry:
db "SORRY", cr
;*************************************************************
;
; *** MAIN ***
;
; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
; AND STORES IT IN THE MEMORY.
;
; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
;
; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
;
; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
;
; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
;*************************************************************
rstart::
ld sp, stack
st1:
call crlf
sub a ; a=0
ld de, ok ; print ok
call printstr
ld hl, st2 + 1 ; literal zero
;ld (current),hl ; reset current line pointer
ST_HL_TO current
st2:
ld hl, 0
;ld (loopvar),hl
ST_HL_TO loopvar
;ld (stkgos),hl
ST_HL_TO stkgos
st3:
ld a, 1
ldh [hInputMode], a
ld a, '>' ; initialise prompt
call getline
xor a
ldh [hInputMode], a
push de ; de points to end of line
ld de, buffer ; point de to beginning of line
call testnum ; check if it is a number
call_skipspace
ld a, h ; hl = value of the number, or
or l ; 0 if no number was found
pop bc ; bc points to end of line
jp z, direct
dec de ; back up de and save the value of
ld a, h ; the value of the line number there
ld [de], a
dec de
ld a, l
ld [de], a
push bc ; bc,de point to begin,end
push de
ld a, c
sub e
push af ; a = number of bytes in line
call findline ; find this line in save area
push de ; de points to save area
jr nz, st4 ; nz: line not found
push de ; z: found, delete it
call findnext ; find next line
; de -> next line
pop bc ; bc -> line to be deleted
;ld hl,(textunfilled) ; hl -> unfilled text area
LD_TO_HL textunfilled
call mvup ; move up to delete
ld h, b ; txtunf -> unfilled area
ld l, c
;ld (textunfilled),hl
ST_HL_TO textunfilled
st4:
pop bc ; get ready to insert
;ld hl,(textunfilled) ; but first check if the length
LD_TO_HL textunfilled
pop af ; of new line is 3 (line# and cr)
push hl
cp 3 ; if so, do not insert
jr z, rstart ; must clear the stack
add a, l ; calculate new txtunf
ld l, a
ld a, 0
adc a, h
ld h, a ; hl -> new unfilled area
ld de, textend ; check to see if there is space
call comp
jp nc, qsorry ; no, sorry
;ld (textunfilled),hl ; ok, update textunfilled
ST_HL_TO textunfilled
pop de ; de -> old unfilled area
call mvdown
pop de ; de,hl -> begin,end
pop hl
call mvup ; copy new line to save area
jr st3
;*************************************************************
;
; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
;
; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
; GO BACK TO 'RSTART'.
; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
;*************************************************************
;
; *** NEW *** CLEAR *** STOP *** RUN (& FRIENDS) *** GOTO ***
;
; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
;
; 'CLEAR(CR)' CLEARS ALL VARIABLES
;
; 'END(CR)' GOES BACK TO 'RSTART'
;
; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
;
; THERE ARE 3 MORE ENTRIES IN 'RUN':
; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
;
; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
;*************************************************************
new:
call endchk ; ** New **
ld hl, textbegin
;ld (textunfilled),hl
ST_HL_TO textunfilled
clear:
call clrvars ; ** Clear **
jp rstart
endd:
call endchk ; ** End **
jp rstart
run:
call endchk ; ** Run **
call rstreadptr
ld de, textbegin
runnxl:
ld hl, 0 ; ** Run Next Line **
call findlineptr
jp c, rstart
runtsl:
; ex de,hl ; ** Run Tsl
; ld (current),hl ; set current -> line #
; ex de,hl
ST_DE_TO current
inc de
inc de
runsml:
call chkio ; ** Run Same Line **
ld hl, tab2-1 ; find the command in table 2
jp exec ; and execute it
goto:
call expr
push de ; save for error routine
call endchk ; must find a cr
call findline ; find the target line
jp nz, ahow ; no such line #
pop af ; clear the pushed de
jr runtsl ; go do it
;*************************************************************
;
; *** LIST *** & PRINT ***
;
; LIST HAS TWO FORMS:
; 'LIST(CR)' LISTS ALL SAVED LINES
; 'LIST #(CR)' START LIST AT THIS LINE #
; YOU CAN STOP THE LISTING BY CONTROL C KEY
;
; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
;
; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
; SPECIFIED, 6 POSITIONS WILL BE USED.
;
; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
; DOUBLE QUOTES.
;
; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
;
; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
;*************************************************************
list:
call testnum ; check if there is a number
call endchk ; if no number we get a 0
call findline ; find this or next line
ls1:
jp c, rstart
call printline ; print the line
call chkio ; stop on ctrl-c
call findlineptr ; find the next line
jr ls1 ; and loop back
_print:
ld c, 6 ; c = number of spaces
call_testc ; is it a semicolon?
db ';'
db pr2-@-1
call crlf
jr runsml
pr2:
call_testc ; is it a cr?
db cr
db pr0-@-1
call crlf
jr runnxl
pr0:
call_testc ; is it format?
db '#'
db pr10-@-1
call expr
ld c, l
jr pr3
pr10:
call_testc ; is it position?
db '\{'
db pr1-@-1
call expr
xor a
cp h
jp nz, qhow
ld a, l
cp 20
jp nc, qhow
call_testc ; do we have a comma?
db ','
db pr11-@-1
push hl
call expr
xor a
cp h
jp nz, qhow
ld a, l
cp 18
pop hl
jp nc, qhow
ld h, a
call_testc
db '\}'
db pr11-@-1
call set_position
jr pr3
pr1:
call_testc ; is it a dollar? selvin: changed to underscore
db '_'
db pr4-@-1
call expr
ld c, l
call_testc ; do we have a comma?
db ','
db pr6-@-1
push bc
call expr
pop bc
ld a, 8 ; 8 bits?
cp c
jr nz, pr9 ; no, try 16
call printhex8 ; yes, print a single hex byte
jr pr3
pr9:
ld a, $10 ; 16 bits?
cp c
jp nz, qhow ; no, show error message
call printhex ; yes, print two hex bytes
jr pr3
pr4:
call qtstg ; is it a string?
;jp pr8
jr pr8
pr3:
call_testc ; is it a comma?
db ','
db pr6-@-1
call fin
jr pr0
pr6:
call crlf ; list ends
call finish
pr8:
call expr ; evaluate the expression
push bc
call printnum
pop bc
jr pr3
pr11:
pop hl
jp qwhat
;*************************************************************
;
; *** GOSUB *** & RETURN ***
;
; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
;
; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
;*************************************************************
gosub:
call pusha ; ** Gosub **
call expr ; save the current "FOR" params
push de ; and text pointer
call findline ; find the target line
jp nz, ahow ; how? because it doesn't exist
;ld hl,(current) ; found it, save old 'current'
LD_TO_HL current
push hl
;ld hl,(stkgos) ; and 'stkgos'
LD_TO_HL stkgos
push hl
ld hl, 0 ; and load new ones
;ld (loopvar),hl
ST_HL_TO loopvar
add hl, sp
;ld (stkgos),hl
ST_HL_TO stkgos
jp runtsl ; and run the line
return:
call endchk ; there must be a cr
;ld hl,(stkgos) ; check old stack pointer
LD_TO_HL stkgos
ld a, h
or l
jp z, what ; what? not found
ld sp, hl ; otherwise restore it
pop hl
;ld (stkgos), hl
ST_HL_TO stkgos
pop hl
;ld (current), hl ; and old 'current'
ST_HL_TO current
pop de ; and old text pointer
call popa ; and old 'FOR' params
call finish ; and we're back
;*************************************************************
;
; *** FOR *** & NEXT ***
;
; 'FOR' HAS TWO FORMS:
; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
; EXP3=1. (I.E., WITH A STEP OF +1.)
; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
; BEFORE THE NEW ONE OVERWRITES IT.
; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
; (PURGED FROM THE STACK..)
;
; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
; IS PURGED AND EXECUTION CONTINUES.
;*************************************************************
_for:
call pusha ; save old save area
call setval ; set the control variable
dec hl ; its address is hl
;ld (loopvar),hl ; save that
ST_HL_TO loopvar
ld hl, tab5-1 ; use 'exec' to find 'TO'
jp exec
fr1:
call expr ; evaluate the limit
;ld (looplmt),hl ; and save it
ST_HL_TO looplmt
ld hl, tab6-1 ; use 'exec' to find 'STEP'
jp exec
fr2:
call expr ; found 'STEP'
jr fr4
fr3:
ld hl, $0001 ; no 'STEP' so set to 1
fr4:
;ld (loopinc),hl ; and save that too
ST_HL_TO loopinc
fr5:
;ld hl,(current) ; save current line number
LD_TO_HL current
;ld (loopln),hl
ST_HL_TO loopln
;ex de,hl ; and text pointer
;ld (loopptr),hl
ST_DE_TO loopptr
ld bc, $0a ; dig into stack to find loopvar
;ld hl,(loopvar)
LD_TO_DE loopvar
;ex de,hl
ld h, b
ld l, b
add hl, sp
db $3e ; + add hl,bc = ld a, 9
fr7:
add hl, bc
ld a, [hl+]
;inc hl
or [hl]
jr z, fr8
ld a, [hl-]
;dec hl
cp d
jr nz, fr7
ld a, [hl]
cp e
jr nz, fr7
;ex de,hl
ld d, h ; selvin: no need we destroy hl right after
ld e, l ; this is enough
ld hl, 0
add hl, sp
ld b, h
ld c, l
ld hl, $0a
add hl, de
call mvdown
ld sp, hl
fr8:
;ld hl,(loopptr) ; all done
LD_TO_HL loopptr
;ex de,hl
EX_DE_HL
call finish
next:
call testvar ; get address of variable
jp c, qwhat ; what, no variable
;ld (varnext),hl ; yes, save it
ST_HL_TO varnext
nx0:
push de ; save the text pointer
;ex de,hl
ld d, h ; selvin: no need we destroy hl right after
ld e, l ; this is enough
;ld hl,(loopvar) ; get the variable in 'FOR'
LD_TO_HL loopvar
ld a, h
or l ; if 0, there never was one
jp z, awhat
call comp ; else check them
jr z, nx3 ; yes, they agree
pop de ; no, complete current loop
call popa
;ld hl,(varnext) ; and pop one level
LD_TO_HL varnext
jr nx0 ; go check again
nx3:
ld e, [hl]
inc hl
ld d, [hl] ; de = value of variable
;ld hl,(loopinc)
LD_TO_HL loopinc
push hl
ld a, h
xor d
ld a, d
add hl, de
bit 7, h
jr nz, nx4
xor h
bit 7, h
jr nz, nx5
nx4:
;ex de,hl
ld d, h ; selvin: no need we destroy hl right after
ld e, l ; this is enough
;ld hl,(loopvar)
LD_TO_HL loopvar
ld [hl], e
inc hl
ld [hl], d
;ld hl,(looplmt)
LD_TO_HL looplmt
pop af
or a
;jp p,nx1 ; step > 0
bit 7, a
jr z, nx1
;ex de,hl ; step < 0
EX_DE_HL
nx1:
call ckhlde ; compare with limit
pop de ; restore the text pointer
jr c, nx2 ; over the limit
;ld hl,(loopln) ; within the limit
LD_TO_HL loopln
;ld (current),hl
ST_HL_TO current
;ld hl,(loopptr)
LD_TO_HL loopptr
;ex de,hl
EX_DE_HL
call finish
nx5:
pop hl
pop de
nx2:
call popa ; purge this loop
call finish
init::
ld hl, start ; initialise random pointer
;ld (rndptr),hl
ST_HL_TO rndptr
ld hl, usrfunc ; initialise usr func pointer
;ld (usrptr),hl
ST_HL_TO usrptr
ld a, $c9 ; initialise usr func (RET)
ld [usrfunc], a
ld hl, textbegin ; initialise text area pointers
;ld (textunfilled),hl
ST_HL_TO textunfilled
ld [ocsw], a ; enable output control switch
call clrvars ; clear variables
;call crlf
ld de, welcome ; output welcome message
call printstr
;call crlf
call size ; output free size message
call printnum
ld de, free
call printstr
jp rstart
chkio::
call haschar ; check if character available
ret z ; no, return
;#ifndef CPM selvin: haschar now works as in CPM
; call getchar ; get the character
;#endif
;push bc ; is it a lf?
;ld b, a
;sub lf
cp lf
jr z, io1 ; yes, ignore a return
;ld a, b ; no, restore a and bc
;pop bc
cp ctrlo ; is it ctrl-o?
jr nz, io2 ; no, done
ld a, [ocsw] ; toggle output control switch
cpl
ld [ocsw], a
jr chkio ; get next character
io1:
;ld a, 0 ; clear
;or a ; set the z-flag
xor a
;pop bc ; restore bc
ret ; return with z set
io2:
cp 'a'-1 ; is it lower case?
jr c, io3 ; no
cp 'z'+1 ; selvin: but wait, there is more
jr nc, io3 ; no
and $df ; yes, make upper case
io3:
cp ctrlc ; is it ctrl-c?
ret nz ; no
jp rstart ; yes, restart tasty basic
crlf:
ld a, cr
outc::
push af
ld a, [ocsw] ; check output control switch
or a
jr nz, oc1 ; output is enabled
pop af ; output is disabled
ret ; so return
oc1:
pop af
call putchar
cp cr ; was it a cr?
ret nz ; no, return
ld a, lf ; send a lf
call outc
ld a, cr ; restore register
ret ; and return
;*************************************************************
;
; *** TABLES *** DIRECT *** & EXEC ***
;
; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
; OF CODE ACCORDING TO THE TABLE.
;
; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
; ALL DIRECT AND STATEMENT COMMANDS.
;
; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
;
; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
; BYTE SET TO 1.
;
; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
; MATCH THIS NULL ITEM AS DEFAULT.
;*************************************************************
MACRO dwa
db ( (\1) >> 8 ) + $80
db ( (\1) & $FF )
ENDM
tab1: ; direct commands
db "LIST"
dwa list
db "RUN"
dwa run
db "NEW"
dwa new
db "CLEAR"
dwa clear
; #ifdef PLATFORM
; .db "BYE"
; dwa(bye)
; #endif
tab2: ; direct/statements
db "NEXT"
dwa next
db "LET"
dwa let
db "IF"
dwa iff
db "GOTO"
dwa goto
db "GOSUB"
dwa gosub
db "RETURN"
dwa return
db "REM"
dwa rem
db "FOR"
dwa _for
db "INPUT"
dwa input
db "WAIT"
dwa wait
db "PRINT"
dwa _print
db "POKE"
dwa poke
db "SOUND"
dwa sound
db "SPEED"
dwa speed
db "VOLUME"
dwa volume
db "CLS"
dwa _cls
;db "OUT"
;dwa outp
; #ifdef CPM
IF !DEF(TARGET_MEGADUCK)
db "DEL"
dwa del
db "DIR"
dwa dir
db "LOAD"
dwa _load
db "SAVE"
dwa save
ENDC
; #endif
datastmt:
db "DATA"
dwa data
db "READ"
dwa read
db "RESTORE"
dwa restore
db "END"
dwa endd
dwa deflt
tab4: ; functions
db "PAD"
dwa pad
db "PEEK"
dwa peek
;db "IN"
;dwa inp
db "RND"
dwa rnd
db "ABS"
dwa abs
db "USR"
dwa usrexec
db "SIZE"
dwa size
dwa xp40
tab5: ; 'TO' in 'FOR'
db "TO"
dwa fr1
tab6: ; 'STEP' in 'FOR'
db "STEP"
dwa fr2
dwa fr3
tab8: ; relational operators
db ">="
dwa xp11
;db "#"
db "<>" ; selvin changed from #
dwa xp12
db ">"
dwa xp13
db "="
dwa xp15
db "<="
dwa xp14
db "<"
dwa xp16
dwa xp17
direct:
ld hl,tab1-1 ; ** Direct **
exec:
call_skipspace ; ** Exec **
push de
ex1:
ld a, [de]
inc de
cp '.'
jr z, ex3
inc hl
cp [hl]
jr z, ex1
ld a, $7f
dec de
cp [hl]
jr c, ex5
ex2:
inc hl
cp [hl]
jr nc, ex2
inc hl
pop de
jr exec
ex3:
ld a, $7f
ex4:
inc hl
cp [hl]
jr nc, ex4
ex5:
ld a, [hl+]
;inc hl
ld l, [hl]
and $7f
ld h, a
pop af
jp hl
;-------------------------------------------------------------------------------
LST_ROM: ; all the above _can_ be in rom
; ; all following *must* be in ram
; padding .equ (TBC_LOC + USRPTR_OFFSET - $)
; .echo "TASTYBASIC ROM padding: "
; .echo padding
; .echo " bytes.\n"
; .org TBC_LOC + USRPTR_OFFSET
; usrptr .ds 2 ; -> user defined function area
; usrfunc .equ $ ; start of user defined function area
; .org TBC_LOC + INTERNAL_OFFSET ; start of state
; ocsw .ds 1 ; output control switch
; current .ds 2 ; points to current line
; stkgos .ds 2 ; saves sp in 'GOSUB'
; varnext .ds 2 ; temp storage
; stkinp .ds 2 ; save sp in 'INPUT'
; loopvar .ds 2 ; 'FOR' loop save area
; loopinc .ds 2 ; loop increment
; looplmt .ds 2 ; loop limit
; loopln .ds 2 ; loop line number
; loopptr .ds 2 ; loop text pointer
; rndptr .ds 2 ; random number pointer
; readptr .ds 2 ; read pointer
; textunfilled .ds 2 ; -> unfilled text area
; textbegin .ds 2 ; start of text save area
; .org TBC_LOC + TEXTEND_OFFSET
; textend .ds 0 ; end of text area
; varbegin .ds 55 ; variable @(0)
; varend .equ $ ; end of variable area
; buffer .ds 72 ; input buffer
; bufend .ds 1
; stacklimit .equ $
; .org TBC_LOC + STACK_OFFSET
; stack .equ $
; #ifdef ROMWBW
; slack .equ (TBC_END - LST_ROM)
; .fill slack,'t'
; .echo "TASTYBASIC space remaining: "
; .echo slack
; .echo " bytes.\n"
; #endif
; .end
SECTION "TASTYBASIC HRAM", HRAM
ocsw: db ; output control switch
current: dw ; points to current line
stkgos: dw ; saves sp in 'GOSUB'
varnext: dw ; temp storage
stkinp: dw ; save sp in 'INPUT'
loopvar: dw ; 'FOR' loop save area
loopinc: dw ; loop increment
looplmt: dw ; loop limit
loopln: dw ; loop line number
loopptr: dw ; loop text pointer
rndptr: dw ; random number pointer
readptr: dw ; read pointer
textunfilled:: dw ; -> unfilled text area
usrptr: dw ; -> user defined function area
hRealBanks:: db ; number of "real" banks in format (0 - count + 1)
UNION
hTempR: dw
NEXTU
hTempBanksCfg:: db
hTempSizeC:: db
ENDU
DEF WRAM_BASE EQU $C000
DEF USER_FUNC_SIZE EQU $0200
DEF STACK_LOCATION EQU $DFFF
IF !DEF(TARGET_MEGADUCK)
DEF SRAM_BASE EQU $A000
DEF CODE_SIZE EQU $1F80
ELSE
DEF WRAMX_BASE EQU $D000
DEF STACK_SIZE EQU $300
ENDC
IF !DEF(TARGET_MEGADUCK)
SECTION "USER_FUNC", WRAM0[WRAM_BASE]
usrfunc:: ds USER_FUNC_SIZE
filesystem:: ds (13+2+1)*15 ; must be aligned 15 rows of filename(13) + size(2) + padding(1)
filename:: ds 13 ; 8 + ".TBA" + \0
filesize:: ds 3
copybuffer:: ds 256
stacklimit::
SECTION "STACK_LOCATION", WRAMX[STACK_LOCATION]
stack::
SECTION UNION "CODE_AREA", SRAM[SRAM_BASE] ; bank 0 - acts as code basic code buffer
textbegin:: ds CODE_SIZE
textend::
varbegin:: ds 55
varend::
buffer:: ds 72
fake_sram_test::
bufend:: ds 1
SECTION UNION "CODE_AREA", SRAM[SRAM_BASE] ; structure for file system banks
fs_begin:: ds CODE_SIZE
fs_end:
fs_magic:: ds 4
fs_filename:: ds 13
fs_filesize:: ds 2
ELSE
SECTION "USER_FUNC", WRAM0[WRAM_BASE]
usrfunc:: ds USER_FUNC_SIZE
textbegin:: ds WRAMX_BASE - @ ; on laptop megaduck there is no file system support
SECTION "WRAMX", WRAMX
textend::
varbegin:: ds 55
varend::
buffer:: ds 72
bufend:: ds 1
stacklimit:: ds STACK_SIZE
stack::
ALIGN 16, STACK_LOCATION
SECTION "WRAMXT", WRAMX[WRAMX_BASE]
textcontinue: ds textend - WRAMX_BASE
ENDC
INCLUDE "macros.inc"
INCLUDE "defs.inc"
SECTION "UTILS", ROM0
_cls::
ld a, cls
call outc
call finish
wait::
call expr
inc h
inc l
dec l
jr z, .dec_h
.loop
call wait_vblank
call chkio
dec l
jr nz, .loop
.dec_h
dec h
jr nz, .loop
call finish
speed::
call testnum ; b - digits parsed, hl - number
xor a
cp b
jp z, qhow
inc h
dec h
jp nz, qhow
ld a, l
dec a
jr c, .change_speed
jr z, .change_speed
jp qhow
.change_speed:
ldh a, [hIsGBC]
dec a
call nz, finish
ld a, l
rrca
ld l, a
ldh a, [rSPD]
and SPD_DOUBLE
cp a, l
call z, finish
ldh a, [rIE]
push af
xor a
ld [rIE], a
ld a, JOYP_GET_NONE
ld [rJOYP], a
ld a, SPD_PREPARE
ld [rSPD], a
stop
pop af
ld [rIE], a
call finish
SECTION "HRAM_UTILS", HRAM
hIsGBC:: db
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment