honeylisp/game/defs.fnl
2020-12-31 11:49:52 -05:00

129 lines
2.9 KiB
Fennel

(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 0x4000)
:font (prg:org 0x4f00)
:map (prg:org 0x5100)
:entity (prg:org 0x5200)
:levelcode (prg:org 0x5300)
:code vm.code
})
(local controlstate {
:jaye 0
:neut 1
:rexx 2
:gord 3
:libb 4
:count 5
})
(local style {
:normal 0x80
:inverse 0x00
:flashing 0x40
})
(fn str-with-style [s stylebits]
(-> [(string.byte s 1 -1)]
(lume.map #(bit.bor (bit.band $1 0x3f) stylebits))
(-> (table.unpack) (string.char))))
(fn achar [c] (bit.bor (string.byte c) style.normal))
(fn astr [s ?style] (str-with-style s (or ?style style.normal)))
(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)
(set level.vm.code (level:org org.levelcode.org))
level)
(fn say-runon [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))]))
result)
(fn say [portrait ...]
(local result (say-runon portrait ...))
(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 : style : rot8l : deflevel : say : say-runon : itile : controlstate}