honeylisp/bitsy/player.fnl

81 lines
2.4 KiB
Plaintext
Raw Normal View History

2020-12-22 04:24:39 +00:00
(local tile (require :game.tiles))
(local {: vm : mapw : maph : itile : controlstate} (require :bitsy.defs))
2020-12-22 04:24:39 +00:00
(local {: walkable} (tile.flag-to-bit))
2020-12-22 04:24:39 +00:00
2021-04-25 16:12:57 +00:00
(vm:word :either= ; target val1 val2 -- f
:>rot :over := :>rot := :|)
2020-12-22 04:24:39 +00:00
(vm:word :movement-dir ; key -- dyx
2021-04-25 16:12:57 +00:00
(vm:ifchain [:dup (string.byte "I") 0x0b :either=] [:drop 0xff00]
[:dup (string.byte "J") 0x08 :either=] [:drop 0x00ff]
[:dup (string.byte "K") 0x15 :either=] [:drop 0x0001]
[:dup (string.byte "M") 0x0a :either=] [:drop 0x0100]
[:drop 0x0000]))
2020-12-22 04:24:39 +00:00
(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 :player-yx 0x0a0a)
2020-12-22 04:24:39 +00:00
(vm:word :draw-player ; --
:player-yx :dup (vm:if [:get :dup 0xffff := (vm:if [:drop] [:yx>screen :player-tile :drawtile])] [:drop]))
2021-02-12 02:38:57 +00:00
(vm:var :noclip)
(vm:word :move-if-clear ; yx -- f
:noclip :get (vm:if [:drop vm.false] [:movable-player-flag :flag-at? :not]))
(vm:const :movable-player-flag ; -- flag
walkable)
2020-12-22 04:24:39 +00:00
(vm:word :move-player-to ; yx --
:player-yx :dup :get :dup 0xffff := (vm:if [:drop] [:drawtile-at])
:set :draw-player)
(vm:word :move-noop :drop vm.false)
(vm:word :handle-general-move ; yx -- f
(vm:if-or [[:dup :map-specific-move] [:dup :move-if-clear]]
2020-12-22 04:24:39 +00:00
[:drop vm.true] [:move-noop]))
(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 --
:player-yx :get :yx+ ; yxnew
(vm:if-or [[:dup :yxclip?] [:dup :touch-entity] [:dup :handle-general-move]]
2020-12-22 04:24:39 +00:00
[: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 :two-frame :tick-count :get 0x1f :& 0x10 :<)
(vm:word :player-tile ; -- ptile
2021-04-18 04:09:31 +00:00
(itile :player-frame1) :lookup-tile)
2020-12-22 04:24:39 +00:00
(vm:word :flag-at? ; yx flag -- f
:swap :itile-at :lookup-flags :&)
(vm:word :player-key ; key --
2021-04-25 16:12:57 +00:00
(vm:ifchain [:movement-dir :dup] [:try-move-player :load-next-level]
2020-12-22 04:24:39 +00:00
[:drop]))
(vm:word :full-redraw :drawmap :player-redraw)
(vm:word :player-redraw :draw-player)