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

full-screen draw speed test

Browse source
This commit is contained in:
Jeremy Penner 2021-09-06 23:23:45 -04:00
parent a03c8b2865
commit ba03b74278
2 changed files with 18 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
neutgs/init.fnl
View file

@ -38,7 +38,7 @@
(const screen-addr 0xe12000) (const screen-addr 0xe12000)
(const screen-size 0x9d00) (const screen-size 0x9d00)
(asm tiles (bytes [(. files.game.tiles 1 :gfx)])) (asm tiles [(lume.concat [:flatten] (icollect [_ tile (ipairs files.game.tiles)] [:bytes tile.gfx]))])
(form set-palette [(fn [ssc index pal] (form set-palette [(fn [ssc index pal]
(let [addr (+ 0xe19e00 (* index 0x20)) (let [addr (+ 0xe19e00 (* index 0x20))
@ -65,10 +65,12 @@
(yield) (yield)
(set! i (+ i 1))))) (set! i (+ i 1)))))
(fn draw-test-tiles () (form itile-to-tile [(fn [ssc itile] [:block (ssc:expr-word itile) [:asl] [:asl] [:asl] [:asl] [:asl] [:asl] [:asl] [:clc] [:adc #($1:lookup-addr :tiles)]])])
(fn draw-test-tiles (i)
(let (x 0 y 0 screen 0x2000) (let (x 0 y 0 screen 0x2000)
(while (< y 12) (while (< y 12)
(draw-tile (ref tiles) screen) (draw-tile (itile-to-tile (& (+ x y i) 3)) screen)
(set! x (+ x 1)) (set! x (+ x 1))
(if (= x 20) (if (= x 20)
(do (set! x 0) (do (set! x 0)
@ -76,6 +78,13 @@
(set! screen (+ screen [(+ 8 (* 160 15))]))) (set! screen (+ screen [(+ 8 (* 160 15))])))
(set! screen (+ screen 8)))))) (set! screen (+ screen 8))))))
(fn draw-test-tiles-forever ()
(let (i 0)
(while true
(draw-test-tiles i)
(yield)
(set! i (+ i 1)))))
(fn main () (fn main ()
(LoadTools (far-ref toolsets)) (LoadTools (far-ref toolsets))
(set! userID (MMStartUp)) (set! userID (MMStartUp))
@ -84,14 +93,16 @@
(QDStartUp 0x2100 0 0 userID) (QDStartUp 0x2100 0 0 userID)
(EMStartUp 0x2000 0 0 320 0 200 userID) (EMStartUp 0x2000 0 0 320 0 200 userID)
(GrafOn) (GrafOn)
(ClearScreen 0) (ClearScreen 0)
(set-palette 0 [pal]) (set-palette 0 [pal])
(SetAllSCBs 0) (SetAllSCBs 0)
(wait-for-key) (wait-for-key)
(draw-test-tiles) (let (tile-task (new-task (ref draw-test-tiles-forever)))
(wait-for-key) (wait-for-key)
(set! (word-at (ref :0xc035)) (& (word-at (ref :0xc035)) 0xf7))
(wait-for-key)
(reset-task tile-task (ref yield-forever)))
(GrafOff) (GrafOff)

2
ssc/init.fnl
View file

@ -71,7 +71,7 @@
c-setup (when opgen.setup (opgen.setup)) c-setup (when opgen.setup (opgen.setup))
c-hi (when opgen.hi [(opgen.hi :lda) [:pha]]) c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])
loc {: name :type (if c-hi :word :placeholder)} loc {: name :type (if c-hi :word :placeholder)}
_ (table.insert self.locals loc) _ (table.insert self.locals loc) ; if we push a high word onto the stack it shifts stack offsets
c-lo [(opgen.lo :lda) [:pha]]] c-lo [(opgen.lo :lda) [:pha]]]
(set loc.type etype) (set loc.type etype)
(lume.concat [:block c-setup] c-hi c-lo))) (lume.concat [:block c-setup] c-hi c-lo)))