Modularize game code
This commit is contained in:
parent
de5a5b38b5
commit
3f30ac91c6
103
game/defs.fnl
Normal file
103
game/defs.fnl
Normal 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}
|
||||
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(local util (require :lib.util))
|
||||
(local tiles (util.require :game.tiles))
|
||||
|
||||
(local {: vm : org} (require :game.defs))
|
||||
(local {: lo : hi} util)
|
||||
(local itile
|
||||
(let [tilelist (tiles.loadgfx tiles.fn-tiles)]
|
||||
|
|
@ -24,13 +24,13 @@
|
|||
:deact 2
|
||||
: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)]
|
||||
[:lda #(hi org.entity.org)]
|
||||
[:sta vm.TOPH :x])
|
||||
(vm:word :entity-at ; yx -- entity|0
|
||||
:>r 0 :entity-count
|
||||
|
|
@ -79,7 +79,10 @@
|
|||
: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]
|
||||
(each [_ entity (ipairs map.objects)]
|
||||
|
|
@ -91,5 +94,5 @@
|
|||
(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]))))
|
||||
|
||||
{: ev : install : append-from-map}
|
||||
{: ev : append-from-map}
|
||||
|
||||
|
|
|
|||
142
game/gfx.fnl
Normal file
142
game/gfx.fnl
Normal 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
286
game/init.fnl
|
|
@ -1,257 +1,14 @@
|
|||
(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 : vm : org : mapw : maph} (require :game.defs))
|
||||
|
||||
(local tile (util.reload :game.tiles))
|
||||
(local entity (util.reload :game.entity))
|
||||
(local link (require :link))
|
||||
(util.reload :game.gfx)
|
||||
(util.reload :game.map)
|
||||
(util.reload :game.entity)
|
||||
|
||||
(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:case [(string.byte "I") 0xff00]
|
||||
|
|
@ -331,7 +88,7 @@
|
|||
[:asl vm.TOP :x] [:rol :a] ;x2
|
||||
[:asl vm.TOP :x] [:rol :a] ;x4
|
||||
[:asl vm.TOP :x] [:rol :a] ;x8
|
||||
[:adc #(hi font-org.org)]
|
||||
[:adc #(hi org.font.org)]
|
||||
[:sta vm.TOPH :x])
|
||||
|
||||
(vm:word :draw-char ; pscreen c --
|
||||
|
|
@ -355,37 +112,16 @@
|
|||
(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
|
||||
(vm:word :dismiss-dialog :wait-for-return :cleartext)
|
||||
|
||||
(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)
|
||||
|
||||
(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)
|
||||
(tile.appendtiles org.tiles)
|
||||
(tile.appendgfx org.font (tile.loadgfx tile.fn-font))
|
||||
|
||||
; thought:
|
||||
; hotswap-safe debug stub at root of call stack
|
||||
; 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?
|
||||
(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 :interpret]
|
||||
[:vm :hires
|
||||
|
|
@ -397,5 +133,7 @@
|
|||
)
|
||||
:quit])
|
||||
|
||||
(util.reload :game.level1)
|
||||
|
||||
(prg:assemble)
|
||||
|
||||
|
|
|
|||
5
game/level1.fnl
Normal file
5
game/level1.fnl
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(local {: deflevel} (require :game.defs))
|
||||
|
||||
(local level (deflevel "game/map00001.json"))
|
||||
|
||||
level
|
||||
39
game/map.fnl
Normal file
39
game/map.fnl
Normal 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)
|
||||
|
||||
|
|
@ -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}]}
|
||||
|
|
@ -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":[]}]
|
||||
Loading…
Reference in a new issue