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

Modularize game code

Browse source
This commit is contained in:
Jeremy Penner 2020-11-26 23:33:14 -05:00
parent de5a5b38b5
commit 3f30ac91c6
8 changed files with 358 additions and 328 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

103
game/defs.fnl Normal file
View file

@ -0,0 +1,103 @@
(local util (require :lib.util))
(local {: lo : hi : readjson} util)
(local lume (require :lib.lume))
(local asm (require :asm.asm))
(local VM (require :asm.vm))
(local prg (asm.new))
(local vm (VM.new prg))
(local mapw 20)
(local maph 12)
(local mon {
:hexout :0xfdda
:putchar :0xfded
:bell :0xff3a
})
(local org {
:tiles (prg:org 0x4100)
:font (prg:org 0x4900)
:map (prg:org 0x4800)
:entity (prg:org 0x4b00)
:code vm.code
})
(fn achar [c] (bit.bor (string.byte c) 0x80))
(fn astr [s]
(-> [(string.byte s 1 -1)]
(lume.map #(bit.bor $1 0x80))
(-> (table.unpack) (string.char))))
(fn rot8l [n] ; clears carry
(local block [:block [:clc]])
(for [_ 1 n] (table.insert block [:block [:asl :a] [:adc 0]]))
block)
; a handful of debugging words
(vm:def :.
[:lda vm.TOPH :x]
[:jsr mon.hexout]
[:lda vm.TOP :x]
[:jsr mon.hexout]
[:lda (achar " ")]
[:jsr mon.putchar]
(vm:drop))
(vm:def :stacklen
(vm:reserve)
[:txa] [:lsr :a] [:sta vm.TOP :x]
[:lda 0] [:sta vm.TOPH :x])
(vm:word :.s
:stacklen (prg:parse-addr vm.TOP) :swap
(vm:for :dup :get :. :inc :inc) :drop)
; input words
(vm:def :last-key ; -- key
(vm:reserve)
[:lda :0xc000]
[:and 0x7f]
[:sta vm.TOP :x]
[:lda 0]
[:sta vm.TOPH :x])
(vm:def :read-key ; -- key|0
[:block
(vm:reserve)
[:lda :0xc000]
[:bmi :key-pressed]
[:lda 0]
[:sta vm.TOP :x]
[:sta vm.TOPH :x]
(vm:ret)
:key-pressed
[:and 0x7f]
[:sta vm.TOP :x]
[:lda 0]
[:sta vm.TOPH :x]
[:sta :0xc010]])
(fn deflevel [mapfile]
(local level prg) ; todo: (asm.new prg)
(local map-org (level:org org.map.org))
(local entity-org (level:org org.entity.org))
(local map (readjson mapfile))
(local tile (require :game.tiles))
(local entity (require :game.entity))
(tile.append-map map map-org)
(entity.append-from-map map entity-org)
level)
(fn with-footer [...] [:vm :drawfooter [:vm ...] :clearfooter])
(fn say [portrait ...]
(local result [:vm :lit (.. :p portrait) :draw-portrait])
(local lines [...])
(local ilineOffset (if (< (length lines) 4) 1 0))
(each [iline line (ipairs lines)]
(table.insert result [:vm (vm:str line) (.. :draw-text (+ iline ilineOffset))]))
(table.insert result :dismiss-dialog)
result)
{: vm : prg : mapw : maph : mon : org : achar : astr : rot8l : deflevel : with-footer : say}

107
game/entity.fnl
View file

@ -1,6 +1,6 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local tiles (util.require :game.tiles)) (local tiles (util.require :game.tiles))
(local {: vm : org} (require :game.defs))
(local {: lo : hi} util) (local {: lo : hi} util)
(local itile (local itile
(let [tilelist (tiles.loadgfx tiles.fn-tiles)] (let [tilelist (tiles.loadgfx tiles.fn-tiles)]
@ -24,62 +24,65 @@
:deact 2 :deact 2
:tog 3 :tog 3
}) })
(fn install [vm entity-org]
(vm:word :entity-count :lit :map-entity-count :bget)
(vm:def :lookup-entity ; i -- entity
[:lda vm.TOP :x]
[:asl :a] [:asl :a] [:asl :a] ; x8
[:sta vm.TOP :x]
[:lda #(hi entity-org.org)]
[:sta vm.TOPH :x])
(vm:word :entity-at ; yx -- entity|0
:>r 0 :entity-count
(vm:while [:dup] :dec ; entity|0 i
:dup :lookup-entity :get :rtop :=
(vm:when :lookup-entity :swap)
) :drop :rdrop)
(vm.code:append :responder [:dw 0])
(vm:word :get-responder :lit :responder :get)
(vm:word :responder-itile :get-responder :get :itile-at)
(vm:word :entity>do ; entity ev --
:over :lit :responder :dup :get :>r :set
:swap 2 :+ :get :execute
:r> :lit :responder :set)
(vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:dup :. :execute] [:drop 6 :+ :dup :. :get]) :dup :.) (vm:word :entity-count :lit :map-entity-count :bget)
(vm:word :touch-entity ; yx -- f (vm:def :lookup-entity ; i -- entity
:entity-at :dup (vm:when ev.touch :entity>do vm.true)) [:lda vm.TOP :x]
[:asl :a] [:asl :a] [:asl :a] ; x8
[:sta vm.TOP :x]
[:lda #(hi org.entity.org)]
[:sta vm.TOPH :x])
(vm:word :entity-at ; yx -- entity|0
:>r 0 :entity-count
(vm:while [:dup] :dec ; entity|0 i
:dup :lookup-entity :get :rtop :=
(vm:when :lookup-entity :swap)
) :drop :rdrop)
(vm.code:append :responder [:dw 0])
(vm:word :get-responder :lit :responder :get)
(vm:word :responder-itile :get-responder :get :itile-at)
(vm:word :entity>do ; entity ev --
:over :lit :responder :dup :get :>r :set
:swap 2 :+ :get :execute
:r> :lit :responder :set)
(vm:word :set-entitytile ; e itile -- (vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:dup :. :execute] [:drop 6 :+ :dup :. :get]) :dup :.)
:swap :get :swap :update-itile) (vm:word :touch-entity ; yx -- f
:entity-at :dup (vm:when ev.touch :entity>do vm.true))
(vm:word :set-respondertile ; itile -- (vm:word :set-entitytile ; e itile --
:get-responder :get :swap :update-itile) :swap :get :swap :update-itile)
(vm:word :handle-onoff ; ev off on -- (vm:word :set-respondertile ; itile --
:<rot (vm:case :get-responder :get :swap :update-itile)
[ev.act :swap :drop :set-respondertile]
[ev.deact :drop :set-respondertile]
[ev.tog :dup :responder-itile := (vm:if [:drop :set-respondertile] [:set-respondertile :drop])]
[:else :drop :drop]))
(vm:word :activation-ev? ; ev -- f
:dup ev.act := :over ev.deact := :| :swap ev.tog := :|)
(vm:word :activate-link ; ev itile-on --
:swap :activation-ev? (vm:if [
:responder-itile :dup :. := (vm:if [ev.act] [ev.deact])
:linked-entity :swap :entity>do
] [:drop]))
(vm:word :door ; ev -- (vm:word :handle-onoff ; ev off on --
:dup :. :dup (vm:case :<rot (vm:case
[ev.touch :drop :responder-itile (itile :dooropen) := (vm:when :move-player)] [ev.act :swap :drop :set-respondertile]
[:else (itile :doorclosed) (itile :dooropen) :handle-onoff])) [ev.deact :drop :set-respondertile]
[ev.tog :dup :responder-itile := (vm:if [:drop :set-respondertile] [:set-respondertile :drop])]
[:else :drop :drop]))
(vm:word :activation-ev? ; ev -- f
:dup ev.act := :over ev.deact := :| :swap ev.tog := :|)
(vm:word :activate-link ; ev itile-on --
:swap :activation-ev? (vm:if [
:responder-itile :dup :. := (vm:if [ev.act] [ev.deact])
:linked-entity :swap :entity>do
] [:drop]))
(vm:word :switch ; ev -- (vm:word :door ; ev --
:dup ev.touch := (vm:when :drop ev.tog) :dup :. :dup (vm:case
:dup (itile :switchoff) (itile :switchon) :handle-onoff [ev.touch :drop :responder-itile (itile :dooropen) := (vm:when :move-player)]
(itile :switchon) :activate-link) [:else (itile :doorclosed) (itile :dooropen) :handle-onoff]))
)
(vm:word :switch ; ev --
:dup ev.touch := (vm:when :drop ev.tog)
:dup (itile :switchoff) (itile :switchon) :handle-onoff
(itile :switchon) :activate-link)
(vm:word :term ; ev --
:dup ev.touch := (vm:when :drop ev.act)
:dup (itile :termoff) (itile :termon) :handle-onoff)
(fn append-from-map [map entity-org] (fn append-from-map [map entity-org]
(each [_ entity (ipairs map.objects)] (each [_ entity (ipairs map.objects)]
@ -91,5 +94,5 @@
(if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0]) (if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
(if entity.link [:dw (+ entity-org.org (* (- entity.link 1) 8))] [:dw 0])))) (if entity.link [:dw (+ entity-org.org (* (- entity.link 1) 8))] [:dw 0]))))
{: ev : install : append-from-map} {: ev : append-from-map}

142
game/gfx.fnl Normal file
View file

@ -0,0 +1,142 @@
(local {: lo : hi} (require :lib.util))
(local {: vm : mapw : maph : org} (require :game.defs))
; Graphics routines
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052])
(vm:def :mixed [:sta :0xc053])
; starting address:
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
; x between 0-19
; y between 0-12
; yx - 16-bit value, low byte x, high byte y
(vm.code:append :screeny-lookup [:bytes "\0\040\080"])
(vm:def :yx>screen ; yx -- p
[:lda vm.TOPH :x] ; a=y
[:lsr :a] [:lsr :a] ; a=y/4
[:tay] ; y=y/4
[:lda 0x03]
[:and vm.TOPH :x] ; a=y%4
[:ora 0x20] ; a=0x20 + y%4
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
[:lda vm.TOP :x] ; a=x
[:asl :a] ; a = x*2
[:clc]
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
[:sta vm.TOP :x] ; low byte is set
)
; note: the graphical tile data must not cross a page boundary
; (this happens automatically because each tile is 32 bytes and we
; start them on a page; this lets lookup-tile be fast)
(fn draw-block []
[:block
[:clc]
[:ldy 8]
:loop
[:lda [vm.TOP :x]]
[:sta [vm.ST1 :x]]
[:inc vm.TOP :x]
[:lda vm.ST1H :x]
[:adc 4]
[:sta vm.ST1H :x]
[:dey]
[:bne :loop]])
(fn draw-vertical-block []
[:block
(draw-block)
[:lda vm.ST1H :x]
[:sbc 31] ; with carry clear this is 32
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:ora 0x80]
[:sta vm.ST1 :x]
(draw-block)])
(vm:def :drawtile ; p gfx --
(draw-vertical-block)
[:lda vm.ST1H :x]
[:sbc 31]
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:sbc 0x7f]
[:sta vm.ST1 :x]
(draw-vertical-block)
(vm:drop) (vm:drop))
(vm:def :cleargfx
(vm:push 0x4000)
[:block :page
[:dec vm.TOPH :x]
[:lda 0]
[:block :start
[:sta [vm.TOP :x]]
[:inc vm.TOP :x]
[:bne :start]]
[:lda vm.TOPH :x]
[:cmp 0x20]
[:bne :page]]
(vm:drop))
(vm:def :clearline ; pscreen --
[:lda vm.TOP :x] [:sta vm.W]
[:lda vm.TOPH :x] [:sta vm.WH]
(vm:drop)
[:block
:row
[:ldy 0x27] [:lda 0]
:start
[:sta [vm.W] :y]
[:dey]
[:bpl :start]
[:lda vm.WH]
[:cmp 0x3d]
[:bcs :done]
; cmp has cleared carry for us here
[:lda 4] [:adc vm.WH] [:sta vm.WH]
[:bcc :row]
:done])
(vm:word :drawfooter
0x39d0 :clearline
0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
(vm:word :drawmaprow ; pscreen pmap -- pmap
mapw (vm:for
:2dup :bget :lookup-tile :drawtile
:inc :swap :inc :inc :swap) :swap :drop)
(vm:word :drawmap
:lit :map 0x0c00 (vm:until 0x100 :-
:dup :yx>screen ; pmap yx pscreen
:<rot :drawmaprow :swap ; pmap yx
:dup :not) :drop :drop)
(vm:word :clearfooter
:lit :map 0x0300 (vm:until 0x100 :-
:dup 0x0900 :+ :yx>screen
:<rot :drawmaprow :swap
:dup :not) :drop :drop :object-redraw)
(vm:def :lookup-tile ; itile -- ptile
; each tile is 32 bytes; 2^5
; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
[:lda vm.TOP :x] [:tay]
[:and 0x1f]
[:clc] [:adc #(hi org.tiles.org)]
[:sta vm.TOPH :x]
[:tya] [:and 0xe0]
[:sta vm.TOP :x])
(vm:word :draw-portrait ; pgfx
0x2252 :over :drawtile
0x2352 :over 32 :+ :drawtile
0x2254 :over 64 :+ :drawtile
0x2354 :swap 96 :+ :drawtile)

286
game/init.fnl
View file

@ -1,257 +1,14 @@
(local util (require :lib.util)) (local util (require :lib.util))
(local {: lo : hi : readjson} util) (local {: lo : hi : readjson} util)
(local lume (require :lib.lume)) (local lume (require :lib.lume))
(local asm (require :asm.asm)) (local {: prg : vm : org : mapw : maph} (require :game.defs))
(local VM (require :asm.vm))
(local tile (util.reload :game.tiles)) (local tile (util.reload :game.tiles))
(local entity (util.reload :game.entity)) (util.reload :game.gfx)
(local link (require :link)) (util.reload :game.map)
(util.reload :game.entity)
(local {: walkable} tile.flag-to-bit) (local {: walkable} tile.flag-to-bit)
(local prg (asm.new))
(local tiles-org (prg:org 0x4100))
(local map-org (prg:org 0x4800))
(local font-org (prg:org 0x4900))
(local entity-org (prg:org 0x4b00))
(local vm (VM.new prg))
(local code1 vm.code)
(local mapw 20)
(local maph 12)
(local mon {
:hexout :0xfdda
:putchar :0xfded
:bell :0xff3a
})
(fn achar [c] (bit.bor (string.byte c) 0x80))
(fn astr [s]
(-> [(string.byte s 1 -1)]
(lume.map #(bit.bor $1 0x80))
(-> (table.unpack) (string.char))))
; a handful of debugging words
(vm:def :.
[:lda vm.TOPH :x]
[:jsr mon.hexout]
[:lda vm.TOP :x]
[:jsr mon.hexout]
[:lda (achar " ")]
[:jsr mon.putchar]
(vm:drop))
(vm:def :stacklen
(vm:reserve)
[:txa] [:lsr :a] [:sta vm.TOP :x]
[:lda 0] [:sta vm.TOPH :x])
(vm:word :.s
:stacklen (prg:parse-addr vm.TOP) :swap
(vm:for :dup :get :. :inc :inc) :drop)
; Graphics routines
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052])
(vm:def :mixed [:sta :0xc053])
; starting address:
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
; x between 0-19
; y between 0-12
; yx - 16-bit value, low byte x, high byte y
(code1:append :screeny-lookup [:bytes "\0\040\080"])
(vm:def :yx>screen ; yx -- p
[:lda vm.TOPH :x] ; a=y
[:lsr :a] [:lsr :a] ; a=y/4
[:tay] ; y=y/4
[:lda 0x03]
[:and vm.TOPH :x] ; a=y%4
[:ora 0x20] ; a=0x20 + y%4
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
[:lda vm.TOP :x] ; a=x
[:asl :a] ; a = x*2
[:clc]
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
[:sta vm.TOP :x] ; low byte is set
)
; note: the graphical tile data must not cross a page boundary
; (this happens automatically because each tile is 32 bytes and we
; start them on a page; this lets lookup-tile be fast)
(fn draw-block []
[:block
[:clc]
[:ldy 8]
:loop
[:lda [vm.TOP :x]]
[:sta [vm.ST1 :x]]
[:inc vm.TOP :x]
[:lda vm.ST1H :x]
[:adc 4]
[:sta vm.ST1H :x]
[:dey]
[:bne :loop]])
(fn draw-vertical-block []
[:block
(draw-block)
[:lda vm.ST1H :x]
[:sbc 31] ; with carry clear this is 32
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:ora 0x80]
[:sta vm.ST1 :x]
(draw-block)])
(vm:def :drawtile ; p gfx --
(draw-vertical-block)
[:lda vm.ST1H :x]
[:sbc 31]
[:sta vm.ST1H :x]
[:lda vm.ST1 :x]
[:sbc 0x7f]
[:sta vm.ST1 :x]
(draw-vertical-block)
(vm:drop) (vm:drop))
(vm:def :cleargfx
(vm:push 0x4000)
[:block :page
[:dec vm.TOPH :x]
[:lda 0]
[:block :start
[:sta [vm.TOP :x]]
[:inc vm.TOP :x]
[:bne :start]]
[:lda vm.TOPH :x]
[:cmp 0x20]
[:bne :page]]
(vm:drop))
(vm:def :clearline ; pscreen --
[:lda vm.TOP :x] [:sta vm.W]
[:lda vm.TOPH :x] [:sta vm.WH]
(vm:drop)
[:block
:row
[:ldy 0x27] [:lda 0]
:start
[:sta [vm.W] :y]
[:dey]
[:bpl :start]
[:lda vm.WH]
[:cmp 0x3d]
[:bcs :done]
; cmp has cleared carry for us here
[:lda 4] [:adc vm.WH] [:sta vm.WH]
[:bcc :row]
:done])
(vm:word :drawfooter
0x39d0 :clearline
0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
(vm:word :drawmaprow ; pscreen pmap -- pmap
mapw (vm:for
:2dup :bget :lookup-tile :drawtile
:inc :swap :inc :inc :swap) :swap :drop)
(vm:word :drawmap
:lit :map 0x0c00 (vm:until 0x100 :-
:dup :yx>screen ; pmap yx pscreen
:<rot :drawmaprow :swap ; pmap yx
:dup :not) :drop :drop)
(vm:word :clearfooter
:lit :map 0x0300 (vm:until 0x100 :-
:dup 0x0900 :+ :yx>screen
:<rot :drawmaprow :swap
:dup :not) :drop :drop :object-redraw)
(vm:def :lookup-tile ; itile -- ptile
; each tile is 32 bytes; 2^5
; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
[:lda vm.TOP :x] [:tay]
[:and 0x1f]
[:clc] [:adc #(hi tiles-org.org)]
[:sta vm.TOPH :x]
[:tya] [:and 0xe0]
[:sta vm.TOP :x])
(fn rot8l [n] ; clears carry
(local block [:block [:clc]])
(for [_ 1 n] (table.insert block [:block [:asl :a] [:adc 0]]))
block)
(vm:def :lookup-flags ; itile -- flags
[:lda vm.TOP :x]
(rot8l 3) ; lllhhhhh > hhhhhlll
[:adc #(lo ($1:lookup-addr :tileflags))]
[:sta vm.W]
[:lda #(hi ($1:lookup-addr :tileflags))]
[:adc 0]
[:sta vm.WH]
[:ldy 0] [:lda [vm.W] :y]
[:sta vm.TOP :x])
(vm:def :map-at ; yx -- pmap
[:lda (- maph 1)]
[:sec]
[:sbc vm.TOPH :x]
[:asl :a] ; x2
[:asl :a] ; x4
[:sta vm.TOPH :x]
[:asl :a] ; x8
[:asl :a] ; x16
[:clc] [:adc vm.TOPH :x] ; x20
[:adc vm.TOP :x]
[:sta vm.TOP :x]
[:lda #(hi ($1:lookup-addr :map))]
[:sta vm.TOPH :x])
(vm:word :itile-at ; yx -- itile
:map-at :bget)
(vm:word :update-itile ; yx itile --
:over :map-at :bset :drawtile-at)
(vm:word :drawtile-at ; yx --
:dup :yx>screen :swap
:itile-at :lookup-tile
:drawtile)
(vm:word :draw-portrait ; pgfx
0x2252 :over :drawtile
0x2352 :over 32 :+ :drawtile
0x2254 :over 64 :+ :drawtile
0x2354 :swap 96 :+ :drawtile)
(vm:def :last-key ; -- key
(vm:reserve)
[:lda :0xc000]
[:and 0x7f]
[:sta vm.TOP :x]
[:lda 0]
[:sta vm.TOPH :x])
(vm:def :read-key ; -- key|0
[:block
(vm:reserve)
[:lda :0xc000]
[:bmi :key-pressed]
[:lda 0]
[:sta vm.TOP :x]
[:sta vm.TOPH :x]
(vm:ret)
:key-pressed
[:and 0x7f]
[:sta vm.TOP :x]
[:lda 0]
[:sta vm.TOPH :x]
[:sta :0xc010]])
(vm:word :movement-dir ; key -- dyx (vm:word :movement-dir ; key -- dyx
(vm:case [(string.byte "I") 0xff00] (vm:case [(string.byte "I") 0xff00]
@ -331,7 +88,7 @@
[:asl vm.TOP :x] [:rol :a] ;x2 [:asl vm.TOP :x] [:rol :a] ;x2
[:asl vm.TOP :x] [:rol :a] ;x4 [:asl vm.TOP :x] [:rol :a] ;x4
[:asl vm.TOP :x] [:rol :a] ;x8 [:asl vm.TOP :x] [:rol :a] ;x8
[:adc #(hi font-org.org)] [:adc #(hi org.font.org)]
[:sta vm.TOPH :x]) [:sta vm.TOPH :x])
(vm:word :draw-char ; pscreen c -- (vm:word :draw-char ; pscreen c --
@ -355,37 +112,16 @@
(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=)) (vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
(vm:word :dismiss-dialog :wait-for-return :cleartext) (vm:word :dismiss-dialog :wait-for-return :cleartext)
(fn with-footer [...] [:vm :drawfooter [:vm ...] :clearfooter]) (tile.appendtiles org.tiles)
(fn say [portrait ...] (tile.appendgfx org.font (tile.loadgfx tile.fn-font))
(local result [:vm :lit (.. :p portrait) :draw-portrait])
(local lines [...])
(local ilineOffset (if (< (length lines) 4) 1 0))
(each [iline line (ipairs lines)]
(table.insert result [:vm (vm:str line) (.. :draw-text (+ iline ilineOffset))]))
(table.insert result :dismiss-dialog)
result)
(entity.install vm entity-org)
(vm:word :hello-world
entity.ev.touch := (vm:when
(with-footer
(say :jaye "THAT WAS AN EARTHQUAKE!")
(say :neut "GOLLY GEE JAYE, YOU'RE RIGHT!" "WHAT ARE WE GONNA DO??")
(say :jaye "WE" "MUST" "NOT" "PANIC!!"))))
(tile.appendtiles tiles-org)
; thought: ; thought:
; hotswap-safe debug stub at root of call stack ; hotswap-safe debug stub at root of call stack
; but REPL debug stub should be very available as a task ; but REPL debug stub should be very available as a task
; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with? ; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with?
(local map (readjson "game/map00001.json"))
(tile.append-map map map-org)
(tile.appendgfx font-org (tile.loadgfx tile.fn-font))
(entity.append-from-map map entity-org)
(code1:append :main (vm.code:append :main
[:jsr :reset] [:jsr :reset]
[:jsr :interpret] [:jsr :interpret]
[:vm :hires [:vm :hires
@ -397,5 +133,7 @@
) )
:quit]) :quit])
(util.reload :game.level1)
(prg:assemble) (prg:assemble)

5
game/level1.fnl Normal file
View file

@ -0,0 +1,5 @@
(local {: deflevel} (require :game.defs))
(local level (deflevel "game/map00001.json"))
level

39
game/map.fnl Normal file
View file

@ -0,0 +1,39 @@
(local {: lo : hi} (require :lib.util))
(local {: vm : mapw : maph : rot8l} (require :game.defs))
(vm:def :lookup-flags ; itile -- flags
[:lda vm.TOP :x]
(rot8l 3) ; lllhhhhh > hhhhhlll
[:adc #(lo ($1:lookup-addr :tileflags))]
[:sta vm.W]
[:lda #(hi ($1:lookup-addr :tileflags))]
[:adc 0]
[:sta vm.WH]
[:ldy 0] [:lda [vm.W] :y]
[:sta vm.TOP :x])
(vm:def :map-at ; yx -- pmap
[:lda (- maph 1)]
[:sec]
[:sbc vm.TOPH :x]
[:asl :a] ; x2
[:asl :a] ; x4
[:sta vm.TOPH :x]
[:asl :a] ; x8
[:asl :a] ; x16
[:clc] [:adc vm.TOPH :x] ; x20
[:adc vm.TOP :x]
[:sta vm.TOP :x]
[:lda #(hi ($1:lookup-addr :map))]
[:sta vm.TOPH :x])
(vm:word :itile-at ; yx -- itile
:map-at :bget)
(vm:word :update-itile ; yx itile --
:over :map-at :bset :drawtile-at)
(vm:word :drawtile-at ; yx --
:dup :yx>screen :swap
:itile-at :lookup-tile
:drawtile)

2
game/map00001.json
View file

@ -1 +1 @@
{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"x":7,"link":2,"func":"switch","linkword":"","name":"","y":6},{"x":8,"func":"door","linkword":"","name":"","y":6}]} {"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"link":2,"y":6,"func":"switch","name":"","linkword":"","x":7},{"x":8,"func":"door","y":6,"linkword":"","name":""},{"x":2,"link":4,"func":"term","linkword":"","name":"","y":4},{"x":17,"link":3,"func":"term","linkword":"","name":"","y":8},{"x":13,"link":6,"func":"switch","linkword":"","name":"","y":8},{"x":13,"func":"door","linkword":"","name":"","y":9}]}

2
game/tiles.json
View file

@ -1 +1 @@
[{"gfx":"7F7F1F03090923436943230909031F7F7F7F784111104542174245101141787F","word":"","label":"neut1","flags":[]},{"gfx":"7F1F03090923436943230909031F7F7F7F784111104542174245101141787F7F","word":"","label":"neut2","flags":[]},{"gfx":"808080C0C0C0E0C0D0C8C04040404080808083058585828A9282820A08081980","word":"","label":"jaye-e","flags":[]},{"gfx":"8080C020A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","word":"","label":"jaye-w","flags":[]},{"gfx":"8080E030B0B098C0D0D0C840404060808080870D8D8D99828A8A920202020780","word":"","label":"jaye-s","flags":[]},{"gfx":"8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","word":"","label":"jaye-n","flags":[]},{"gfx":"80808C8080808080B08080808C808080808C80808083B0808080808080868080","word":"","label":"","flags":{"walkable":true}},{"gfx":"007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979584848400","word":"term","label":"","flags":[]},{"gfx":"007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979584848400","word":"term","label":"","flags":{"neutable":true}},{"gfx":"D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF","word":"","label":"","flags":{"neutable":true}},{"gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","word":"door","label":"doorclosed","flags":[]},{"gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","word":"door","label":"dooropen","flags":{"walkable":true}},{"gfx":"FFFFCFCFCFCF898183838787878FFFFFFFFCE4E4E4E4E0E0E0E0E0E0F0F8FFFF","word":"switch","label":"switchoff","flags":{"neutable":true}},{"gfx":"FFFFCFCFCFCF898123232727878FFFFFFFFCE4E4E4E0E0616565656571F8FFFF","word":"switch","label":"switchon","flags":{"neutable":true}},{"gfx":"FFFF83D3D3D3D3D3D3D3D3D3D383FFFFFFFFC0CACACECACBCACACACACAC0FFFF","word":"","label":"","flags":[]},{"gfx":"FFFFAFEBFBFBFBBBBBFBFBFBEBAFFFFFFFFFF5D7DFDFDFDDDDDFDFDFD7F5FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFFF2F2B2B2B6B6B6B6B2B2B2B2FFFFFFFFF755555555757575755555575FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFF3C78FBFFCF98187BFFFFFBF9F9FC7FFCFE1F1FCFCF8FEFEFCF9F0E6CE8F9F","word":"","label":"","flags":[]},{"gfx":"80808C80808080A8AAAAAAA888888880808C8080808380859595958584848480","word":"","label":"","flags":[]},{"gfx":"80808C8080A0A0A8AAAA8AA0A8808080808C8081919090848594959585858080","word":"","label":"","flags":{"debris":true}},{"gfx":"00005054545450404054545010383800000C0A2A2A2A0A03032A2A0A081C1C00","word":"","label":"","flags":[]},{"gfx":"0000001C1C10545040606010545454000030070702020A0A0100020A080A0200","word":"","label":"","flags":{"debris":true}},{"gfx":"80A0A8AA92D2D2AAC2C2AA92D2AA808080959595949494959494959494858080","word":"","label":"","flags":[]},{"gfx":"80808C808080A8C292AAAAAAAA8AC0D0808C80808083959290959194948580A8","word":"","label":"","flags":{"debris":true}},{"gfx":"80806008282A0800202880A8A8A8A08080980000141501051511819595958580","word":"","label":"","flags":[]},{"gfx":"80808C808080A0A8AAAA8AA2AAAAAA80808C0000000330010105051511010514","word":"","label":"","flags":{"debris":true}},{"gfx":"0000000000000000000000000000000000000000000000000000000000000000","word":"","label":"","flags":[]}] [{"gfx":"7F7F1F03090923436943230909031F7F7F7F784111104542174245101141787F","word":"","label":"neut1","flags":[]},{"gfx":"7F1F03090923436943230909031F7F7F7F784111104542174245101141787F7F","word":"","label":"neut2","flags":[]},{"gfx":"808080C0C0C0E0C0D0C8C04040404080808083058585828A9282820A08081980","word":"","label":"jaye-e","flags":[]},{"gfx":"8080C020A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","word":"","label":"jaye-w","flags":[]},{"gfx":"8080E030B0B098C0D0D0C840404060808080870D8D8D99828A8A920202020780","word":"","label":"jaye-s","flags":[]},{"gfx":"8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","word":"","label":"jaye-n","flags":[]},{"gfx":"80808C8080808080B08080808C808080808C80808083B0808080808080868080","word":"","label":"","flags":{"walkable":true}},{"gfx":"007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979584848400","word":"term","label":"termoff","flags":[]},{"gfx":"007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979584848400","word":"term","label":"termon","flags":{"neutable":true}},{"gfx":"D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF","word":"","label":"","flags":{"neutable":true}},{"gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","word":"door","label":"doorclosed","flags":[]},{"gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","word":"door","label":"dooropen","flags":{"walkable":true}},{"gfx":"FFFFCFCFCFCF898183838787878FFFFFFFFCE4E4E4E4E0E0E0E0E0E0F0F8FFFF","word":"switch","label":"switchoff","flags":{"neutable":true}},{"gfx":"FFFFCFCFCFCF898123232727878FFFFFFFFCE4E4E4E0E0616565656571F8FFFF","word":"switch","label":"switchon","flags":{"neutable":true}},{"gfx":"FFFF83D3D3D3D3D3D3D3D3D3D383FFFFFFFFC0CACACECACBCACACACACAC0FFFF","word":"","label":"","flags":[]},{"gfx":"FFFFAFEBFBFBFBBBBBFBFBFBEBAFFFFFFFFFF5D7DFDFDFDDDDDFDFDFD7F5FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFFF2F2B2B2B6B6B6B6B2B2B2B2FFFFFFFFF755555555757575755555575FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFF3C78FBFFCF98187BFFFFFBF9F9FC7FFCFE1F1FCFCF8FEFEFCF9F0E6CE8F9F","word":"","label":"","flags":[]},{"gfx":"80808C80808080A8AAAAAAA888888880808C8080808380859595958584848480","word":"","label":"","flags":[]},{"gfx":"80808C8080A0A0A8AAAA8AA0A8808080808C8081919090848594959585858080","word":"","label":"","flags":{"debris":true}},{"gfx":"00005054545450404054545010383800000C0A2A2A2A0A03032A2A0A081C1C00","word":"","label":"","flags":[]},{"gfx":"0000001C1C10545040606010545454000030070702020A0A0100020A080A0200","word":"","label":"","flags":{"debris":true}},{"gfx":"80A0A8AA92D2D2AAC2C2AA92D2AA808080959595949494959494959494858080","word":"","label":"","flags":[]},{"gfx":"80808C808080A8C292AAAAAAAA8AC0D0808C80808083959290959194948580A8","word":"","label":"","flags":{"debris":true}},{"gfx":"80806008282A0800202880A8A8A8A08080980000141501051511819595958580","word":"","label":"","flags":[]},{"gfx":"80808C808080A0A8AAAA8AA2AAAAAA80808C0000000330010105051511010514","word":"","label":"","flags":{"debris":true}},{"gfx":"0000000000000000000000000000000000000000000000000000000000000000","word":"","label":"","flags":[]}]