142 lines
3.9 KiB
Fennel
142 lines
3.9 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.footer)
|
|
(util.reload :game.map)
|
|
(util.reload :game.entity)
|
|
|
|
(local {: walkable : neutable} 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 0x0a0a)
|
|
(vm:var :jaye-dir 0xff00)
|
|
(vm:var :neut-yx 0x0b08)
|
|
(vm:var :current-rexx 0)
|
|
|
|
(local controlstate {
|
|
:jaye 0
|
|
:neut 1
|
|
:rexx 2
|
|
:count 3
|
|
})
|
|
|
|
(vm:var :controlstate [:db controlstate.jaye])
|
|
(vm:word :is-jaye? :controlstate :bget controlstate.jaye :=)
|
|
(vm:word :is-neut? :controlstate :bget controlstate.neut :=)
|
|
(vm:word :is-rexx? :controlstate :bget controlstate.rexx :=)
|
|
(vm:word :is-prog? :is-neut? :is-rexx? :|)
|
|
(vm:word :neut-hidden? :neut-yx :get 0xffff :=)
|
|
|
|
(vm:word :player-tile ; -- ptile
|
|
:controlstate :bget
|
|
(vm:case [controlstate.jaye :jaye-tile]
|
|
[controlstate.neut :neut-tile]
|
|
[:else :lit :t-rexx]))
|
|
|
|
(vm:word :player-yx ; -- pyx
|
|
:controlstate :bget
|
|
(vm:case [controlstate.jaye :jaye-yx]
|
|
[controlstate.neut :neut-yx]
|
|
[:else :current-rexx :dup (vm:when :get)]))
|
|
|
|
(vm:word :draw-player ; --
|
|
:player-yx :dup (vm:if [:get :dup 0xffff := (vm:if [:drop] [:yx>screen :player-tile :drawtile])] [:drop]))
|
|
|
|
(vm:word :set-player-dir ; dir --
|
|
:is-jaye? (vm:if [:jaye-dir :set] [:drop]))
|
|
|
|
(vm:word :movable-player-flag ; -- flag
|
|
:is-neut? (vm:if [neutable] [walkable]))
|
|
|
|
(vm:word :move-player-to ; yx --
|
|
:player-yx :dup :get :drawtile-at
|
|
:set :draw-player)
|
|
|
|
(vm:word :try-move-player ; dir --
|
|
:dup :set-player-dir ; dir
|
|
:player-yx :get :yx+ ; yxnew
|
|
(vm:if-or [[:dup :touch-entity] [:dup :movable-player-flag :flag-at? :not]]
|
|
[:drop :player-yx :get])
|
|
; always "move" so that player can visibly change direction
|
|
; touch-entity can modify player-yx so we have to refetch
|
|
:move-player-to)
|
|
|
|
(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 :neut-tile :lit :neut1) ; todo: animate
|
|
|
|
(vm:word :flag-at? ; yx flag -- f
|
|
:swap :itile-at :lookup-flags :&)
|
|
|
|
(vm:word :swap-player
|
|
(vm:ifchain [:is-prog?] [controlstate.jaye]
|
|
[:neut-hidden?] [controlstate.jaye]
|
|
[:current-rexx :get] [controlstate.rexx]
|
|
[controlstate.neut]) :controlstate :bset)
|
|
|
|
(vm:word :player-key ; key --
|
|
(vm:ifchain
|
|
[:dup (string.byte " ") :=] [:drop :swap-player]
|
|
[:movement-dir :dup]
|
|
[:player-yx :get :swap ; oldyx dir
|
|
:try-move-player
|
|
:dup :player-yx :get := :not (vm:if [:untouch-entity] [:drop])]
|
|
[:drop]))
|
|
|
|
(vm:word :full-redraw :drawmap :player-redraw)
|
|
(vm:word :player-redraw
|
|
:controlstate :bget
|
|
controlstate.count (vm:for (vm:i) :controlstate :bset :draw-player)
|
|
:controlstate :bset)
|
|
|
|
(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:word :handle-key :read-key :player-key :hide-footer)
|
|
|
|
(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.level2)
|
|
|
|
(prg:assemble)
|
|
|