honeylisp/game/init.fnl

(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 0x080f)
(vm:var :jaye-dir 0xff00)
(vm:var :neut-yx 0xffff)
(local controlstate {
  :jaye 0
  :neut 1
})
(vm:var :controlstate [:db controlstate.jaye])
(vm:word :is-jaye? :controlstate :bget controlstate.jaye :=)
(vm:word :is-neut? :controlstate :bget controlstate.neut :=)
(vm:word :neut-hidden? :neut-yx :get 0xffff :=)

(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 :move-jaye-to ; yx --
  :jaye-yx :get :drawtile-at
  :dup :jaye-yx :set :draw-jaye-yx)

(vm:word :neut-tile :lit :neut1) ; todo: animate

(vm:word :draw-neut-yx ; yx --
  :yx>screen :neut-tile :drawtile)

(vm:word :move-neut-to ; yx --
  :neut-yx :get :drawtile-at
  :dup :neut-yx :set :draw-neut-yx)

(vm:word :move-jaye ; --
  :jaye-dir :get :jaye-yx :get :yx+ :move-jaye-to)

(vm:word :flag-at? ; yx flag -- f
  :swap :itile-at :lookup-flags :&)

(vm:word :try-move-jaye ; dir --
  :dup :jaye-dir :set ; dir
  :jaye-yx :get       ; dir yx
  :yx+ ; yxnew
  (vm:if-or [[:dup :touch-entity] [:dup walkable :flag-at? :not]]
    [:drop :jaye-yx :get])
  ; always "move" so that jaye visibly changes direction
  ; touch-entity can modify jaye-yx so we have to refetch
  :move-jaye-to)

(vm:word :try-move-neut ; dir --
  :neut-yx :get :yx+
  (vm:if-and [[:dup :touch-entity :not] [:dup neutable :flag-at?]]
    [:move-neut-to] [:drop]))

(vm:word :swap-player :neut-hidden? :not :is-jaye? :& (vm:if [controlstate.neut] [controlstate.jaye]) :controlstate :bset)

(vm:word :player-key ; key --
  (vm:ifchain
    [:dup (string.byte " ") :=] [:drop :swap-player]
    [:movement-dir :dup] [:is-jaye? (vm:if [:try-move-jaye] [:try-move-neut])]
    [:drop]))

(vm:word :full-redraw :drawmap :object-redraw)
(vm:word :object-redraw :jaye-yx :get :draw-jaye-yx)

(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.level1)

(prg:assemble)