|
|
@ -3,7 +3,7 @@
|
|
|
|
; http://devernay.free.fr/hacks/chip8/C8TECH10.HTM
|
|
|
|
; http://devernay.free.fr/hacks/chip8/C8TECH10.HTM
|
|
|
|
; http://mattmik.com/files/chip8/mastering/chip8.html
|
|
|
|
; http://mattmik.com/files/chip8/mastering/chip8.html
|
|
|
|
|
|
|
|
|
|
|
|
(define (explode-bytes val)
|
|
|
|
(define (split-bytes val)
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(zero? val) (list 0)]
|
|
|
|
[(zero? val) (list 0)]
|
|
|
|
[else
|
|
|
|
[else
|
|
|
@ -17,21 +17,21 @@
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
(module+ test
|
|
|
|
(require rackunit)
|
|
|
|
(require rackunit)
|
|
|
|
(check-equal? (explode-bytes #x2B45) (list #x2 #xB #x4 #x5))
|
|
|
|
(check-equal? (split-bytes #x2B45) (list #x2 #xB #x4 #x5))
|
|
|
|
(check-equal? (explode-bytes #xCD) (list #xC #xD))
|
|
|
|
(check-equal? (split-bytes #xCD) (list #xC #xD))
|
|
|
|
(check-equal? (explode-bytes #xA) (list #xA))
|
|
|
|
(check-equal? (split-bytes #xA) (list #xA))
|
|
|
|
(check-equal? (explode-bytes #x0) (list #x0)))
|
|
|
|
(check-equal? (split-bytes #x0) (list #x0)))
|
|
|
|
|
|
|
|
|
|
|
|
(define (glue-bytes bytes)
|
|
|
|
(define (join-bytes bytes)
|
|
|
|
(for/sum ([b (in-list (reverse bytes))]
|
|
|
|
(for/sum ([b (in-list (reverse bytes))]
|
|
|
|
[i (in-naturals)])
|
|
|
|
[i (in-naturals)])
|
|
|
|
(* b (expt 16 i))))
|
|
|
|
(* b (expt 16 i))))
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
(module+ test
|
|
|
|
(check-equal? #x2B45 (glue-bytes (list #x2 #xB #x4 #x5)))
|
|
|
|
(check-equal? #x2B45 (join-bytes (list #x2 #xB #x4 #x5)))
|
|
|
|
(check-equal? #xCD (glue-bytes (list #xC #xD)))
|
|
|
|
(check-equal? #xCD (join-bytes (list #xC #xD)))
|
|
|
|
(check-equal? #xA (glue-bytes (list #xA)))
|
|
|
|
(check-equal? #xA (join-bytes (list #xA)))
|
|
|
|
(check-equal? #x0 (glue-bytes (list #x0))))
|
|
|
|
(check-equal? #x0 (join-bytes (list #x0))))
|
|
|
|
|
|
|
|
|
|
|
|
(define-macro (define-memory-vector ID [FIELD LENGTH SIZE] ...)
|
|
|
|
(define-macro (define-memory-vector ID [FIELD LENGTH SIZE] ...)
|
|
|
|
(with-pattern
|
|
|
|
(with-pattern
|
|
|
@ -50,7 +50,7 @@
|
|
|
|
(define (PREFIXED-ID-REF idx)
|
|
|
|
(define (PREFIXED-ID-REF idx)
|
|
|
|
(unless (< idx LENGTH)
|
|
|
|
(unless (< idx LENGTH)
|
|
|
|
(raise-argument-error 'PREFIXED-ID-REF (format "index less than field length ~a" LENGTH) idx))
|
|
|
|
(raise-argument-error 'PREFIXED-ID-REF (format "index less than field length ~a" LENGTH) idx))
|
|
|
|
(glue-bytes
|
|
|
|
(join-bytes
|
|
|
|
(for/list ([i (in-range SIZE)])
|
|
|
|
(for/list ([i (in-range SIZE)])
|
|
|
|
(vector-ref ID (+ FIELD-OFFSET i idx)))))
|
|
|
|
(vector-ref ID (+ FIELD-OFFSET i idx)))))
|
|
|
|
...
|
|
|
|
...
|
|
|
@ -60,19 +60,38 @@
|
|
|
|
(unless (< val (expt 16 SIZE))
|
|
|
|
(unless (< val (expt 16 SIZE))
|
|
|
|
(raise-argument-error 'PREFIXED-ID-SET! (format "value less than field size ~a" (expt 16 SIZE)) val))
|
|
|
|
(raise-argument-error 'PREFIXED-ID-SET! (format "value less than field size ~a" (expt 16 SIZE)) val))
|
|
|
|
(for ([i (in-range SIZE)]
|
|
|
|
(for ([i (in-range SIZE)]
|
|
|
|
[b (in-list (explode-bytes val))])
|
|
|
|
[b (in-list (split-bytes val))])
|
|
|
|
(vector-set! ID (+ FIELD-OFFSET i idx) b))) ...)))
|
|
|
|
(vector-set! ID (+ FIELD-OFFSET i idx) b))) ...)))
|
|
|
|
|
|
|
|
|
|
|
|
(define-memory-vector chip
|
|
|
|
(define-memory-vector chip8
|
|
|
|
[opcode 1 2] ; two bytes
|
|
|
|
[opcode 1 2] ; two bytes
|
|
|
|
[memory 4096 1] ; one byte per
|
|
|
|
[memory 4096 1] ; one byte per
|
|
|
|
[V 16 1] ; one byte per
|
|
|
|
[V 16 1] ; one byte per
|
|
|
|
[I 3 1] ; index register, 0x000 to 0xFFF
|
|
|
|
[I 2 1] ; index register, 0x000 to 0xFFF (1.5 bytes)
|
|
|
|
[pc 3 1] ; program counter, 0x000 to 0xFFF
|
|
|
|
[pc 2 1] ; program counter, 0x000 to 0xFFF (1.5 bytes)
|
|
|
|
[gfx (* 64 32) 1] ; pixels
|
|
|
|
[gfx (* 64 32) 1] ; pixels
|
|
|
|
[delay_timer 1 1]
|
|
|
|
[delay_timer 1 1]
|
|
|
|
[sound_timer 1 1]
|
|
|
|
[sound_timer 1 1]
|
|
|
|
[stack 16 2] ; 2 bytes each
|
|
|
|
[stack 16 2] ; 2 bytes each
|
|
|
|
[sp 1 1] ; stack pointer
|
|
|
|
[sp 1 2] ; stack pointer
|
|
|
|
[key 16 1]) ; keys
|
|
|
|
[key 16 1]) ; keys
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Set up render system and register input callbacks
|
|
|
|
|
|
|
|
;(setup-graphics chip8)
|
|
|
|
|
|
|
|
;(setup-input chip8)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Initialize the Chip8 system and load the game into the memory
|
|
|
|
|
|
|
|
;(initialize chip8)
|
|
|
|
|
|
|
|
;(load-game chip8 "pong")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Emulation loop
|
|
|
|
|
|
|
|
#;(let loop ()
|
|
|
|
|
|
|
|
;; Emulate one cycle
|
|
|
|
|
|
|
|
(emulate-cycle chip8)
|
|
|
|
|
|
|
|
;; If the draw flag is set, update the screen
|
|
|
|
|
|
|
|
(when (draw-flag? chip8)
|
|
|
|
|
|
|
|
(draw-graphics chip8))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; Store key press state (Press and Release)
|
|
|
|
|
|
|
|
(set-keys chip8)
|
|
|
|
|
|
|
|
(loop))
|