honeylisp/game/init.fnl

207 lines
6.2 KiB
Plaintext
Raw Normal View History

2020-11-27 02:34:05 +00:00
(local util (require :lib.util))
(local {: lo : hi : readjson} util)
(local lume (require :lib.lume))
2020-11-27 04:33:14 +00:00
(local tile (util.reload :game.tiles))
2020-12-03 01:08:10 +00:00
(local {: prg : vm : org : mapw : maph : itile : controlstate} (util.reload :game.defs))
2020-11-27 04:46:36 +00:00
2020-11-27 04:33:14 +00:00
(util.reload :game.gfx)
2020-11-29 05:44:23 +00:00
(util.reload :game.footer)
2020-11-27 04:33:14 +00:00
(util.reload :game.map)
(util.reload :game.entity)
2020-12-12 01:53:46 +00:00
(local {: walkable : neutable : debris : sittable} 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)
2020-12-02 22:19:23 +00:00
(vm:var :rexx-yx 0xffff)
2020-12-10 14:11:46 +00:00
(vm:var :gord-yx 0xffff)
(vm:var :gord-dir 0x0000)
2020-12-12 01:53:46 +00:00
(vm:var :gord-sitting vm.false)
2020-11-29 05:44:23 +00:00
(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? :|)
2020-12-12 01:53:46 +00:00
(vm:word :is-walking? :movable-player-flag walkable :=)
2020-11-29 05:44:23 +00:00
(vm:word :neut-hidden? :neut-yx :get 0xffff :=)
2020-12-02 22:19:23 +00:00
(vm:word :rexx-active? :rexx-yx :get 0xffff := :not)
2020-12-10 14:11:46 +00:00
(vm:word :gord-hidden? :gord-yx :get 0xffff :=)
2020-12-12 01:53:46 +00:00
(vm:word :gord-following? :gord-hidden? :gord-sitting :get :| :not)
2020-12-02 22:19:23 +00:00
(vm:word :set-rexx ; e --
:dup (vm:if [:get controlstate.rexx] [:drop 0xffff controlstate.neut])
:controlstate :bset :rexx-yx :set)
(vm:word :player-tile ; -- ptile
:controlstate :bget
(vm:case [controlstate.jaye :jaye-tile]
[controlstate.neut :neut-tile]
2020-12-10 14:11:46 +00:00
[controlstate.gord :gord-tile]
[:else :lit :t-rexx]))
(vm:word :player-yx ; -- pyx
:controlstate :bget
(vm:case [controlstate.jaye :jaye-yx]
[controlstate.neut :neut-yx]
2020-12-10 14:11:46 +00:00
[controlstate.gord :gord-yx]
2020-12-02 22:19:23 +00:00
[:else :rexx-yx]))
(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 --
2020-12-02 22:19:23 +00:00
:player-yx :dup :get :dup 0xffff := (vm:if [:drop] [:drawtile-at])
:set :draw-player)
2020-12-12 01:53:46 +00:00
(vm:word :transition-gord-sitting ; yx f --
controlstate.gord :controlstate :bset
:gord-sitting :set :move-player-to
controlstate.jaye :controlstate :bset)
2020-12-17 03:59:55 +00:00
(vm:word :move-rexx-trash ; yx -- f
(vm:if-and [[:dup debris :flag-at?] [:is-rexx?]]
[(itile :t-floor) :update-itile] [:drop])
vm.false)
(vm:word :move-gord-sit ; yx -- f
(vm:if-and [[:dup sittable :flag-at?] [:is-jaye?] [:gord-following?]]
[vm.true :transition-gord-sitting vm.true]
[:move-noop]))
(vm:word :move-gord-stand ; yx -- f
(vm:if-and [[:gord-yx :get :=] [:is-jaye?] [:gord-sitting :get]]
[:jaye-yx :get vm.false :transition-gord-sitting 0 :gord-dir :set vm.true]
[vm.false]))
(vm:word :move-noop :drop vm.false)
2020-12-10 14:11:46 +00:00
(vm:word :handle-special-move ; yx -- f
2020-12-17 03:59:55 +00:00
(vm:if-or [[:dup :map-specific-move] [:dup :move-rexx-trash] [:dup :move-gord-sit] [:dup :move-gord-stand]]
[:drop vm.true] [:move-noop]))
2020-12-02 22:19:23 +00:00
2020-12-12 16:55:22 +00:00
(vm:def :yxclip? ; yx -- f
[:block
[:lda vm.TOP :x]
[:cmp mapw]
[:bcs :clipped]
[:lda vm.TOPH :x]
[:cmp maph]
[:bcs :clipped]
[:lda 0] [:sta vm.TOP :x] [:sta vm.TOPH :x] (vm:ret)
:clipped
[:lda 0xff] [:sta vm.TOP :x] [:sta vm.TOPH :x]])
(vm:word :try-move-player ; dir --
:dup :set-player-dir ; dir
:player-yx :get :yx+ ; yxnew
2020-12-12 16:55:22 +00:00
(vm:if-or [[:dup :yxclip?] [:dup :touch-entity] [:dup :handle-special-move] [: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]))
2020-12-10 14:11:46 +00:00
(vm:word :gord-tile ; ptile
2020-12-12 01:53:46 +00:00
:gord-sitting :get
(vm:if [:lit :gord-sit]
[:gord-dir :get
(vm:case [0xff00 :lit :gord-n]
[0x0100 :lit :gord-s]
[0x00ff :lit :gord-w]
[:else :lit :gord-e])]))
2020-12-10 14:11:46 +00:00
2020-11-29 05:44:23 +00:00
(vm:word :neut-tile :lit :neut1) ; todo: animate
(vm:word :flag-at? ; yx flag -- f
:swap :itile-at :lookup-flags :&)
2020-12-02 22:19:23 +00:00
(vm:word :toggle-player
(vm:ifchain [:is-prog?] [controlstate.jaye]
[:rexx-active?] [controlstate.rexx]
[:neut-hidden?] [controlstate.jaye]
[controlstate.neut]) :controlstate :bset)
2020-11-29 05:44:23 +00:00
2020-12-10 14:11:46 +00:00
(vm:word :party-follow
2020-12-12 01:53:46 +00:00
(vm:if-and [[:is-jaye?] [:gord-following?]]
2020-12-10 14:11:46 +00:00
[controlstate.gord :controlstate :bset
:gord-yx :get :gord-dir :get :yx+ :move-player-to
:jaye-dir :get :gord-dir :set
controlstate.jaye :controlstate :bset]))
2020-11-29 05:44:23 +00:00
(vm:word :player-key ; key --
(vm:ifchain
2020-12-02 22:19:23 +00:00
[:dup (string.byte " ") :=] [:drop :toggle-player]
2020-12-12 01:53:46 +00:00
[:dup (string.byte "Z") :=] [:drop :trigger-sidekick]
[:movement-dir :dup]
[:player-yx :get :swap ; oldyx dir
:try-move-player
2020-12-12 01:53:46 +00:00
:dup :player-yx :get := (vm:if [:drop] [:party-follow :untouch-entity])]
2020-11-29 05:44:23 +00:00
[: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)
2020-11-22 03:50:11 +00:00
2020-11-27 04:33:14 +00:00
(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
2020-10-12 15:48:14 +00:00
2020-12-15 04:14:35 +00:00
(vm:word :handle-key :tick :read-key :player-key :hide-footer)
(vm:word :tick :map-specific-tick)
2020-12-03 01:08:10 +00:00
(vm:word :load-level
:lit :map-jaye-yx :get :jaye-yx :set
:lit :map-neut-yx :get :neut-yx :set
2020-12-12 01:53:46 +00:00
:lit :map-gord-yx :get :gord-yx :set
0 :gord-dir :set
2020-12-03 01:08:10 +00:00
0xffff :rexx-yx :set
:full-redraw)
2020-11-27 04:33:14 +00:00
(vm.code:append :main
[:jsr :reset]
[:jsr :interpret]
[:vm :hires
2020-12-03 01:08:10 +00:00
:load-level
(vm:forever
2020-12-03 01:08:10 +00:00
(vm:hotswap-sync :load-level)
2020-11-17 20:35:41 +00:00
:interactive-eval-checkpoint
:handle-key
)
:quit])
2020-12-12 16:55:22 +00:00
(util.reload :game.level5)
2020-11-27 04:33:14 +00:00
(prg:assemble)
2020-11-02 00:39:31 +00:00