Working Neut! More control structures

This commit is contained in:
Jeremy Penner 2020-11-29 00:44:23 -05:00
parent c8531f9917
commit 53c3aac463
8 changed files with 190 additions and 86 deletions

View file

@ -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 {}

View file

@ -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))

View file

@ -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}

View file

@ -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
View 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))

View file

@ -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]

View file

@ -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

View file

@ -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}]}