honeylisp/game/defs.fnl

(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 tiles (require :game.tiles))

(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 say [portrait ...]
  (local result [:vm :show-footer :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)

(local itile
  (let [tilelist (tiles.loadgfx tiles.fn-tiles)]
    (fn [label] (tiles.find-itile tilelist label))))

{: vm : prg : mapw : maph : mon : org : achar : astr : rot8l : deflevel : say : itile}