Working Neut! More control structures
This commit is contained in:
parent
c8531f9917
commit
53c3aac463
|
|
@ -148,6 +148,9 @@
|
|||
(fn dat-parser.flatten [flat block]
|
||||
(parse-dats block (lume.slice flat 2))
|
||||
nil)
|
||||
(fn dat-parser.export [label block]
|
||||
(tset block.globals (. label 2) true)
|
||||
nil)
|
||||
|
||||
(local pdat-processor {
|
||||
:op {}
|
||||
|
|
|
|||
37
asm/vm.fnl
37
asm/vm.fnl
|
|
@ -284,6 +284,11 @@
|
|||
:skip
|
||||
(vm:drop)
|
||||
[:lda 2] (add16 vm.IP vm.IPH) (vm:ret)
|
||||
:bnz [:export :bnz]
|
||||
[:lda vm.TOP :x]
|
||||
[:bne :dojmp]
|
||||
[:lda vm.TOPH :x]
|
||||
[:beq :skip]
|
||||
:dojmp (vm:drop)]
|
||||
:jmp
|
||||
; ugh I don't have enough registers for this; a (one-byte?) relative jump would maybe be better
|
||||
|
|
@ -315,6 +320,22 @@
|
|||
(fn vm.if [self iftrue iffalse]
|
||||
[:block [:vm :bz :_else (table.unpack iftrue)] [:vm :jmp :_end] :_else [:vm (table.unpack iffalse)] :_end])
|
||||
|
||||
(fn vm.ifchain [self ...]
|
||||
(local block [:block])
|
||||
(local cases [...])
|
||||
(for [i 1 (- (length cases) 1) 2]
|
||||
(local (test action) (values (. cases i) (. cases (+ i 1))))
|
||||
(table.insert block [:flatten
|
||||
(.. :_case i)
|
||||
[:vm (table.unpack test)]
|
||||
[:vm :bz (.. :_case (+ 2 i)) (table.unpack action)]
|
||||
[:vm :jmp :_end]]))
|
||||
(table.insert block [:flatten
|
||||
(.. :_case (length cases))
|
||||
[:vm (table.unpack (. cases (length cases)))]
|
||||
:_end])
|
||||
block)
|
||||
|
||||
(fn vm.case [self ...]
|
||||
(local block [:block])
|
||||
(local cases [...])
|
||||
|
|
@ -327,6 +348,22 @@
|
|||
(table.insert block :_end))))
|
||||
block)
|
||||
|
||||
(fn vm.if-or [self clauses iftrue iffalse]
|
||||
(local block [:block])
|
||||
(each [_ clause (ipairs clauses)]
|
||||
(table.insert block [:flatten [:vm (table.unpack clause)] [:vm :bnz :_whentrue]])) ; could bum two instructions here if no iffalse
|
||||
(table.insert block [:flatten [:vm (table.unpack (or iffalse []))] [:vm :jmp :_end]])
|
||||
(table.insert block [:flatten :_whentrue [:vm (table.unpack iftrue)] :_end])
|
||||
block)
|
||||
|
||||
(fn vm.if-and [self clauses iftrue iffalse]
|
||||
(local block [:block])
|
||||
(each [_ clause (ipairs clauses)]
|
||||
(table.insert block [:flatten [:vm (table.unpack clause)] [:vm :bz :_whenfalse]]))
|
||||
(table.insert block [:flatten [:vm (table.unpack iftrue)] [:vm :jmp :_end]])
|
||||
(table.insert block [:flatten :_whenfalse [:vm (table.unpack (or iffalse []))] :_end])
|
||||
block)
|
||||
|
||||
(fn vm.gensym [self]
|
||||
(local sym (.. "G-GEN-SYM-" self.nextsymid))
|
||||
(set self.nextsymid (+ self.nextsymid 1))
|
||||
|
|
|
|||
|
|
@ -90,9 +90,8 @@
|
|||
(entity.append-from-map map entity-org)
|
||||
level)
|
||||
|
||||
(fn with-footer [...] [:vm :drawfooter [:vm ...] :clearfooter])
|
||||
(fn say [portrait ...]
|
||||
(local result [:vm :lit (.. :p portrait) :draw-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)]
|
||||
|
|
@ -104,5 +103,5 @@
|
|||
(let [tilelist (tiles.loadgfx tiles.fn-tiles)]
|
||||
(fn [label] (tiles.find-itile tilelist label))))
|
||||
|
||||
{: vm : prg : mapw : maph : mon : org : achar : astr : rot8l : deflevel : with-footer : say : itile}
|
||||
{: vm : prg : mapw : maph : mon : org : achar : astr : rot8l : deflevel : say : itile}
|
||||
|
||||
|
|
|
|||
|
|
@ -68,17 +68,26 @@
|
|||
] [:drop]))
|
||||
|
||||
(vm:word :door ; ev --
|
||||
:dup :. :dup (vm:case
|
||||
[ev.touch :drop :responder-itile (itile :dooropen) := (vm:when :move-player)]
|
||||
[:else (itile :doorclosed) (itile :dooropen) :handle-onoff]))
|
||||
(vm:if-and [[:is-jaye?] [:dup ev.touch :=] [:responder-itile (itile :dooropen) :=]]
|
||||
[:move-jaye :drop]
|
||||
[(itile :doorclosed) (itile :dooropen) :handle-onoff]))
|
||||
|
||||
(vm:word :switch ; ev --
|
||||
:dup ev.touch := (vm:when :drop ev.tog)
|
||||
:dup ev.touch := (vm:when :drop ev.tog :is-neut? (vm:when :get-responder :get :move-neut-to))
|
||||
:dup (itile :switchoff) (itile :switchon) :handle-onoff
|
||||
(itile :switchon) :activate-link)
|
||||
|
||||
(vm:word :term ; ev --
|
||||
:dup ev.touch := (vm:when :drop ev.act)
|
||||
:dup ev.touch := (vm:when
|
||||
:is-jaye? (vm:if [
|
||||
:drop ev.act
|
||||
] [
|
||||
:linked-entity :dup :get :itile-at (itile :termon) := (vm:if [
|
||||
:get :move-neut-to
|
||||
] [
|
||||
:drop
|
||||
])
|
||||
]))
|
||||
:dup (itile :termoff) (itile :termon) :handle-onoff)
|
||||
|
||||
(fn append-from-map [map entity-org]
|
||||
|
|
|
|||
53
game/footer.fnl
Normal file
53
game/footer.fnl
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
(local {: vm : org} (require :game.defs))
|
||||
(local {: hi : lo} (require :lib.util))
|
||||
|
||||
(vm:def :draw-pchar ; pscreen pchar --
|
||||
[:block
|
||||
[:ldy 7] [:clc]
|
||||
:loop
|
||||
[:lda [vm.TOP :x]]
|
||||
[:sta [vm.ST1 :x]]
|
||||
[:inc vm.TOP :x]
|
||||
[:lda vm.ST1H :x] [:adc 4] [:sta vm.ST1H :x]
|
||||
[:dey]
|
||||
[:bne :loop]
|
||||
]
|
||||
(vm:drop) (vm:drop))
|
||||
|
||||
(vm:def :lookup-pchar ; c -- pchar
|
||||
[:sec]
|
||||
[:lda vm.TOP :x]
|
||||
[:sbc 0x20]
|
||||
[:sta vm.TOP :x]
|
||||
[:lda 0]
|
||||
[:asl vm.TOP :x] [:rol :a] ;x2
|
||||
[:asl vm.TOP :x] [:rol :a] ;x4
|
||||
[:asl vm.TOP :x] [:rol :a] ;x8
|
||||
[:adc #(hi org.font.org)]
|
||||
[:sta vm.TOPH :x])
|
||||
|
||||
(vm:word :draw-char ; pscreen c --
|
||||
:lookup-pchar :draw-pchar)
|
||||
|
||||
(vm:word :snooze (vm:for))
|
||||
(vm:word :textsnooze 0x30 :snooze)
|
||||
(vm:word :draw-text1 0x2257 :draw-text)
|
||||
(vm:word :draw-text2 0x22d7 :draw-text)
|
||||
(vm:word :draw-text3 0x2357 :draw-text)
|
||||
(vm:word :draw-text4 0x23d7 :draw-text)
|
||||
(vm:word :draw-text ; st pscreen --
|
||||
(vm:while [:over :bget :dup] ; st pscreen c
|
||||
:over :swap :draw-char ; st pscreen
|
||||
:textsnooze
|
||||
:inc :swap :inc :swap)
|
||||
:drop :drop :drop)
|
||||
(vm:word :cleartext
|
||||
0x2257 :clearline 0x22d7 :clearline 0x2357 :clearline 0x23d7 :clearline)
|
||||
|
||||
(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
|
||||
(vm:word :dismiss-dialog :wait-for-return :cleartext)
|
||||
|
||||
(vm:var :footer-displayed vm.false)
|
||||
(vm:word :show-footer :footer-displayed :get :not (vm:when vm.true :footer-displayed :set :drawfooter))
|
||||
(vm:word :hide-footer :footer-displayed :get (vm:when vm.false :footer-displayed :set :clearfooter))
|
||||
|
||||
119
game/init.fnl
119
game/init.fnl
|
|
@ -5,10 +5,11 @@
|
|||
(local {: prg : vm : org : mapw : maph} (util.reload :game.defs))
|
||||
|
||||
(util.reload :game.gfx)
|
||||
(util.reload :game.footer)
|
||||
(util.reload :game.map)
|
||||
(util.reload :game.entity)
|
||||
|
||||
(local {: walkable} tile.flag-to-bit)
|
||||
(local {: walkable : neutable} tile.flag-to-bit)
|
||||
|
||||
(vm:word :movement-dir ; key -- dyx
|
||||
(vm:case [(string.byte "I") 0xff00]
|
||||
|
|
@ -26,8 +27,17 @@
|
|||
[:sta vm.ST1H :x]
|
||||
(vm:drop))
|
||||
|
||||
(vm:var :jaye-yx 0x090a)
|
||||
(vm:var :jaye-yx 0x080f)
|
||||
(vm:var :jaye-dir 0xff00)
|
||||
(vm:var :neut-yx 0xffff)
|
||||
(local controlstate {
|
||||
:jaye 0
|
||||
:neut 1
|
||||
})
|
||||
(vm:var :controlstate [:db controlstate.jaye])
|
||||
(vm:word :is-jaye? :controlstate :bget controlstate.jaye :=)
|
||||
(vm:word :is-neut? :controlstate :bget controlstate.neut :=)
|
||||
(vm:word :neut-hidden? :neut-yx :get 0xffff :=)
|
||||
|
||||
(vm:word :jaye-tile ; ptile
|
||||
:jaye-dir :get
|
||||
|
|
@ -39,79 +49,51 @@
|
|||
(vm:word :draw-jaye-yx ; yx --
|
||||
:yx>screen :jaye-tile :drawtile)
|
||||
|
||||
(vm:word :handle-key :read-key :move-jaye)
|
||||
(vm:word :bump-jaye ; dir yx --
|
||||
:yx+ ; yxnew
|
||||
:dup :touch-entity :not
|
||||
(vm:if
|
||||
[:dup :itile-at :lookup-flags ; yxnew flags
|
||||
walkable :& (vm:if [:move-player-to] [:drop])]
|
||||
[:drop]))
|
||||
|
||||
(vm:word :move-player-to ; yx --
|
||||
(vm:word :move-jaye-to ; yx --
|
||||
:jaye-yx :get :drawtile-at
|
||||
:dup :jaye-yx :set
|
||||
:yx>screen :jaye-tile :drawtile)
|
||||
:dup :jaye-yx :set :draw-jaye-yx)
|
||||
|
||||
(vm:word :move-player ; --
|
||||
:jaye-dir :get :jaye-yx :get :yx+ :move-player-to)
|
||||
(vm:word :neut-tile :lit :neut1) ; todo: animate
|
||||
|
||||
(vm:word :move-jaye ; key --
|
||||
:movement-dir :dup (vm:if [
|
||||
:dup :jaye-dir :set ; dir
|
||||
:jaye-yx :get ; dir yx
|
||||
:bump-jaye
|
||||
] [:drop]))
|
||||
(vm:word :draw-neut-yx ; yx --
|
||||
:yx>screen :neut-tile :drawtile)
|
||||
|
||||
(vm:word :move-neut-to ; yx --
|
||||
:neut-yx :get :drawtile-at
|
||||
:dup :neut-yx :set :draw-neut-yx)
|
||||
|
||||
(vm:word :move-jaye ; --
|
||||
:jaye-dir :get :jaye-yx :get :yx+ :move-jaye-to)
|
||||
|
||||
(vm:word :flag-at? ; yx flag -- f
|
||||
:swap :itile-at :lookup-flags :&)
|
||||
|
||||
(vm:word :try-move-jaye ; dir --
|
||||
:dup :jaye-dir :set ; dir
|
||||
:jaye-yx :get ; dir yx
|
||||
:yx+ ; yxnew
|
||||
(vm:if-or [[:dup :touch-entity] [:dup walkable :flag-at? :not]]
|
||||
[:drop :jaye-yx :get])
|
||||
; always "move" so that jaye visibly changes direction
|
||||
; touch-entity can modify jaye-yx so we have to refetch
|
||||
:move-jaye-to)
|
||||
|
||||
(vm:word :try-move-neut ; dir --
|
||||
:neut-yx :get :yx+
|
||||
(vm:if-and [[:dup :touch-entity :not] [:dup neutable :flag-at?]]
|
||||
[:move-neut-to] [:drop]))
|
||||
|
||||
(vm:word :swap-player :neut-hidden? :not :is-jaye? :& (vm:if [controlstate.neut] [controlstate.jaye]) :controlstate :bset)
|
||||
|
||||
(vm:word :player-key ; key --
|
||||
(vm:ifchain
|
||||
[:dup (string.byte " ") :=] [:drop :swap-player]
|
||||
[:movement-dir :dup] [:is-jaye? (vm:if [:try-move-jaye] [:try-move-neut])]
|
||||
[:drop]))
|
||||
|
||||
(vm:word :full-redraw :drawmap :object-redraw)
|
||||
(vm:word :object-redraw :jaye-yx :get :draw-jaye-yx)
|
||||
|
||||
(vm:def :draw-pchar ; pscreen pchar --
|
||||
[:block
|
||||
[:ldy 7] [:clc]
|
||||
:loop
|
||||
[:lda [vm.TOP :x]]
|
||||
[:sta [vm.ST1 :x]]
|
||||
[:inc vm.TOP :x]
|
||||
[:lda vm.ST1H :x] [:adc 4] [:sta vm.ST1H :x]
|
||||
[:dey]
|
||||
[:bne :loop]
|
||||
]
|
||||
(vm:drop) (vm:drop))
|
||||
|
||||
(vm:def :lookup-pchar ; c -- pchar
|
||||
[:sec]
|
||||
[:lda vm.TOP :x]
|
||||
[:sbc 0x20]
|
||||
[:sta vm.TOP :x]
|
||||
[:lda 0]
|
||||
[:asl vm.TOP :x] [:rol :a] ;x2
|
||||
[:asl vm.TOP :x] [:rol :a] ;x4
|
||||
[:asl vm.TOP :x] [:rol :a] ;x8
|
||||
[:adc #(hi org.font.org)]
|
||||
[:sta vm.TOPH :x])
|
||||
|
||||
(vm:word :draw-char ; pscreen c --
|
||||
:lookup-pchar :draw-pchar)
|
||||
|
||||
(vm:word :snooze (vm:for))
|
||||
(vm:word :textsnooze 0x40 :snooze)
|
||||
(vm:word :draw-text1 0x2257 :draw-text)
|
||||
(vm:word :draw-text2 0x22d7 :draw-text)
|
||||
(vm:word :draw-text3 0x2357 :draw-text)
|
||||
(vm:word :draw-text4 0x23d7 :draw-text)
|
||||
(vm:word :draw-text ; st pscreen --
|
||||
(vm:while [:over :bget :dup] ; st pscreen c
|
||||
:over :swap :draw-char ; st pscreen
|
||||
:textsnooze
|
||||
:inc :swap :inc :swap)
|
||||
:drop :drop :drop)
|
||||
(vm:word :cleartext
|
||||
0x2257 :clearline 0x22d7 :clearline 0x2357 :clearline 0x23d7 :clearline)
|
||||
|
||||
(vm:word :wait-for-return (vm:until :read-key (string.byte "\r") :=))
|
||||
(vm:word :dismiss-dialog :wait-for-return :cleartext)
|
||||
|
||||
(tile.appendtiles org.tiles)
|
||||
(tile.appendgfx org.font (tile.loadgfx tile.fn-font))
|
||||
|
||||
|
|
@ -120,6 +102,7 @@
|
|||
; but REPL debug stub should be very available as a task
|
||||
|
||||
; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with?
|
||||
(vm:word :handle-key :read-key :player-key :hide-footer)
|
||||
|
||||
(vm.code:append :main
|
||||
[:jsr :reset]
|
||||
|
|
|
|||
|
|
@ -1,16 +1,36 @@
|
|||
(local {: deflevel : with-footer : say : itile} (require :game.defs))
|
||||
(local {: deflevel : say : itile} (require :game.defs))
|
||||
(local {: ev} (require :game.entity))
|
||||
(local level (deflevel "game/map00001.json"))
|
||||
(local vm level.vm)
|
||||
|
||||
(vm:word :exitscanner (with-footer
|
||||
(say :jaye "IT'S A CARD SCANNER." "IT SHOULD OPEN THIS DOOR.")
|
||||
(say :jaye "IT'S NOT READING MY CARD" "FOR SOME REASON." "QUAKE MUST'VE DAMAGED IT.")
|
||||
(say :jaye "NEUT MIGHT BE ABLE TO" "HACK IT...")))
|
||||
|
||||
(vm:word :firstdoor
|
||||
:dup ev.touch := :responder-itile (itile :doorclosed) := :& (vm:when
|
||||
(with-footer (say :jaye "IT WON'T OPEN!"))
|
||||
) :door)
|
||||
(vm:if-and [[:is-jaye?] [:dup ev.touch :=] [:responder-itile (itile :doorclosed) :=]] [
|
||||
(say :jaye "IT WON'T OPEN!")
|
||||
]) :door)
|
||||
|
||||
(vm:word :neutterm
|
||||
(vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
|
||||
:neut-hidden? (vm:if [
|
||||
(say :jaye "MAYBE NEUT CAN HELP.")
|
||||
:get-responder :get :move-neut-to
|
||||
(say :neut "NEUT V0.71.4RC12 ONLINE" "" "PRESS SPACE TO TAKE CONTROL")
|
||||
] [
|
||||
(say :jaye "NEUT IS RUNNING NOW." "I CAN HIT THE SPACE BAR" "TO CONTROL THEM.")
|
||||
])
|
||||
]) :term)
|
||||
|
||||
(vm:word :firstterm
|
||||
(vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
|
||||
:responder-itile (itile :termoff) := (vm:when
|
||||
(say :jaye "LOOKS LIKE THERE'S STILL" "POWER TO THIS TERMINAL."))
|
||||
(say :jaye "IF I TURN A TERMINAL ON," "NEUT CAN USE IT TO" "TRAVEL THROUGH THE NETWORK.")
|
||||
]) :term)
|
||||
|
||||
(vm:word :exitscanner
|
||||
(vm:if-and [[:is-jaye?] [:dup ev.touch :=]] [
|
||||
(say :jaye "IT'S A CARD SCANNER." "IT SHOULD OPEN THIS DOOR.")
|
||||
(say :jaye "IT'S NOT READING MY CARD" "FOR SOME REASON." "QUAKE MUST'VE DAMAGED IT.")
|
||||
(say :jaye "NEUT MIGHT BE ABLE TO" "HACK IT...")
|
||||
]))
|
||||
|
||||
level
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"link":2,"x":7,"y":6,"linkword":"","name":"","func":"switch"},{"x":8,"func":"door","name":"","linkword":"","y":6},{"link":4,"y":4,"func":"term","name":"","linkword":"","x":2},{"link":3,"y":8,"func":"term","name":"","linkword":"","x":17},{"link":6,"y":8,"func":"switch","name":"","linkword":"","x":13},{"x":13,"func":"firstdoor","y":9,"linkword":"","name":""},{"x":9,"func":"exitscanner","linkword":"","name":"","y":1}]}
|
||||
{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"x":7,"link":2,"func":"switch","linkword":"","name":"","y":6},{"x":8,"func":"door","linkword":"","name":"","y":6},{"x":2,"func":"firstterm","y":4,"name":"","linkword":"","link":4},{"x":17,"func":"neutterm","y":8,"name":"","linkword":"","link":3},{"x":13,"func":"switch","y":8,"name":"","linkword":"","link":6},{"x":13,"func":"firstdoor","y":9,"name":"","linkword":""},{"x":9,"func":"exitscanner","name":"","linkword":"","y":1}]}
|
||||
Loading…
Reference in a new issue