(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 { ; :level (prg:org 0x5100) :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]]) ; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end for metadata (fn append-map [map org label] (org:append [:align 0x100] label [:bytes (map.map:fromhex)] [:db (length map.objects)] [:dw (tiles.encode-yx map.jaye)] [:dw (tiles.encode-yx map.neut)] [:dw (if map.gord-following (tiles.encode-yx map.jaye) 0xffff)] [:jmp (if (= (or map.tickword "") "") :next map.tickword)] [:jmp (if (= (or map.moveword "") "") :move-noop map.moveword)] [:jmp (if (= (or map.loadword "") "") :next map.loadword)])) (vm.code:append :map-ptr [:db 0] :map-page [:db 0]) (vm:word :map :lit :map-ptr :get) (vm:word :entity-count :map 240 :+ :bget) (vm:word :map-jaye-yx :map 241 :+ :get) (vm:word :map-neut-yx :map 243 :+ :get) (vm:word :map-gord-yx :map 245 :+ :get) (vm:word :map-specific-tick :map 247 :+ :execute) (vm:word :map-specific-move :map 250 :+ :execute) (vm:word :map-specific-load :map 253 :+ :execute) (fn deflevel [mapfile label] (local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay (local org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation (local map (readjson mapfile)) (local entity (require :game.entity)) (append-map map org label) (entity.append-from-map map org label) (set level.vm.code 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}