SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

fix test program

Browse source
This commit is contained in:
Jeremy Penner 2021-12-11 13:51:31 -05:00
parent 38023f8828
commit 3e87f231bc
3 changed files with 17 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
neutgs/game.json
View file

File diff suppressed because one or more lines are too long

46
neutgs/init.fnl
View file

@ -41,10 +41,10 @@
(define screen-addr 0xe12000) (define screen-addr 0xe12000)
(define screen-size 0x9d00) (define screen-size 0x9d00)
(compile-sprite tile0 [(. files.game.tiles 1 :gfx)] 16 16) (compile-sprite tile0 [(. files.game.iso 3 :gfx)] 24 32)
(compile-sprite tile1 [(. files.game.tiles 2 :gfx)] 16 16) (compile-sprite tile1 [(. files.game.iso 5 :gfx)] 24 32)
(compile-sprite tile2 [(. files.game.tiles 3 :gfx)] 16 16) (compile-sprite tile2 [(. files.game.iso 11 :gfx)] 24 32)
(compile-sprite tile3 [(. files.game.tiles 4 :gfx)] 16 16) (compile-sprite tile3 [(. files.game.iso 12 :gfx)] 24 32)
(asm tiles (jmp tile0) (nop) (jmp tile1) (nop) (jmp tile2) (nop) (jmp tile3) (nop)) (asm tiles (jmp tile0) (nop) (jmp tile1) (nop) (jmp tile2) (nop) (jmp tile3) (nop))
(form set-palette [(fn [ssc index pal] (form set-palette [(fn [ssc index pal]
@ -69,32 +69,16 @@
(fn draw-test-tiles (i) (fn draw-test-tiles (i)
(when with-shadowing (disable-shadow-writes)) (when with-shadowing (disable-shadow-writes))
(let (x 0 y 0 screen 0x2000) (let (x 0 y 0 screen 0x2000)
(while (< y 37) (while (< y 26)
(let (tile (itile-to-tile (& (+ x y i) 3))) (let (tile (itile-to-tile (& (+ x y i) 3)))
(draw-object screen tile)) (draw-object screen tile))
(set! x (+ x 1)) (set! x (+ x 1))
(if (= x 20) (if (= x 12)
(do (set! y (+ y 1)) (do (set! y (+ y 1))
(set! x (if (& y 1) 1 0)) (set! x 0)
(set! screen (+ screen [(+ 12 (* 160 4))]))) (set! screen (+ screen (if (& y 1) [(+ (- 160 (* 11 12)) (* 160 5) 6)]
(set! screen (+ screen 8))))) [(+ (- 160 6 (* 11 12)) (* 160 5))]))))
(when with-shadowing (set! screen (+ screen 12))))))
(enable-shadow-writes)
(if (= with-shadowing 1)
(let (x 0 y 0 screen 0x2000)
(while (< y 12)
(draw-object screen pei-slam-tile)
(set! x (+ x 1))
(if (= x 20)
(do (set! x 0)
(set! y (+ y 1))
(set! screen (+ screen [(+ 8 (* 1 60 15))])))
(set! screen (+ screen 8)))))
(let (screen 0x2000 y 0)
(while (< y 200)
(draw-object screen pei-slam-scanline)
(set! screen (+ screen 160))
(set! y (+ y 1)))))))
(fn draw-test-tiles-forever () (fn draw-test-tiles-forever ()
(let (i 0) (let (i 0)
@ -126,11 +110,11 @@
(wait-for-key) (wait-for-key)
(let (tile-task (new-task (ref draw-test-tiles-forever))) (let (tile-task (new-task (ref draw-test-tiles-forever)))
(wait-for-key) (wait-for-key)
(set! with-shadowing 1) ; (set! with-shadowing 1)
(wait-for-key) ; (wait-for-key)
(set! with-shadowing 2) ; (set! with-shadowing 2)
(wait-for-key) ; (wait-for-key)
(set! with-shadowing false) ; (set! with-shadowing false)
(reset-task tile-task (ref yield-forever)) (reset-task tile-task (ref yield-forever))
(wait-for-key)) (wait-for-key))

2
ssc/iigs/graphics.fnl
View file

@ -104,7 +104,7 @@
(phd) ; save direct page register (phd) ; save direct page register
(tsc) (sta draw-object-saved-stack) ; save stack (tsc) (sta draw-object-saved-stack) ; save stack
(lda screen 2) ; we offset by 2 because we just pushed a word onto the stack and the compiler doesn't know about it (lda screen 2) ; we offset by 2 because we just pushed a word onto the stack and the compiler doesn't know about it
(tcs) ; drawfns expect the current screen pointer to be stored in the stack register (tcs) ; drawfns expect the current screen pointer to be stored in the stack register
(lda :0xc068) (ora 0x30) (sta :0xc068) ; move bank 1 to bank 0 (lda :0xc068) (ora 0x30) (sta :0xc068) ; move bank 1 to bank 0
(clc) ; clear carry - all drawfns will add to the stack pointer and then walk it back (clc) ; clear carry - all drawfns will add to the stack pointer and then walk it back
draw-object-current-object-jump draw-object-current-object-jump