Skip to content

Instantly share code, notes, and snippets.

@sinsinpub

sinsinpub/CHIP8I.BAS

Last active March 7, 2025 05:22
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save sinsinpub/848195603846b57026e239dba5a86c8d to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save sinsinpub/848195603846b57026e239dba5a86c8d to your computer and use it in GitHub Desktop.
Download ZIP
CHIP8 interpreter with simple debugger for QBasic. Display viewer and better timing added, more configs for SCHIP48 quirks. Compiled with QuickBASIC for playable speed under DOS/DOSBox emulator. (WTFPL)
Raw
CHIP8I.BAS
' CHIP-8 interpreter with simple debugger for QBasic
' 1234qwerasdfzxcv = keypad, Esc = quit, Backspace = toggle debugger,
' see checkinput for more key bindings
DEFINT A-Z
DECLARE SUB chip8exec ()
DECLARE SUB chip8reset ()
DECLARE SUB chip8run ()
DECLARE SUB fetch (ofs)
DECLARE SUB debugger ()
DECLARE SUB decode ()
DECLARE SUB update ()
DECLARE SUB nextpc ()
DECLARE SUB pushstk (v)
DECLARE SUB putbyte (ofs, b)
DECLARE SUB loadfont ()
DECLARE SUB loadprg (f$)
DECLARE SUB drawdisp ()
DECLARE SUB viewgrps ()
DECLARE SUB resetgrps ()
DECLARE SUB checkinput (aw)
DECLARE SUB checktimer ()
DECLARE SUB dispborder ()
DECLARE SUB debugborder ()
DECLARE SUB fixvgalomode ()
DECLARE SUB setattimer (flag)
DECLARE SUB drawbox (x, y, w, h, fc, bc)
DECLARE SUB scrollgrps (l, t, w, h, dx, dy)
DECLARE FUNCTION popstk ()
DECLARE FUNCTION disasm$ ()
DECLARE FUNCTION getbyte (ofs)
DECLARE FUNCTION ihex$ (v, l)
DECLARE FUNCTION iif (c, tv, fv)
DECLARE FUNCTION clamp (v, l, u)
DECLARE FUNCTION tomemaddr (v)
CONST false = 0
CONST true = NOT false
' Chip-8 specifications:
CONST memsize = &H1000
CONST regmax = &HF
CONST stkmax = &HF
CONST keymax = &HF
CONST fontmax = &HF
CONST bytespc = &H5
CONST fontstart = &H0
CONST prgstart = &H200
CONST c48ldi = true, c48v0s = false
CONST c48svy = true
CONST c48ref = true
CONST grpclip = true
CONST sfx = true
CONST beepfreq = 440
CONST msptick = 16
CONST directhw = true, attimer = true
' LCD constants:
CONST himode = false
CONST dispwidth = 63, dispheight = 31
CONST displeft = 8, disptop = 2
CONST dispfcolor = 0, dispbcolor = 7
' Debugger constants:
CONST dbgleft = 3, dbgtop = 21
CONST dbgfcolor = 7, dbgbcolor = 1, dbghcolor = 15
CONST instmaxlen = 13
' Memory and globals:
DIM SHARED mems AS STRING * memsize
DIM SHARED grps(dispheight, dispwidth)
DIM SHARED regs(regmax)
DIM SHARED stks(stkmax)
DIM SHARED keys(keymax)
DIM SHARED prgcnt, idxreg, stkptr
DIM SHARED delaytimer, soundtimer
DIM SHARED running, needsdraw, debug, steptrace
DIM SHARED curinst AS LONG
DIM SHARED prgfile AS STRING, scrfile AS STRING
' Determine program file name
ON ERROR GOTO errhandler
prgfile = COMMAND$
IF prgfile = "" THEN
FILES
LINE INPUT "Chip-8 program to run: ", prgfile
END IF
IF prgfile = "" THEN SYSTEM
'ON ERROR GOTO 0
chip8exec
SYSTEM
errhandler:
IF ERR = 73 THEN RESUME NEXT
WIDTH 80, 25
COLOR 7, 0
CLS
LOCATE , , 1, 30, 31
SELECT CASE ERR
CASE 53
PRINT "File not found"
CASE 75
PRINT "Path access error"
CASE ELSE
PRINT "Unexpected fatal error:"; ERR
END SELECT
SYSTEM
chip8font:
DATA &HF0, &H90, &H90, &H90, &HF0
DATA &H20, &H60, &H20, &H20, &H70
DATA &HF0, &H10, &HF0, &H80, &HF0
DATA &HF0, &H10, &HF0, &H10, &HF0
DATA &H90, &H90, &HF0, &H10, &H10
DATA &HF0, &H80, &HF0, &H10, &HF0
DATA &HF0, &H80, &HF0, &H90, &HF0
DATA &HF0, &H10, &H20, &H40, &H40
DATA &HF0, &H90, &HF0, &H90, &HF0
DATA &HF0, &H90, &HF0, &H10, &HF0
DATA &HF0, &H90, &HF0, &H90, &H90
DATA &HE0, &H90, &HE0, &H90, &HE0
DATA &HF0, &H80, &H80, &H80, &HF0
DATA &HE0, &H90, &H90, &H90, &HE0
DATA &HF0, &H80, &HF0, &H80, &HF0
DATA &HF0, &H80, &HF0, &H80, &H80
SUB checkinput (aw)
DO
i$ = INKEY$
waitend = true
SELECT CASE i$
CASE "1", CHR$(0) + "R" 'Ins
keys(&H1) = true
CASE "2", CHR$(0) + "H" 'Up
keys(&H2) = true
CASE "3", CHR$(0) + "I" 'PgUp
keys(&H3) = true
CASE "4", CHR$(0) + "G" 'Home
keys(&HC) = true
CASE "Q", "q", CHR$(0) + "K" 'Left
keys(&H4) = true
CASE "W", "w", CHR$(0) + "O" 'End
keys(&H5) = true
CASE "E", "e", CHR$(0) + "M" 'Right
keys(&H6) = true
CASE "R", "r"
keys(&HD) = true
CASE "A", "a", CHR$(0) + "S" 'Del
keys(&H7) = true
CASE "S", "s", CHR$(0) + "P" 'Down
keys(&H8) = true
CASE "D", "d", CHR$(0) + "Q" 'PgDn
keys(&H9) = true
CASE "F", "f"
keys(&HE) = true
CASE "Z", "z"
keys(&HA) = true
CASE "X", "x"
keys(&H0) = true
CASE "C", "c"
keys(&HB) = true
CASE "V", "v"
keys(&HF) = true
CASE CHR$(27) 'ESC: Terminate running
running = false
CASE CHR$(8), CHR$(0) + "<" 'F2/BS: Toggle debugger
debug = NOT debug
debugborder
CASE CHR$(9), CHR$(0) + "=" 'F3/TAB: Toggle step trace
IF debug THEN
steptrace = NOT steptrace
ELSE
waitend = false
END IF
CASE "`", CHR$(0) + ";" 'F1: Reset running
chip8reset
fetch 0
CASE " ", CHR$(13) 'For step forward
IF NOT debug THEN waitend = false
CASE CHR$(0) + ">" 'F4: Enter graphics display inspector
IF debug THEN viewgrps
CASE ELSE
waitend = false
END SELECT
LOOP UNTIL NOT aw OR waitend
END SUB
SUB checktimer
STATIC tmr&, posted
onetick = false
IF directhw AND attimer THEN
IF posted > 0 THEN
posted = 0
onetick = true
END IF
IF posted = 0 THEN setattimer posted
ELSE
onetick = ABS((TIMER * 1000) - tmr&) > msptick
IF onetick THEN tmr& = TIMER * 1000
END IF
IF onetick THEN
IF delaytimer > 0 THEN delaytimer = delaytimer - 1
IF soundtimer > 0 THEN
IF sfx THEN SOUND beepfreq, .3
soundtimer = soundtimer - 1
END IF
END IF
END SUB
SUB chip8exec
SCREEN 0, 1, 0, 0
WIDTH 80, iif(himode, 50, 25)
COLOR 7, 0
CLS
LOCATE , , 0, 0, 31
IF directhw AND NOT himode THEN fixvgalomode
debug = true
steptrace = false
dispborder
debugborder
chip8reset
chip8run
WIDTH 80, 25
COLOR 7, 0
CLS
LOCATE , , 1, 30, 31
END SUB
SUB chip8reset
RANDOMIZE TIMER
running = true
needsdraw = true
prgcnt = prgstart
idxreg = 0
stkptr = 0
loadfont
loadprg prgfile
resetgrps
ERASE regs, stks, keys
' FOR i = 0 TO regmax
' regs(i) = 0
' NEXT i
' FOR i = 0 TO stkmax
' stks(i) = 0
' NEXT i
' FOR i = 0 TO keymax
' keys(i) = false
' NEXT i
END SUB
SUB chip8run
DO
fetch 0
debugger
decode
update
LOOP WHILE running
END SUB
FUNCTION clamp (v, l, u)
clamp = v
IF v < l THEN clamp = l
IF v > u THEN clamp = u
END FUNCTION
SUB debugborder
IF debug THEN
drawbox dbgleft, dbgtop + iif(himode, 16, 0), 76, 5, dbghcolor, dbgbcolor
ELSE
drawbox dbgleft, dbgtop + iif(himode, 16, 0), 76, 5, 0, 0
END IF
END SUB
SUB debugger
STATIC prepc, preda$
IF NOT debug THEN EXIT SUB
COLOR dbgfcolor, dbgbcolor
rtop = dbgtop + iif(himode, 16, 0)
LOCATE rtop + 1, dbgleft + 23
PRINT USING "PC:\ \ "; ihex$(prgcnt, 3);
PRINT USING "OP:\ \ "; RIGHT$("0000" + HEX$(curinst), 4);
PRINT USING "IX:\ \ "; ihex$(idxreg, 3);
PRINT USING "DT:\\ ST:\\ "; ihex$(delaytimer, 2); ihex$(soundtimer, 2);
FOR i = 0 TO keymax
COLOR keys(i) AND dbghcolor OR dbgfcolor
PRINT USING "!"; HEX$(i);
NEXT i
COLOR dbgfcolor
LOCATE rtop + 2, dbgleft + 23
PRINT "RV:";
FOR i = 0 TO regmax
PRINT USING "\\ "; ihex$(regs(i), 2);
NEXT i
LOCATE rtop + 3, dbgleft + 23
PRINT USING "SP:\\ "; ihex$(stkptr, 2);
FOR i = 0 TO 6
PRINT USING "\ \ "; ihex$(stks(i), 3);
NEXT i
FOR i = 0 TO 7
PRINT USING "\\"; ihex$(getbyte(idxreg + i), 2);
NEXT i
IF preda$ <> "" THEN
LOCATE rtop + 1, dbgleft + 3
PRINT ihex$(prepc, 3); ":"; LEFT$(preda$ + SPACE$(instmaxlen), instmaxlen);
END IF
prepc = prgcnt
preda$ = disasm$
LOCATE rtop + 2, dbgleft + 3
PRINT ihex$(prgcnt, 3); ":"; LEFT$(preda$ + SPACE$(instmaxlen), instmaxlen);
fetch 2
nexda$ = disasm$
LOCATE rtop + 3, dbgleft + 3
PRINT ihex$(tomemaddr(prgcnt + 2), 3); ":";
PRINT LEFT$(nexda$ + SPACE$(instmaxlen), instmaxlen);
fetch 0
IF steptrace THEN checkinput true
END SUB
SUB decode
opcode = (curinst AND &HF000) \ &H1000
operand8 = curinst AND &HF
operand16 = curinst AND &HFF
operand24 = curinst AND &HFFF
operandvx = (curinst AND &HF00) \ &H100
operandvy = (curinst AND &HF0) \ &H10
SELECT CASE opcode
CASE 0
SELECT CASE operand16
CASE &HE0 'CLS
resetgrps
needsdraw = true
CASE &HEE 'RET
prgcnt = popstk
END SELECT
nextpc
CASE 1 'JP nnn
prgcnt = operand24
CASE 2 'CALL nnn
pushstk prgcnt
prgcnt = operand24
CASE 3 'SE Vx,kk
IF regs(operandvx) = operand16 THEN nextpc
nextpc
CASE 4 'SNE Vx,kk
IF regs(operandvx) <> operand16 THEN nextpc
nextpc
CASE 5 'SE Vx,Vy
IF regs(operandvx) = regs(operandvy) THEN nextpc
nextpc
CASE 6 'LD Vx,kk
regs(operandvx) = operand16
nextpc
CASE 7 'ADD Vx,kk
regs(operandvx) = (regs(operandvx) + operand16) AND &HFF
nextpc
CASE 8
SELECT CASE operand8
CASE &H0 'LD Vx,Vy
regs(operandvx) = regs(operandvy)
CASE &H1 'OR Vx,Vy
regs(operandvx) = regs(operandvx) OR regs(operandvy)
IF c48ref THEN regs(&HF) = 0
CASE &H2 'AND Vx,Vy
regs(operandvx) = regs(operandvx) AND regs(operandvy)
IF c48ref THEN regs(&HF) = 0
CASE &H3 'XOR Vx,Vy
regs(operandvx) = regs(operandvx) XOR regs(operandvy)
IF c48ref THEN regs(&HF) = 0
CASE &H4 'ADD Vx,Vy
regs(operandvx) = regs(operandvx) + regs(operandvy)
regs(&HF) = ABS(regs(operandvx) > &HFF)
regs(operandvx) = regs(operandvx) AND &HFF
CASE &H5 'SUB Vx,Vy
regs(operandvx) = regs(operandvx) - regs(operandvy)
regs(&HF) = ABS(regs(operandvx) >= 0)
regs(operandvx) = regs(operandvx) AND &HFF
CASE &H6 'SHR Vx,Vy
IF c48svy THEN regs(operandvx) = regs(operandvy)
flag = regs(operandvx) AND 1
regs(operandvx) = regs(operandvx) \ 2
regs(&HF) = flag
CASE &H7 'SUBN Vx,Vy
regs(operandvx) = regs(operandvy) - regs(operandvx)
regs(&HF) = ABS(regs(operandvx) >= 0)
regs(operandvx) = regs(operandvx) AND &HFF
CASE &HE 'SHL Vx,Vy
IF c48svy THEN regs(operandvx) = regs(operandvy)
flag = ABS((regs(operandvx) AND &H80) > 0)
regs(operandvx) = (regs(operandvx) * 2) AND &HFF
regs(&HF) = flag
END SELECT
nextpc
CASE 9 'SNE Vx,Vy
IF regs(operandvx) <> regs(operandvy) THEN nextpc
nextpc
CASE 10 'LD I,nnn
idxreg = operand24
nextpc
CASE 11 'JP V0,nnn
'Vn quirk not supported
prgcnt = tomemaddr(regs(0) + operand24)
CASE 12 'RND Vx,kk
regs(operandvx) = INT(RND * 256) AND operand16
nextpc
CASE 13 'DRW Vx,Vy,n
x = regs(operandvx) AND dispwidth
y = regs(operandvy) AND dispheight
regs(&HF) = 0
FOR i = 0 TO operand8 - 1
IF grpclip AND (y + i > dispheight) THEN EXIT FOR
d = getbyte(idxreg + i)
FOR j = 7 TO 0 STEP -1
IF (d AND (2 ^ j)) > 0 THEN
IF grpclip THEN
rx = x + 7 - j
IF rx > dispwidth THEN EXIT FOR
ry = y + i
ELSE
rx = (x + 7 - j) AND dispwidth
ry = (y + i) AND dispheight
END IF
regs(&HF) = regs(&HF) OR grps(ry, rx)
grps(ry, rx) = grps(ry, rx) XOR 1
END IF
NEXT j
NEXT i
needsdraw = true
nextpc
CASE 14
SELECT CASE operand16
CASE &H9E 'SKP Vx
IF keys(regs(operandvx)) THEN
keys(regs(operandvx)) = false
nextpc
END IF
CASE &HA1 'SKNP Vx
IF NOT keys(regs(operandvx)) THEN nextpc
keys(regs(operandvx)) = false
END SELECT
nextpc
CASE 15
SELECT CASE operand16
CASE &H7 'LD Vx,DT
regs(operandvx) = delaytimer
nextpc
CASE &HA 'LD Vx,K
'Halting DT & ST not supported
regs(operandvx) = 0
nextpc
ERASE keys
' FOR i = 0 TO keymax
' keys(i) = false
' NEXT i
checkinput true
FOR i = 0 TO keymax
IF keys(i) THEN
regs(operandvx) = i
EXIT FOR
END IF
NEXT i
CASE &H15 'LD DT,Vx
delaytimer = regs(operandvx)
nextpc
CASE &H18 'LD ST,Vx
soundtimer = regs(operandvx)
nextpc
CASE &H1E 'ADD I,Vx
previdx = idxreg
idxreg = tomemaddr(idxreg + regs(operandvx))
regs(&HF) = ABS(previdx + regs(operandvx) >= memsize)
nextpc
CASE &H29 'LD F,Vx
idxreg = fontstart + bytespc * (regs(operandvx) AND fontmax)
nextpc
CASE &H33 'LD B,Vx
putbyte idxreg + 0, regs(operandvx) \ 100
putbyte idxreg + 1, (regs(operandvx) MOD 100) \ 10
putbyte idxreg + 2, (regs(operandvx) MOD 100) MOD 10
nextpc
CASE &H55 'LD [I],Vx
FOR i = 0 TO operandvx
putbyte idxreg + i, regs(i)
NEXT i
IF c48ldi THEN idxreg = tomemaddr(idxreg + i + c48v0s)
nextpc
CASE &H65 'LD Vx,[I]
FOR i = 0 TO operandvx
regs(i) = getbyte(idxreg + i)
NEXT i
IF c48ldi THEN idxreg = tomemaddr(idxreg + i + c48v0s)
nextpc
CASE ELSE
nextpc
END SELECT
END SELECT
END SUB
FUNCTION disasm$
disasm$ = "Invalid code"
opcode = (curinst AND &HF000) \ &H1000
b = curinst AND &HF
kk = curinst AND &HFF
nnn = curinst AND &HFFF
vx = (curinst AND &HF00) \ &H100
vy = (curinst AND &HF0) \ &H10
' Here used CHIPPER mnemonics
SELECT CASE opcode
CASE 0
IF kk = &HE0 THEN '00E0
disasm$ = "CLS"
ELSEIF kk = &HEE THEN '00EE
disasm$ = "RET"
ELSE
disasm$ = "NOP"
END IF
CASE 1 '1nnn
disasm$ = "JP " + ihex$(nnn, 3)
CASE 2 '2nnn
disasm$ = "CALL " + ihex$(nnn, 3)
CASE 3 '3xkk
disasm$ = "SE V" + ihex$(vx, 1) + "," + ihex$(kk, 2)
CASE 4 '4xkk
disasm$ = "SNE V" + ihex$(vx, 1) + "," + ihex$(kk, 2)
CASE 5 '5xy0
IF b = 0 THEN disasm$ = "SE V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE 6 '6xkk
disasm$ = "LD V" + ihex$(vx, 1) + "," + ihex$(kk, 2)
CASE 7 '7xkk
disasm$ = "ADD V" + ihex$(vx, 1) + "," + ihex$(kk, 2)
CASE 8
SELECT CASE b
CASE &H0 '8xy0
disasm$ = "LD V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H1 '8xy1
disasm$ = "OR V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H2 '8xy2
disasm$ = "AND V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H3 '8xy3
disasm$ = "XOR V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H4 '8xy4
disasm$ = "ADD V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H5 '8xy5
disasm$ = "SUB V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H6 '8xy6, y unsed for CHIP48+
disasm$ = "SHR V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &H7 '8xy7
disasm$ = "SUBN V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE &HE '8xyE, y unsed for CHIP48+
disasm$ = "SHL V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
END SELECT
CASE 9 '9xy0
IF b = 0 THEN disasm$ = "SNE V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1)
CASE 10 'Annn
disasm$ = "LD I," + ihex$(nnn, 3)
CASE 11 'Bnnn
disasm$ = "JP V0," + ihex$(nnn, 3)
CASE 12 'Cxkk
disasm$ = "RND V" + ihex$(vx, 1) + "," + ihex$(kk, 2)
CASE 13 'Dxyn
disasm$ = "DRW V" + ihex$(vx, 1) + ",V" + ihex$(vy, 1) + "," + ihex$(b, 1)
CASE 14
IF kk = &H9E THEN 'Ex9E
disasm$ = "SKP V" + ihex$(vx, 1)
ELSEIF kk = &HA1 THEN 'ExA1
disasm$ = "SKNP V" + ihex$(vx, 1)
END IF
CASE 15
SELECT CASE kk
CASE &H7 'Fx07
disasm$ = "LD V" + ihex$(vx, 1) + ",DT"
CASE &HA 'Fx0A
disasm$ = "LD V" + ihex$(vx, 1) + ",K"
CASE &H15 'Fx15
disasm$ = "LD DT,V" + ihex$(vx, 1)
CASE &H18 'Fx18
disasm$ = "LD ST,V" + ihex$(vx, 1)
CASE &H1E 'Fx1E
disasm$ = "ADD I,V" + ihex$(vx, 1)
CASE &H29 'Fx29
disasm$ = "LD F,V" + ihex$(vx, 1)
CASE &H33 'Fx33
disasm$ = "LD B,V" + ihex$(vx, 1)
CASE &H55 'Fx55
disasm$ = "LD [I],V" + ihex$(vx, 1)
CASE &H65 'Fx65
disasm$ = "LD V" + ihex$(vx, 1) + ",[I]"
END SELECT
END SELECT
END FUNCTION
SUB dispborder
COLOR 8, 7
bc = 177
FOR r = 0 TO dispheight \ iif(himode, 1, 2) + 2
LOCATE disptop + r, displeft
PRINT CHR$(bc); SPACE$(dispwidth + 1); CHR$(bc);
NEXT r
FOR c = 0 TO dispwidth + 2
LOCATE disptop, displeft + c
PRINT CHR$(bc);
LOCATE disptop + dispheight \ iif(himode, 1, 2) + 2, displeft + c
PRINT CHR$(bc);
NEXT c
END SUB
SUB drawbox (x, y, w, h, fc, bc)
IF w < 2 OR h < 2 OR x + w > 81 THEN EXIT SUB
COLOR fc, bc
FOR r = y + 1 TO y + h - 2
LOCATE r, x
PRINT CHR$(179); SPACE$(w - 2); CHR$(179);
NEXT r
FOR c = x + 1 TO x + w - 2
LOCATE y, c
PRINT CHR$(196);
LOCATE y + h - 1, c
PRINT CHR$(196);
NEXT c
LOCATE y, x
PRINT CHR$(218);
LOCATE y, x + w - 1
PRINT CHR$(191);
LOCATE y + h - 1, x
PRINT CHR$(192);
LOCATE y + h - 1, x + w - 1
PRINT CHR$(217);
END SUB
SUB drawdisp
IF NOT needsdraw THEN EXIT SUB
needsdraw = false
ys = iif(himode, 1, 2)
COLOR dispfcolor, dispbcolor
FOR y = 0 TO dispheight - 1 STEP ys
l$ = SPACE$(dispwidth + 1)
FOR x = 0 TO dispwidth
p1 = grps(y, x)
IF himode THEN
IF p1 > 0 THEN c = 219 ELSE c = 0
ELSE
p2 = grps(y + 1, x)
IF p1 > 0 AND p2 > 0 THEN
c = 219
ELSEIF p1 > 0 THEN
c = 223
ELSEIF p2 > 0 THEN
c = 220
ELSE
c = 0
END IF
END IF
IF c THEN MID$(l$, x + 1, 1) = CHR$(c)
NEXT x
LOCATE disptop + y \ ys + 1, displeft + 1
PRINT l$;
NEXT y
END SUB
SUB fetch (ofs)
DIM lngbin AS STRING * 4
adr = tomemaddr(prgcnt + ofs)
MID$(lngbin, 1, 1) = MID$(mems, adr + 2, 1)
MID$(lngbin, 2, 1) = MID$(mems, adr + 1, 1)
curinst = CVL(lngbin)
END SUB
SUB fixvgalomode
OUT &H3C4, &H2
OUT &H3C5, &H4
OUT &H3C4, &H4
OUT &H3C5, &H7
OUT &H3CE, &H5
OUT &H3CF, &H0
OUT &H3CE, &H6
OUT &H3CF, &H4
OUT &H3CE, &H4
OUT &H3CF, &H2
DEF SEG = &HA000
' Fix half blocks to real 8x8 instead of height 9/7
POKE 220 * 32 + 7, &H0
POKE 223 * 32 + 7, &HFF
DEF SEG
OUT &H3C4, &H2
OUT &H3C5, &H3
OUT &H3C4, &H4
OUT &H3C5, &H3
OUT &H3CE, &H5
OUT &H3CF, &H10
OUT &H3CE, &H6
OUT &H3CF, &HE
OUT &H3CE, &H4
OUT &H3CF, &H0
END SUB
FUNCTION getbyte (ofs)
getbyte = ASC(MID$(mems, 1 + tomemaddr(ofs), 1))
END FUNCTION
FUNCTION ihex$ (i, l)
ihex$ = RIGHT$(STRING$(l, 48) + HEX$(i), l)
END FUNCTION
FUNCTION iif (c, tv, fv)
IF c THEN iif = tv ELSE iif = fv
END FUNCTION
SUB loadfont
RESTORE chip8font
FOR i = fontstart TO fontstart + (fontmax + 1) * bytespc - 1
READ b
putbyte i, b
NEXT i
END SUB
SUB loadprg (f$)
fp = FREEFILE
OPEN f$ FOR INPUT AS fp
CLOSE fp
OPEN f$ FOR BINARY AS fp
fsize = LOF(fp)
IF fsize > memsize - prgstart THEN fsize = memsize - prgstart
b$ = INPUT$(fsize, fp)
CLOSE fp
MID$(mems, 1 + prgstart) = b$
extd = 0
DO
i = INSTR(extd + 1, f$, ".")
IF i > 0 THEN extd = i
LOOP WHILE i > 0
IF extd > 0 THEN
scrfile = LEFT$(f$, extd) + "SCR"
ELSE
scrfile = f$ + ".SCR"
END IF
END SUB
SUB nextpc
prgcnt = tomemaddr(prgcnt + 2)
END SUB
FUNCTION popstk
stkptr = (stkptr - 1) AND stkmax
popstk = stks(stkptr)
END FUNCTION
SUB pushstk (v)
stks(stkptr) = v
stkptr = (stkptr + 1) AND stkmax
END SUB
SUB putbyte (ofs, b)
MID$(mems, 1 + tomemaddr(ofs), 1) = CHR$(b)
END SUB
SUB resetgrps
' Static arrays dim with constant to ensure fast erasable
ERASE grps
' FOR y = 0 TO dispheight
' FOR x = 0 TO dispwidth
' grps(y, x) = 0
' NEXT x, y
END SUB
SUB scrollgrps (l, t, w, h, dx, dy)
b = clamp(t + h - 1, 0, dispheight)
r = clamp(l + w - 1, 0, dispwidth)
IF SGN(dx) < 0 THEN
FOR y = t TO b
FOR x = l TO r
IF x = r THEN grps(y, x) = 0 ELSE grps(y, x) = grps(y, x + 1)
NEXT x, y
ELSEIF SGN(dx) > 0 THEN
FOR y = t TO b
FOR x = r TO l STEP -1
IF x = l THEN grps(y, x) = 0 ELSE grps(y, x) = grps(y, x - 1)
NEXT x, y
END IF
IF SGN(dy) < 0 THEN
FOR y = t TO b
FOR x = l TO r
IF y = b THEN grps(y, x) = 0 ELSE grps(y, x) = grps(y + 1, x)
NEXT x, y
ELSEIF SGN(dy) > 0 THEN
FOR y = b TO t STEP -1
FOR x = l TO r
IF y = t THEN grps(y, x) = 0 ELSE grps(y, x) = grps(y - 1, x)
NEXT x, y
END IF
END SUB
SUB setattimer (flag)
i15$ = STRING$(20, &HCB)
MID$(i15$, 1, 3) = CHR$(&HB8) + MKI$(&H8300)
MID$(i15$, 4, 3) = CHR$(&HB9) + MKI$(0)
MID$(i15$, 7, 3) = CHR$(&HBA) + MKI$(msptick * 1000)
MID$(i15$, 10, 3) = CHR$(&HBB) + MKI$(VARSEG(flag))
MID$(i15$, 13, 2) = CHR$(&H8E) + CHR$(&HC3)
MID$(i15$, 15, 3) = CHR$(&HBB) + MKI$(VARPTR(flag))
MID$(i15$, 18, 2) = CHR$(&HCD) + CHR$(&H15)
CALL ABSOLUTE(SADD(i15$))
END SUB
FUNCTION tomemaddr (v)
tomemaddr = v AND (memsize - 1)
END FUNCTION
SUB update
checkinput false
checktimer
drawdisp
END SUB
SUB viewgrps
drawbox dbgleft + 2, dbgtop + iif(himode, 16, 0) + 1, 40, 3, 14, 5
cx = dispwidth \ 2
cy = dispheight \ iif(himode, 2, 4)
cm = true
DO
i$ = INKEY$
SELECT CASE i$
CASE CHR$(0) + "K" 'Left
cx = (cx - 1) AND dispwidth
cm = true
CASE CHR$(0) + "M" 'Right
cx = (cx + 1) AND dispwidth
cm = true
CASE CHR$(0) + "H" 'Up
cy = (cy - 1) AND dispheight \ iif(himode, 1, 2)
cm = true
CASE CHR$(0) + "P" 'Down
cy = (cy + 1) AND dispheight \ iif(himode, 1, 2)
cm = true
CASE ";", "/", " ", CHR$(8), CHR$(13), CHR$(0) + "S"
LOCATE , , 0
ry = cy * iif(himode, 1, 2)
IF NOT himode AND (i$ = "/" OR i$ = CHR$(13)) THEN ry = ry + 1
'Del: clear, both dots if not himode
IF i$ = CHR$(0) + "S" THEN
grps(ry, cx) = 0
IF NOT himode THEN grps(ry + 1, cx) = 0
ELSE
grps(ry, cx) = grps(ry, cx) XOR 1
END IF
needsdraw = true
drawdisp
cm = true
CASE CHR$(0) + "G", CHR$(0) + "O", CHR$(0) + "I", CHR$(0) + "Q"
'Home/End/PgUp/PgDn: shift 8x8 area at cursor
LOCATE , , 0
rx = cx
ry = cy * iif(himode, 1, 2)
SELECT CASE i$
CASE CHR$(0) + "G"
rx = clamp(cx - 1, 0, cx)
rw = 9: rh = 8
dx = -1: dy = 0
CASE CHR$(0) + "O"
rw = 9: rh = 8
dx = 1: dy = 0
CASE CHR$(0) + "I"
ry = clamp(ry - 1, 0, ry)
rw = 8: rh = 9
dx = 0: dy = -1
CASE CHR$(0) + "Q"
rw = 8: rh = 9
dx = 0: dy = 1
END SELECT
scrollgrps rx, ry, rw, rh, dx, dy
needsdraw = true
drawdisp
cm = true
CASE CHR$(0) + "w", CHR$(0) + "u", CHR$(0) + CHR$(132), CHR$(0) + "v"
'Ctrl+Home/End/PgUp/PgDn: full screen scroll
LOCATE , , 0
dx = 0
dy = 0
IF i$ = CHR$(0) + "w" THEN dx = -1
IF i$ = CHR$(0) + "u" THEN dx = 1
IF i$ = CHR$(0) + CHR$(132) THEN dy = -1
IF i$ = CHR$(0) + "v" THEN dy = 1
scrollgrps 0, 0, dispwidth + 1, dispheight + 1, dx, dy
needsdraw = true
drawdisp
cm = true
CASE CHR$(0) + "?" 'F5: Save screen into file
LOCATE , , 0
fp = FREEFILE
OPEN scrfile FOR OUTPUT AS fp
FOR r = 0 TO dispheight
l$ = SPACE$(dispwidth + 1)
FOR c = 0 TO dispwidth
IF grps(r, c) > 0 THEN MID$(l$, c + 1, 1) = CHR$(219)
NEXT c
PRINT #fp, l$
NEXT r
CLOSE fp
IF sfx THEN SOUND beepfreq, 2
CASE CHR$(0) + "A" 'F7: Load screen from file
LOCATE , , 0
fp = FREEFILE
OPEN scrfile FOR BINARY AS fp
IF LOF(fp) = 0 THEN
CLOSE fp
KILL scrfile
IF sfx THEN SOUND beepfreq * 2, 4
ELSE
CLOSE fp
OPEN scrfile FOR INPUT AS fp
FOR r = 0 TO dispheight
LINE INPUT #fp, l$
IF LEN(l$) <= dispwidth THEN l$ = l$ + SPACE$(dispwidth + 1)
FOR c = 0 TO dispwidth
grps(r, c) = iif(MID$(l$, c + 1, 1) <> " ", 1, 0)
NEXT c
NEXT r
CLOSE fp
IF sfx THEN SOUND beepfreq, 2
needsdraw = true
drawdisp
cm = true
END IF
END SELECT
IF cm THEN
LOCATE , , 0
COLOR 15, 5
LOCATE dbgtop + 2 + iif(himode, 16, 0), dbgleft + 4
ry = cy * iif(himode, 1, 2)
PRINT USING "\\:\\ "; ihex$(cx, 2); ihex$(ry, 2);
h15$ = STRING$(30, 48)
FOR i = 0 TO 14
IF ry + i > dispheight THEN EXIT FOR
b = 0
FOR j = 0 TO 7
IF cx + j > dispwidth THEN EXIT FOR
IF grps(ry + i, cx + j) > 0 THEN b = b + 2 ^ (7 - j)
NEXT j
MID$(h15$, i * 2 + 1, 2) = ihex$(b, 2)
NEXT i
PRINT h15$;
cm = false
END IF
LOCATE disptop + cy + 1, displeft + cx + 1, 1
LOOP UNTIL i$ = CHR$(27)
LOCATE , , 0
debugborder
END SUB
Raw
GWAC01.ASM
; Game & Watch BALL-like game to play balls toss-up trick.
; 4/6 to move hands left/right, 7/8/9 to put hands left/middle/right.
; Assembler: chipper gwac01
option chip8
align off
minus1 = #ff
manx = 23
many = 17
handlx = 17
handrx = 37
handy = 22
maxlane1 = 11
maxlane2 = 9
maxlane3 = 7
crushlx = 17
crushrx = 37
crushy = 27
start:
cls
ld v3, 0 ; score
ld v4, 0 ; crush flag
ld v5, 0 ; ball to move
ld v6, 1 ; ball #1 dir
ld v7, minus1 ; ball #2 dir
ld v8, 1 ; ball #3 dir
rnd v9, 3 ; ball pos on lane #1
ld va, maxlane2 ; ball pos on lane #2
rnd vb, 1 ; ball pos on lane #3
ld vc, 5 ; move delay per balls
ld vd, 0 ; prev hand pos
ld ve, 0 ; curr hand pos
call showinit
ld vf, k
gameloop:
call updatehands
call updateballs
sne v4, 0
jp gameloop
jp start
showinit:
ld i, manleft
ld v0, manx
ld v1, many
drw v0, v1, 15
ld i, manright
add v0, 8
drw v0, v1, 15
ld i, handleft
ld v0, handlx
ld v1, handy
drw v0, v1, 4
ld i, handright
ld v0, handrx
drw v0, v1, 4
ld v5, minus1 ; -1 to show all balls
call showballs
call showscore
ret
updatehands:
ld v0, 4
sknp v0
call movehandsleft
ld v0, 6
sknp v0
call movehandsright
ld v0, 7
sknp v0
call movehandsonleft
ld v0, 9
sknp v0
call movehandsonright
ld v0, 5
sknp v0
call movehandsonmiddle
ld v0, 8
sknp v0
call movehandsonmiddle
call showhands
call tossballs
ret
tossballs:
se ve, 0
jp handpos2
sne v9, 0
call tosslane1l
sne vb, maxlane3
call tosslane3r
handpos2:
se ve, 1
jp handpos3
sne va, 0
call tosslane2l
sne va, maxlane2
call tosslane2r
handpos3:
se ve, 2
ret
sne v9, maxlane1
call tosslane1r
sne vb, 0
call tosslane3l
ret
tosslane1l:
se v6, minus1
ret
ld v6, 1
jp gainscore
tosslane1r:
se v6, 1
ret
ld v6, minus1
jp gainscore
tosslane2l:
se v7, minus1
ret
ld v7, 1
jp gainscore
tosslane2r:
se v7, 1
ret
ld v7, minus1
jp gainscore
tosslane3l:
se v8, minus1
ret
ld v8, 1
jp gainscore
tosslane3r:
se v8, 1
ret
ld v8, minus1
jp gainscore
showhands:
sne ve, vd
ret
ld v0, vd
shl v0
shl v0
ld i, handleft
add i, v0
ld v0, handlx
ld v1, handy
drw v0, v1, 4
ld v0, ve
shl v0
shl v0
ld i, handleft
add i, v0
ld v0, handlx
drw v0, v1, 4
ld v0, vd
shl v0
shl v0
ld i, handright
add i, v0
ld v0, handrx
drw v0, v1, 4
ld v0, ve
shl v0
shl v0
ld i, handright
add i, v0
ld v0, handrx
drw v0, v1, 4
ld vd, ve
ret
movehandsleft:
se ve, 0
add ve, minus1
ret
movehandsright:
se ve, 2
add ve, 1
ret
movehandsonleft:
ld ve, 0
ret
movehandsonmiddle:
ld ve, 1
ret
movehandsonright:
ld ve, 2
ret
gainscore:
ld vf, 2
ld st, vf
call showscore
sne v3, 99
jp gamebeaten
add v3, 1
sne v3, 20
add vc, minus1
sne v3, 40
add vc, minus1
sne v3, 60
add vc, minus1
sne v3, 80
add vc, minus1
showscore:
ld i, bcd
ld b, v3
ld v2, [i]
ld v0, 54
ld f, v1
ld v1, 1
drw v0, v1, 5
add v0, 5
ld f, v2
drw v0, v1, 5
ret
updateballs:
ld v0, dt
se v0, 0
ret
call showballs
call moveballs
call showballs
add v5, 1
sne v5, 3
ld v5, 0
ld dt, vc
ret
showballs:
sne v5, minus1
jp s3balls
sne v5, 0
jp sball1
sne v5, 1
jp sball2
jp sball3
s3balls:
call sball1
call sball2
call sball3
ret
sball1: ld v0, v9
ld v1, 0
call showball
ret
sball2: ld v0, va
ld v1, 1
call showball
ret
sball3: ld v0, vb
ld v1, 2
call showball
ret
showball:
ld i, ballpos
sne v1, 1
add v0, 12
sne v1, 2
add v0, 22
shl v0
add i, v0
ld v1, [i]
ld i, ball
drw v0, v1, 2
ret
moveballs:
sne v5, 0
jp mball1
sne v5, 1
jp mball2
jp mball3
mball1: add v9, v6
sne v9, maxlane1+1
jp crushlaner
sne v9, minus1
jp crushlanel
ret
mball2: add va, v7
sne va, maxlane2+1
jp crushlaner
sne va, minus1
jp crushlanel
ret
mball3: add vb, v8
sne vb, maxlane3+1
jp crushlaner
sne vb, minus1
jp crushlanel
ret
crushlanel:
ld i, crushleft
ld v0, crushlx
ld v1, crushy
drw v0, v1, 4
jp gameover
crushlaner:
ld i, crushright
ld v0, crushrx
ld v1, crushy
drw v0, v1, 4
jp gameover
gamebeaten:
ld v4, 5
clearloop:
ld vf, 5
ld st, vf
ld vf, 10
ld dt, vf
waitblink:
ld vf, dt
se vf, 0
jp waitblink
call showscore
add v4, minus1
se v4, 0
jp clearloop
gameover:
ld vf, 10
ld dt, vf
ld st, vf
waitbeep:
ld vf, dt
se vf, 0
jp waitbeep
ld vf, k
ld v4, 1
ret
bcd: db 0, 0, 0
ballpos:
db 17,19, 17,16, 18,13, 20,10, 23,6, 28,3
db 32,3, 37,6, 40,10, 42,13, 43,16, 43,19
db 20,19, 20,16, 22,13, 24,10, 28,7
db 32,7, 36,10, 38,13, 40,16, 40,19
db 23,19, 23,16, 25,13, 28,10
db 32,10, 35,13, 37,16, 37,19
manleft:
db $.......1
db $.......1
db $.....111
db $....11.1
db $...11111
db $...11111
db $.....111
db $.......1
db $...11111
db $111...11
db $.......1
db $......1.
db $.....1..
db $...111..
db $........
manright:
db $1.......
db $1.......
db $111.....
db $1.11....
db $11111...
db $11111...
db $111.....
db $1.......
db $11111...
db $11...111
db $1.......
db $.1......
db $..1.....
db $..111...
db $........
handleft:
db $11.1....
db $..1.....
db $...1....
db $....1...
db $..11.1..
db $....1...
db $....1...
db $....1...
db $....11.1
db $......1.
db $.....1..
db $....1...
handright:
db $1.11....
db $.1......
db $..1.....
db $...1....
db $..1.11..
db $...1....
db $...1....
db $...1....
db $....1.11
db $.....1..
db $....1...
db $...1....
ball:
db $11......
db $11......
crushleft:
db $11......
db $1.......
db $..1.1..1
db $...1..11
crushright:
db $......11
db $.......1
db $1..1.1..
db $11..1...
Raw
TESTC8.ASM
; Testing CHIP-8 graphics and keypad move.
; 12346789 to move a ball around.
; 5 to reset its position.
; C to toggle dodge mode.
; Assembler: chipper testc8
option chip8
option binary
byte equ #ff
bsize equ ballend-ball
bhalf equ bsize/2
start: cls
ld v5, 0 ; move flag
ld v6, 0 ; mode flag
ld v7, 0 ; laser type
ld v8, 0 ; laser x
ld v9, 0 ; laser y
ld va, 0 ; laser v
ld vb, 0 ; key flag
ld i, ball ; draws initial ball
ld v0, 31-bhalf ; ball x
ld v1, 16-bhalf ; ball y
ld v2, v0 ; prev x
ld v3, v1 ; prev y
drw v0, v1, bsize
sceneloop:
sne v6, 0 ; checks dodge mode
jp waitkey
rnd v4, 15 ; random stops
sne v4, 0
jp waitkey
call initlaser
sne v7, 0
jp waitkey
ld i, hlaser ; laser moves
drw v8, v9, 1
add v8, va
sne v8, 0
ld v7, 0
sne v8, 60
ld v7, 0
sne v7, 0
jp waitkey
drw v8, v9, 1
sne vf, 0
jp waitkey
ld v7, 0 ; laser hit
drw v8, v9, 1
ld v4, 3
ld st, v4
jp start
waitkey: ; Checks keys
ld v4, 4
sknp v4
call movel
ld v4, 6
sknp v4
call mover
ld v4, 2
sknp v4
call moveu
ld v4, 8
sknp v4
call moved
ld v4, 1
sknp v4
call movelu
ld v4, 3
sknp v4
call moveru
ld v4, 9
sknp v4
call moverd
ld v4, 7
sknp v4
call moveld
ld v4, 5
sknp v4
jp start
ld v4, #c
sknp v4
ld vb, 1
se vb, 1
jp moveball
sknp v4
jp moveball
ld vb, 0 ; on key C down and up
call toggle
moveball:
ld v5, 0 ; Checks if ball moved
se v0, v2
ld v5, 1
se v1, v3
ld v5, 1
sne v5, 0
jp sceneloop
ld i, ball
se v6, 0
ld i, pien
drw v2, v3, bsize ; hides old ball
drw v0, v1, bsize ; draws at new position
ld v2, v0
ld v3, v1
jp sceneloop
initlaser:
se v7, 0
ret
ld v7, 1 ; laser type
rnd v8, 1
ld va, 1 ; laser v
sne v8, 0
ld va, -1 &byte ; 1=to left laser
sne v8, 0
ld v8, 60 ; laser x
rnd v9, 31 ; laser y
ld i, hlaser
drw v8, v9, 1
ret
toggle:
ld i, ball
se v6, 0
ld i, pien
drw v2, v3, bsize
ld v4, 1
xor v6, v4
ld i, ball
se v6, 0
ld i, pien
drw v2, v3, bsize
sne v7, 0
ret
ld i, hlaser
drw v8, v9, 1
ld v7, 0
ret
movelu: add v0, -1 &byte
moveu: add v1, -1 &byte
ret
moveru: add v1, -1 &byte
mover: add v0, 1
ret
moveld: add v1, 1
movel: add v0, -1 &byte
ret
moverd: add v0, 1
moved: add v1, 1
ret
align off
ball:
db $..11....
db $.1111...
db $111111..
db $111111..
db $.1111...
db $..11....
ballend:
pien:
db $.1111...
db $111111..
db $1.11.1..
db $111111..
db $11..11..
db $.1111...
hlaser: db $1111....
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment