140 lines
3.4 KiB
Fennel
140 lines
3.4 KiB
Fennel
(local util (require :lib.util))
|
|
(local {: lo : hi : readjson} util)
|
|
(local lume (require :lib.lume))
|
|
(local tile (util.reload :game.tiles))
|
|
(local {: prg : vm : org : mapw : maph} (util.reload :game.defs))
|
|
|
|
(util.reload :game.gfx)
|
|
(util.reload :game.map)
|
|
(util.reload :game.entity)
|
|
|
|
(local {: walkable} tile.flag-to-bit)
|
|
|
|
(vm:word :movement-dir ; key -- dyx
|
|
(vm:case [(string.byte "I") 0xff00]
|
|
[(string.byte "J") 0x00ff]
|
|
[(string.byte "K") 0x0001]
|
|
[(string.byte "M") 0x0100]
|
|
[:else 0x0000]))
|
|
|
|
(vm:def :yx+ ; yx yx -- yx
|
|
[:lda vm.TOP :x]
|
|
[:clc] [:adc vm.ST1 :x]
|
|
[:sta vm.ST1 :x]
|
|
[:lda vm.TOPH :x]
|
|
[:clc] [:adc vm.ST1H :x]
|
|
[:sta vm.ST1H :x]
|
|
(vm:drop))
|
|
|
|
(vm:var :jaye-yx 0x090a)
|
|
(vm:var :jaye-dir 0xff00)
|
|
|
|
(vm:word :jaye-tile ; ptile
|
|
:jaye-dir :get
|
|
(vm:case [0xff00 :lit :jaye-n]
|
|
[0x0100 :lit :jaye-s]
|
|
[0x00ff :lit :jaye-w]
|
|
[:else :lit :jaye-e]))
|
|
|
|
(vm:word :draw-jaye-yx ; yx --
|
|
:yx>screen :jaye-tile :drawtile)
|
|
|
|
(vm:word :handle-key :read-key :move-jaye)
|
|
(vm:word :bump-jaye ; dir yx --
|
|
:yx+ ; yxnew
|
|
:dup :touch-entity :not
|
|
(vm:if
|
|
[:dup :itile-at :lookup-flags ; yxnew flags
|
|
walkable :& (vm:if [:move-player-to] [:drop])]
|
|
[:drop]))
|
|
|
|
(vm:word :move-player-to ; yx --
|
|
:jaye-yx :get :drawtile-at
|
|
:dup :jaye-yx :set
|
|
:yx>screen :jaye-tile :drawtile)
|
|
|
|
(vm:word :move-player ; --
|
|
:jaye-dir :get :jaye-yx :get :yx+ :move-player-to)
|
|
|
|
(vm:word :move-jaye ; key --
|
|
:movement-dir :dup (vm:if [
|
|
:dup :jaye-dir :set ; dir
|
|
:jaye-yx :get ; dir yx
|
|
:bump-jaye
|
|
] [:drop]))
|
|
|
|
(vm:word :full-redraw :drawmap :object-redraw)
|
|
(vm:word :object-redraw :jaye-yx :get :draw-jaye-yx)
|
|
|
|
(vm:def :draw-pchar ; pscreen pchar --
|
|
[:block
|
|
[:ldy 7] [:clc]
|
|
: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]
|
|
]
|
|
(vm:drop) (vm:drop))
|
|
|
|
(vm:def :lookup-pchar ; c -- pchar
|
|
[:sec]
|
|
[:lda vm.TOP :x]
|
|
[:sbc 0x20]
|
|
[:sta vm.TOP :x]
|
|
[:lda 0]
|
|
[:asl vm.TOP :x] [:rol :a] ;x2
|
|
[:asl vm.TOP :x] [:rol :a] ;x4
|
|
[:asl vm.TOP :x] [:rol :a] ;x8
|
|
[:adc #(hi org.font.org)]
|
|
[:sta vm.TOPH :x])
|
|
|
|
(vm:word :draw-char ; pscreen c --
|
|
:lookup-pchar :draw-pchar)
|
|
|
|
(vm:word :snooze (vm:for))
|
|
(vm:word :textsnooze 0x40 :snooze)
|
|
(vm:word :draw-text1 0x2257 :draw-text)
|
|
(vm:word :draw-text2 0x22d7 :draw-text)
|
|
(vm:word :draw-text3 0x2357 :draw-text)
|
|
(vm:word :draw-text4 0x23d7 :draw-text)
|
|
(vm:word :draw-text ; st pscreen --
|
|
(vm:while [:over :bget :dup] ; st pscreen c
|
|
:over :swap :draw-char ; st pscreen
|
|
:textsnooze
|
|
:inc :swap :inc :swap)
|
|
:drop :drop :drop)
|
|
(vm:word :cleartext
|
|
0x2257 :clearline 0x22d7 :clearline 0x2357 :clearline 0x23d7 :clearline)
|
|
|
|
(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
|
|
(vm:word :dismiss-dialog :wait-for-return :cleartext)
|
|
|
|
(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?
|
|
|
|
(vm.code:append :main
|
|
[:jsr :reset]
|
|
[:jsr :interpret]
|
|
[:vm :hires
|
|
:full-redraw
|
|
(vm:forever
|
|
(vm:hotswap-sync :full-redraw)
|
|
:interactive-eval-checkpoint
|
|
:handle-key
|
|
)
|
|
:quit])
|
|
|
|
(util.reload :game.level1)
|
|
|
|
(prg:assemble)
|
|
|