Re-import Neu] [ower to coexist with 8-bitsy, probably broke both
This commit is contained in:
parent
35808f061b
commit
16a6830b20
|
|
@ -1,4 +1,4 @@
|
||||||
(local {: vm} (require :game.defs))
|
(local {: vm} (require :bitsy.defs))
|
||||||
|
|
||||||
(local speaker :0xc030)
|
(local speaker :0xc030)
|
||||||
(vm:def :blipmem ; count p --
|
(vm:def :blipmem ; count p --
|
||||||
|
|
@ -154,7 +154,7 @@
|
||||||
(local level prg) ; todo: (asm.new prg) - if we want to load levels as an overlay
|
(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 org level.vm.code) ; (level:org org.level.org) - if we want to give level data a stable loxation
|
||||||
(local map (. files.game.levels ilevel))
|
(local map (. files.game.levels ilevel))
|
||||||
(local entity (require :game.entity))
|
(local entity (require :bitsy.entity))
|
||||||
(append-map map org label)
|
(append-map map org label)
|
||||||
(entity.append-from-map map org label)
|
(entity.append-from-map map org label)
|
||||||
(set level.vm.code org)
|
(set level.vm.code org)
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
(local Prodos (require :asm.prodos))
|
(local Prodos (require :asm.prodos))
|
||||||
(local util (require :lib.util))
|
(local util (require :lib.util))
|
||||||
(local {: lo : hi} util)
|
(local {: lo : hi} util)
|
||||||
(local {: org} (require :game.defs))
|
(local {: org} (require :bitsy.defs))
|
||||||
|
|
||||||
(fn append-boot-loader [prg]
|
(fn append-boot-loader [prg]
|
||||||
(local vm prg.vm)
|
(local vm prg.vm)
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
(local util (require :lib.util))
|
(local util (require :lib.util))
|
||||||
(local tiles (util.require :game.tiles))
|
(local tiles (util.require :game.tiles))
|
||||||
(local {: vm : org : itile : say : say-runon : controlstate} (require :game.defs))
|
(local {: vm : org : itile : say : say-runon : controlstate} (require :bitsy.defs))
|
||||||
(local {: lo : hi} util)
|
(local {: lo : hi} util)
|
||||||
|
|
||||||
; Entity memory layout:
|
; Entity memory layout:
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
(local {: vm : org} (require :game.defs))
|
(local {: vm : org} (require :bitsy.defs))
|
||||||
(local {: hi : lo} (require :lib.util))
|
(local {: hi : lo} (require :lib.util))
|
||||||
|
|
||||||
(vm:def :draw-pchar ; pscreen pchar --
|
(vm:def :draw-pchar ; pscreen pchar --
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
(local {: lo : hi} (require :lib.util))
|
(local {: lo : hi} (require :lib.util))
|
||||||
(local {: vm : mapw : maph : org} (require :game.defs))
|
(local {: vm : mapw : maph : org} (require :bitsy.defs))
|
||||||
|
|
||||||
; Graphics routines
|
; Graphics routines
|
||||||
(vm:def :mixed [:sta :0xc053])
|
(vm:def :mixed [:sta :0xc053])
|
||||||
|
|
@ -1,17 +1,17 @@
|
||||||
(local util (require :lib.util))
|
(local util (require :lib.util))
|
||||||
(local {: lo : hi : readjson} util)
|
(local {: lo : hi : readjson} util)
|
||||||
(local tile (util.reload :game.tiles))
|
(local tile (util.reload :game.tiles))
|
||||||
(local {: prg : vm : org : deflevel} (util.reload :game.defs))
|
(local {: prg : vm : org : deflevel} (util.reload :bitsy.defs))
|
||||||
(local files (require :game.files))
|
(local files (require :game.files))
|
||||||
|
|
||||||
(local disk (util.reload :game.disk))
|
(local disk (util.reload :bitsy.disk))
|
||||||
|
|
||||||
(util.reload :game.gfx)
|
(util.reload :bitsy.gfx)
|
||||||
(util.reload :game.footer)
|
(util.reload :bitsy.footer)
|
||||||
(util.reload :game.map)
|
(util.reload :bitsy.map)
|
||||||
(util.reload :game.entity)
|
(util.reload :bitsy.entity)
|
||||||
(util.reload :game.player)
|
(util.reload :bitsy.player)
|
||||||
(util.reload :game.boop)
|
(util.reload :bitsy.boop)
|
||||||
|
|
||||||
(tile.appendtiles org.code)
|
(tile.appendtiles org.code)
|
||||||
(org.code:append [:align 0x100] :font)
|
(org.code:append [:align 0x100] :font)
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
(local {: lo : hi} (require :lib.util))
|
(local {: lo : hi} (require :lib.util))
|
||||||
(local {: vm : mapw : maph : rot8l} (require :game.defs))
|
(local {: vm : mapw : maph : rot8l} (require :bitsy.defs))
|
||||||
|
|
||||||
(vm:def :lookup-flags ; itile -- flags
|
(vm:def :lookup-flags ; itile -- flags
|
||||||
[:lda vm.TOP :x]
|
[:lda vm.TOP :x]
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
(local tile (require :game.tiles))
|
(local tile (require :game.tiles))
|
||||||
(local {: vm : mapw : maph : itile : controlstate} (require :game.defs))
|
(local {: vm : mapw : maph : itile : controlstate} (require :bitsy.defs))
|
||||||
|
|
||||||
(local {: walkable} tile.flag-to-bit)
|
(local {: walkable} tile.flag-to-bit)
|
||||||
|
|
||||||
|
|
@ -22,7 +22,7 @@
|
||||||
(util.nested-tset action [:lines 4] (line4:sub 1 33))
|
(util.nested-tset action [:lines 4] (line4:sub 1 33))
|
||||||
y))
|
y))
|
||||||
(fn [action vm]
|
(fn [action vm]
|
||||||
(local {: say} (require :game.defs))
|
(local {: say} (require :bitsy.defs))
|
||||||
(say action.character (table.unpack (lume.map action.lines #($1:upper))))))
|
(say action.character (table.unpack (lume.map action.lines #($1:upper))))))
|
||||||
|
|
||||||
(actions.register :warp
|
(actions.register :warp
|
||||||
|
|
|
||||||
86
neuttower/boop.fnl
Normal file
86
neuttower/boop.fnl
Normal file
|
|
@ -0,0 +1,86 @@
|
||||||
|
(local {: vm} (require :neuttower.defs))
|
||||||
|
|
||||||
|
(local speaker :0xc030)
|
||||||
|
(vm:def :blipmem ; count p --
|
||||||
|
[:block
|
||||||
|
[:lda [vm.ST1 :x]]
|
||||||
|
[:tay]
|
||||||
|
:sample
|
||||||
|
[:lda speaker]
|
||||||
|
[:lda [vm.TOP :x]]
|
||||||
|
[:inc vm.TOP :x]
|
||||||
|
[:bne :wait]
|
||||||
|
[:inc vm.TOPH :x]
|
||||||
|
:wait
|
||||||
|
[:clc] [:adc 1]
|
||||||
|
[:bne :wait]
|
||||||
|
[:dey]
|
||||||
|
[:bne :sample]]
|
||||||
|
(vm:drop) (vm:drop))
|
||||||
|
|
||||||
|
(vm:def :bliptone ; duration-f1 f2 --
|
||||||
|
[:block
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:sta vm.W]
|
||||||
|
:top
|
||||||
|
[:lda speaker]
|
||||||
|
[:ldy vm.ST1 :x]
|
||||||
|
:wave1 [:dey] [:bne :wave1]
|
||||||
|
[:lda speaker]
|
||||||
|
[:lda vm.TOPH :x]
|
||||||
|
[:ldy vm.TOP :x] [:iny]
|
||||||
|
:wave2 [:dey] [:bne :wave2]
|
||||||
|
[:ldy 0xff]
|
||||||
|
[:sec] [:sbc 1] [:bcs :wave2]
|
||||||
|
[:dec vm.W]
|
||||||
|
[:bne :top]
|
||||||
|
(vm:drop) (vm:drop)])
|
||||||
|
|
||||||
|
; 0x39a "samples" = 440hz
|
||||||
|
(local notes {})
|
||||||
|
(each [i note (ipairs [:a :a# :b :c :c# :d :d# :e :f :f# :g :g#])]
|
||||||
|
(tset notes note (- i 1)))
|
||||||
|
(fn wavelength [note]
|
||||||
|
(-> 0x39a
|
||||||
|
(/ (math.pow 1.05946 (. notes note)))
|
||||||
|
(math.floor)))
|
||||||
|
(fn octave [wvl oct]
|
||||||
|
(-> wvl
|
||||||
|
(/ (math.pow 2 (- oct 3)))
|
||||||
|
(math.floor)))
|
||||||
|
(fn parse-note [n]
|
||||||
|
(values (n:sub 1 -2) (tonumber (n:sub -1))))
|
||||||
|
(fn note-wavelength [n]
|
||||||
|
(local (note oct) (parse-note n))
|
||||||
|
(-> (wavelength note)
|
||||||
|
(octave oct)))
|
||||||
|
(fn note [n ?duration ?timbre]
|
||||||
|
(local timbre (or ?timbre 0x20))
|
||||||
|
(local duration (or ?duration 0x10))
|
||||||
|
(local wvl (note-wavelength n))
|
||||||
|
[:vm (bit.bor (bit.lshift duration 8) timbre) (- wvl timbre) :bliptone])
|
||||||
|
(fn notes [ns ?duration ?timbre]
|
||||||
|
(local result [:block])
|
||||||
|
(each [_ n (ipairs ns)]
|
||||||
|
(table.insert result (note n ?duration ?timbre)))
|
||||||
|
result)
|
||||||
|
|
||||||
|
(vm:word :snd-explode 0x40 :lit :randombytes :blipmem)
|
||||||
|
(vm:word :snd-dooropen (notes [:c1 :e1] 3))
|
||||||
|
(vm:word :snd-doorclose (notes [:e1 :c1] 3))
|
||||||
|
(vm:word :snd-term-jingle (notes [:e3 :f3 :g3] 0x20))
|
||||||
|
(vm:word :snd-termon :snd-term-jingle (note :c4 0x20))
|
||||||
|
(vm:word :snd-termoff :snd-term-jingle (note :c3 0x20))
|
||||||
|
(vm:word :snd-rexx (notes [:c2 :g2 :e2 :c3] 0x08 0x08))
|
||||||
|
(vm:word :snd-libb (notes [:d#1 :g#1 :f#1 :g1] 0x08 0x7f))
|
||||||
|
(vm:word :snd-garbage (notes [:a5 :a3 :a2] 0x04 0xa0))
|
||||||
|
(vm:word :snd-teleport (notes [:e4 :d#4 :d4 :g#4] 0x1a 0x50))
|
||||||
|
|
||||||
|
(vm.code:append :keypad-boops)
|
||||||
|
(each [_ n (ipairs [:c4 :c#4 :d4 :d#4 :e4 :f4 :f#4 :g4 :g#4 :a5])]
|
||||||
|
(vm.code:append [:dw (- (note-wavelength n) 0xd0)]))
|
||||||
|
(vm:word :snd-keypad ; digit --
|
||||||
|
:dup :+ :lit :keypad-boops :+ :get 0x10d0 :swap :bliptone)
|
||||||
|
(vm:word :snd-cheat (notes [:g4 :f#4 :d#4 :a4 :g#3 :e4 :g#4 :c5] 0x30 0x20))
|
||||||
|
|
||||||
|
{: note : notes}
|
||||||
59
neuttower/bosskey.fnl
Normal file
59
neuttower/bosskey.fnl
Normal file
|
|
@ -0,0 +1,59 @@
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local {: vm : prg : astr : style} (util.require :neuttower.defs))
|
||||||
|
(vm:word :boss-key :textmode :page2 (vm:until :read-key) :hires :page1)
|
||||||
|
|
||||||
|
; if we upload to page 2 we don't have to worry about clobbering screen holes
|
||||||
|
(local textorg (prg:org 0x0800))
|
||||||
|
|
||||||
|
(fn padding [s w style]
|
||||||
|
(string.rep (astr " " style) (- w (length s))))
|
||||||
|
(fn pad [s w style]
|
||||||
|
(.. s (padding s w style)))
|
||||||
|
(fn rpad [s w style]
|
||||||
|
(.. (padding s w style) s))
|
||||||
|
(fn cellpad [s ?style]
|
||||||
|
(local textstyle (or ?style style.normal))
|
||||||
|
(match (type s)
|
||||||
|
:nil (pad "" 9 textstyle)
|
||||||
|
:string (pad (astr s textstyle) 9 textstyle)
|
||||||
|
:number (rpad (astr (.. s " ") textstyle) 9 textstyle)
|
||||||
|
:table (cellpad (. s 1) (. s 2))))
|
||||||
|
(fn cells [r a b c d]
|
||||||
|
(.. (rpad (.. r "") 3 style.inverse)
|
||||||
|
(cellpad a) (cellpad b) (cellpad c) (cellpad d)))
|
||||||
|
|
||||||
|
(fn generate-boss-screen-lines []
|
||||||
|
[(-> (astr "A16 (L) TOTAL" style.inverse)
|
||||||
|
(pad 38 style.inverse)
|
||||||
|
(.. (astr "C!" style.inverse)))
|
||||||
|
(.. (pad "" 38 style.inverse) (astr "24"))
|
||||||
|
""
|
||||||
|
(cells "" [" A" style.inverse] [" B" style.inverse] [" C" style.inverse] [" D" style.inverse])
|
||||||
|
(cells 1 "DEFINITEL" "Y REAL WO" "RK" "")
|
||||||
|
(cells 2 "(NOT PLAY" "ING COMPU" "TER GAMES" ")")
|
||||||
|
(cells 3)
|
||||||
|
(cells 4 "" "HAMMERS" "BILLS" "SANDWICH")
|
||||||
|
(cells 5 "JANUARY" 23 "$1" "CLUB")
|
||||||
|
(cells 6 "FEBRUARY" 121 "$2" "REUBEN")
|
||||||
|
(cells 7 "MARCH" 38 "$5" "BLT")
|
||||||
|
(cells 8 "SMARCH" 97 "$10" "HOT DOG")
|
||||||
|
(cells 9 "APRIL" 555 "$20" "I SAID IT")
|
||||||
|
(cells 10 "WEDNESDAY" 246 "$50" "EGG SALAD")
|
||||||
|
(cells 11 "KEYCODE" 1337 2757 9876)
|
||||||
|
(cells 12 "NUMBERS" 12345 "$100" "IF I HAD")
|
||||||
|
(cells 13 "LETTERS" "MARMOTS" "BENJAMIN" "100 I'D")
|
||||||
|
(cells 14 "SYMBOLS" "^!@#%&?" "$$$$$" "EAT THEM")
|
||||||
|
(cells 15)
|
||||||
|
(cells 16 ["TOTAL" style.inverse] "TOO MANY" ["* MAGIC *" style.flashing] "ALL@ONCE")
|
||||||
|
(cells 17) (cells 18) (cells 19) (cells 20)])
|
||||||
|
|
||||||
|
(fn bytes-from-lines [lines]
|
||||||
|
(var bytes (string.rep (astr " ") 0x400))
|
||||||
|
(each [y line (ipairs lines)]
|
||||||
|
(local offset (+ (* (math.floor (/ (- y 1) 8)) 0x28)
|
||||||
|
(* (% (- y 1) 8) 0x80)))
|
||||||
|
(set bytes (util.splice bytes offset line)))
|
||||||
|
bytes)
|
||||||
|
|
||||||
|
(textorg:append [:bytes (bytes-from-lines (generate-boss-screen-lines))])
|
||||||
|
|
||||||
36
neuttower/cheat.fnl
Normal file
36
neuttower/cheat.fnl
Normal file
|
|
@ -0,0 +1,36 @@
|
||||||
|
(local {: vm : say-runon : say} (require :neuttower.defs))
|
||||||
|
|
||||||
|
(fn defcheat [name ...]
|
||||||
|
(local cheatdata (.. name "-data"))
|
||||||
|
(vm.code:append cheatdata [:db 0] [:bytes name] [:db 0])
|
||||||
|
(vm:word name :lit cheatdata :cheatguard ...))
|
||||||
|
|
||||||
|
(vm:word :pcheatnext ; cheatdata -- pchar
|
||||||
|
:dup :bget :inc :+)
|
||||||
|
(vm:word :reset-cheat ; cheatdata --
|
||||||
|
0 :swap :bset)
|
||||||
|
(vm:word :cheatguard ; char cheatdata -- [optional rdrop]
|
||||||
|
:dup :pcheatnext :bget :<rot := (vm:if ; cheatdata
|
||||||
|
[:dup :bget :inc :over :bset
|
||||||
|
:dup :pcheatnext :bget (vm:if [:drop :rdrop] [:snd-cheat :reset-cheat])]
|
||||||
|
[:reset-cheat :rdrop]))
|
||||||
|
|
||||||
|
(defcheat :NTSPISPOPD :noclip :get :not :noclip :set)
|
||||||
|
|
||||||
|
(vm.code:append :level-pointers
|
||||||
|
[:vm :level1 :level2 :level3 :level4 :level5 :level6])
|
||||||
|
(defcheat :NTXYZZY
|
||||||
|
(say-runon :term "WARP TO ROOM #?" "(0 TO NOT CHEAT)")
|
||||||
|
:read-digit :hide-footer (vm:if-and [[:dup 1 :>=] [:dup 7 :<]]
|
||||||
|
[:dec :dup :+ :lit :level-pointers :+ :get :load-level]
|
||||||
|
[:drop]))
|
||||||
|
|
||||||
|
(defcheat :NTCHUCK :chuck-mode :get :not :chuck-mode :set
|
||||||
|
:chuck-mode :get (vm:if
|
||||||
|
[(say :neut "CHUCK MODE ENABLED!" "* W H I N N Y *")]
|
||||||
|
[(say :neut "CHUCK MODE DISABLED." "BEEP BOOP.")]))
|
||||||
|
|
||||||
|
(vm:word :cheat-key ; ascii --
|
||||||
|
(vm:if-and [[:dup (string.byte "A") :>=] [:dup (string.byte "Z") :<=]]
|
||||||
|
[:dup :NTSPISPOPD :dup :NTXYZZY :NTCHUCK]
|
||||||
|
[:drop]))
|
||||||
184
neuttower/defs.fnl
Normal file
184
neuttower/defs.fnl
Normal file
|
|
@ -0,0 +1,184 @@
|
||||||
|
(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 Prodos (require :asm.prodos))
|
||||||
|
|
||||||
|
(local prg (asm.new))
|
||||||
|
(local vm (VM.new prg {:org 0xc00}))
|
||||||
|
(Prodos.install-words vm)
|
||||||
|
|
||||||
|
(local org {
|
||||||
|
:boot vm.code
|
||||||
|
:code (prg:org 0x4000)
|
||||||
|
})
|
||||||
|
|
||||||
|
(local mapw 20)
|
||||||
|
(local maph 12)
|
||||||
|
|
||||||
|
(local mon {
|
||||||
|
:hexout :0xfdda
|
||||||
|
:putchar :0xfded
|
||||||
|
:bell :0xff3a
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
(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)
|
||||||
|
|
||||||
|
; core graphics words needed for booting
|
||||||
|
(vm:def :hires
|
||||||
|
[:sta :0xc050]
|
||||||
|
[:sta :0xc057]
|
||||||
|
[:sta :0xc052]
|
||||||
|
[:sta :0xc054])
|
||||||
|
|
||||||
|
(vm:def :cleargfx
|
||||||
|
(vm:push 0x4000)
|
||||||
|
[:block :page
|
||||||
|
[:dec vm.TOPH :x]
|
||||||
|
[:lda 0]
|
||||||
|
[:block :start
|
||||||
|
[:sta [vm.TOP :x]]
|
||||||
|
[:inc vm.TOP :x]
|
||||||
|
[:bne :start]]
|
||||||
|
[:lda vm.TOPH :x]
|
||||||
|
[:cmp 0x20]
|
||||||
|
[:bne :page]]
|
||||||
|
(vm:drop))
|
||||||
|
|
||||||
|
; 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]])
|
||||||
|
|
||||||
|
; "random" numbers
|
||||||
|
; this is used only for cosmetic purposes and short noise generation, so we can get away
|
||||||
|
; with just including a short table of random digits rather than implementing our own
|
||||||
|
; pseudorandom number generator
|
||||||
|
(var randombytes "")
|
||||||
|
(for [i 0 0x40] (set randombytes (.. randombytes (string.char (math.random 0 255)))))
|
||||||
|
(vm.code:append :randombytes [:bytes randombytes])
|
||||||
|
(vm:var :irandom [:db 0])
|
||||||
|
(vm:word :rnd
|
||||||
|
:irandom :bget
|
||||||
|
:dup 1 :+ 0x3f :& :irandom :bset
|
||||||
|
:lit :randombytes :+ :bget)
|
||||||
|
|
||||||
|
; 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 :neuttower.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 (.. :draw-p 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 tilelist (tiles.loadgfx tiles.fn-tiles))
|
||||||
|
(fn itile [label] (tiles.find-itile tilelist label))
|
||||||
|
|
||||||
|
(set vm.code org.code)
|
||||||
|
|
||||||
|
{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : tilelist : controlstate}
|
||||||
|
|
||||||
87
neuttower/disk.fnl
Normal file
87
neuttower/disk.fnl
Normal file
|
|
@ -0,0 +1,87 @@
|
||||||
|
(local asm (require :asm.asm))
|
||||||
|
(local VM (require :asm.vm))
|
||||||
|
(local Prodos (require :asm.prodos))
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local {: lo : hi} util)
|
||||||
|
(local {: org} (require :neuttower.defs))
|
||||||
|
|
||||||
|
(fn append-boot-loader [prg]
|
||||||
|
(local vm prg.vm)
|
||||||
|
(set vm.code org.boot)
|
||||||
|
(set prg.files [])
|
||||||
|
|
||||||
|
(vm:word :loadfile ; length addr filename --
|
||||||
|
0xbb00 :open :read :drop :close)
|
||||||
|
(vm:word :loadscreen :cleargfx 0x2000 0x2000 :<rot :loadfile)
|
||||||
|
|
||||||
|
(vm.code:append
|
||||||
|
:boot
|
||||||
|
[:jsr :reset]
|
||||||
|
[:jsr :interpret]
|
||||||
|
[:vm :hires (vm:pstr "TITLE.SCREEN") :loadscreen])
|
||||||
|
(each [addr _ (pairs prg.org-to-block)]
|
||||||
|
(when (~= addr org.boot.org)
|
||||||
|
(local filename (.. "STUFF." (length prg.files)))
|
||||||
|
(table.insert prg.files {: filename :org addr})
|
||||||
|
(vm.code:append [:vm :lit [:dw #(length (. prg.org-to-block addr :bytes))] addr :lit (.. :filename (length prg.files)) :loadfile])))
|
||||||
|
(vm.code:append
|
||||||
|
[:vm :native]
|
||||||
|
[:jmp prg.start-symbol])
|
||||||
|
(each [i file (ipairs prg.files)]
|
||||||
|
(vm.code:append (.. :filename i) (Prodos.str file.filename))))
|
||||||
|
|
||||||
|
(fn org-copier [org]
|
||||||
|
(local srclabel (.. :loader- org.addr))
|
||||||
|
; this will always copy full pages, because it simplifies the code and we don't actually care if a little extra
|
||||||
|
; garbage is tacked on to the end.
|
||||||
|
; We copy the pages in reverse order, because this allows us to safely move from 0x2000 to higher memory, and we
|
||||||
|
; never want to overlap with 0x2000 from lower memory, so either direction is safe
|
||||||
|
(local dstpage-first (hi org.addr))
|
||||||
|
(local dstpage-last (hi (+ org.addr (length org.bytes) -1)))
|
||||||
|
[:block
|
||||||
|
[:computed :srchi #(+ ($1:lookup-addr :ld-src) 2)]
|
||||||
|
[:computed :dsthi #(+ ($1:lookup-addr :st-dst) 2)]
|
||||||
|
[:computed :src-last #(+ ($1:lookup-addr srclabel) (* (- dstpage-last dstpage-first) 0x100))]
|
||||||
|
[:computed :dst-last #(+ org.addr (* (- dstpage-last dstpage-first) 0x100))]
|
||||||
|
[:ldx 0]
|
||||||
|
:ld-src [:lda :src-last :x]
|
||||||
|
:st-dst [:sta :dst-last :x]
|
||||||
|
[:inx]
|
||||||
|
[:bne :ld-src]
|
||||||
|
|
||||||
|
[:lda :dsthi]
|
||||||
|
[:cmp dstpage-first]
|
||||||
|
[:beq :done]
|
||||||
|
[:dec :srchi]
|
||||||
|
[:dec :dsthi]
|
||||||
|
[:bne :ld-src]
|
||||||
|
:done])
|
||||||
|
|
||||||
|
(fn create-sys-loader [disk filename game]
|
||||||
|
(local blocks [])
|
||||||
|
(local prg (asm.new game))
|
||||||
|
(local sys (prg:org 0x2000))
|
||||||
|
(sys:append :loader-main)
|
||||||
|
(set prg.start-symbol :loader-main)
|
||||||
|
(sys:append (org-copier org.boot.block))
|
||||||
|
(sys:append [:jmp :boot])
|
||||||
|
(sys:append (.. :loader- org.boot.org) [:bytes org.boot.block.bytes])
|
||||||
|
(prg:assemble)
|
||||||
|
(disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 sys.block.bytes))
|
||||||
|
|
||||||
|
(fn write [game]
|
||||||
|
(local disk (Prodos "ProDOS_Blank.dsk"))
|
||||||
|
(disk:update-volume-header {:name "NEUT.TOWER"})
|
||||||
|
|
||||||
|
(create-sys-loader disk :NEUT game)
|
||||||
|
|
||||||
|
(disk:add-file "TITLE.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "game/title.screen") :fromhex))
|
||||||
|
(disk:add-file "ELEVATOR.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "game/end.screen") :fromhex))
|
||||||
|
(each [_ file (ipairs game.files)]
|
||||||
|
(disk:add-file file.filename Prodos.file-type.BIN file.org (. game.org-to-block file.org :bytes)))
|
||||||
|
|
||||||
|
(disk:write "NeutTower.dsk")
|
||||||
|
disk)
|
||||||
|
|
||||||
|
{: write : append-boot-loader}
|
||||||
|
|
||||||
1
neuttower/end.screen
Normal file
1
neuttower/end.screen
Normal file
File diff suppressed because one or more lines are too long
234
neuttower/entity.fnl
Normal file
234
neuttower/entity.fnl
Normal file
|
|
@ -0,0 +1,234 @@
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local tiles (util.require :game.tiles))
|
||||||
|
(local {: vm : org : itile : say : say-runon : controlstate} (require :neuttower.defs))
|
||||||
|
(local {: lo : hi} util)
|
||||||
|
|
||||||
|
; Entity memory layout:
|
||||||
|
; +0 - yx
|
||||||
|
; +2 - event handler
|
||||||
|
; +4 - link word
|
||||||
|
; +6 - link pointer
|
||||||
|
|
||||||
|
; All entities exist in a single page in RAM - with this structure we can have up to 32
|
||||||
|
; (players are handled specially and never require a link)
|
||||||
|
; if we really need more we could have one page for entities and one page for link data
|
||||||
|
; hellmaze level 2 from MS-DOS Neut Tower has 36 entities - good excuse to simplify IMO
|
||||||
|
; The entity count for a level is stored after the map.
|
||||||
|
|
||||||
|
(local ev {
|
||||||
|
:touch 0
|
||||||
|
:untouch 1
|
||||||
|
:act 2
|
||||||
|
:deact 3
|
||||||
|
:tog 4
|
||||||
|
:hack 5
|
||||||
|
:noop 6
|
||||||
|
})
|
||||||
|
|
||||||
|
(vm:def :lookup-entity ; i -- entity
|
||||||
|
[:lda vm.TOP :x]
|
||||||
|
[:asl :a] [:asl :a] [:asl :a] ; x8
|
||||||
|
[:sta vm.TOP :x]
|
||||||
|
[:lda :map-page] [:clc] [:adc 1]
|
||||||
|
[:sta vm.TOPH :x])
|
||||||
|
(vm:word :entity-at ; yx -- entity|0
|
||||||
|
:>r 0 :entity-count
|
||||||
|
(vm:while [:dup] :dec ; entity|0 i
|
||||||
|
:dup :lookup-entity :get :rtop :=
|
||||||
|
(vm:when :lookup-entity :swap)
|
||||||
|
) :drop :rdrop)
|
||||||
|
(vm:var :responder 0)
|
||||||
|
(vm:word :get-responder :responder :get)
|
||||||
|
(vm:word :entity-itile :get :itile-at)
|
||||||
|
(vm:word :responder-itile :get-responder :entity-itile)
|
||||||
|
(vm:word :entity>do ; entity ev --
|
||||||
|
:over :responder :dup :get :>r :set
|
||||||
|
:swap 2 :+ :get :execute
|
||||||
|
:r> :responder :set)
|
||||||
|
(vm:word :link-arg ; e -- a
|
||||||
|
6 :+ :get)
|
||||||
|
(vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:execute] [:drop :link-arg]))
|
||||||
|
(vm:word :entity-at>do ; yx ev -- f
|
||||||
|
:>r :entity-at :dup (vm:if [:r> :entity>do vm.true] [:rdrop]))
|
||||||
|
(vm:word :touch-entity ; yx -- f
|
||||||
|
ev.touch :entity-at>do)
|
||||||
|
(vm:word :untouch-entity ; yx --
|
||||||
|
ev.untouch :entity-at>do :drop)
|
||||||
|
|
||||||
|
(vm:word :entity-around>do ; yx ev --
|
||||||
|
:over 0x0100 :yx+ :over :entity-at>do :drop
|
||||||
|
:over 0x0001 :yx+ :over :entity-at>do :drop
|
||||||
|
:over 0xff00 :yx+ :over :entity-at>do :drop
|
||||||
|
:swap 0x00ff :yx+ :swap :entity-at>do :drop)
|
||||||
|
|
||||||
|
(vm:word :set-entitytile ; e itile --
|
||||||
|
:swap :get :swap :update-itile)
|
||||||
|
|
||||||
|
(vm:word :set-respondertile ; itile --
|
||||||
|
:get-responder :get :swap :update-itile)
|
||||||
|
|
||||||
|
; run only when processing an ev.touch event
|
||||||
|
(vm:word :transparent-entity-move ; -- f
|
||||||
|
:get-responder :get :dup :handle-general-move
|
||||||
|
:swap :over :not (vm:if [:move-player-to] [:drop]))
|
||||||
|
|
||||||
|
(vm:var :pre-handled-tile 0)
|
||||||
|
(vm:var :pre-handled-ev 0)
|
||||||
|
(vm:word :handle-onoff ; ev off on --
|
||||||
|
:responder-itile :pre-handled-tile :set :<rot
|
||||||
|
:dup ev.tog := (vm:when
|
||||||
|
:drop :dup :responder-itile := (vm:if [ev.deact] [ev.act])
|
||||||
|
) :dup :pre-handled-ev :set (vm:case
|
||||||
|
[ev.act :swap :drop :set-respondertile]
|
||||||
|
[ev.deact :drop :set-respondertile]
|
||||||
|
[:else :drop :drop]))
|
||||||
|
|
||||||
|
(vm:word :on-handled ; xp-on xp-off --
|
||||||
|
:responder-itile :pre-handled-tile :get := (vm:if
|
||||||
|
[:drop :drop]
|
||||||
|
[:pre-handled-ev :get ev.act :=
|
||||||
|
(vm:if [:drop] [:swap :drop]) :execute]))
|
||||||
|
|
||||||
|
(vm:word :activation-ev? ; ev -- f
|
||||||
|
:dup ev.act := :over ev.deact := :| :swap ev.tog := :|)
|
||||||
|
(vm:word :activate-link ; ev itile-on --
|
||||||
|
:swap :activation-ev? (vm:if [
|
||||||
|
:responder-itile := (vm:if [ev.act] [ev.deact])
|
||||||
|
:linked-entity :swap :entity>do
|
||||||
|
] [:drop]))
|
||||||
|
|
||||||
|
(vm:word :walking-through-door ; ev -- ev f
|
||||||
|
(vm:if-and [[:is-walking?] [:dup ev.touch :=] [:responder-itile (itile :dooropen) :=]]
|
||||||
|
[vm.true] [vm.false]))
|
||||||
|
|
||||||
|
(vm:word :door ; ev --
|
||||||
|
:walking-through-door (vm:if
|
||||||
|
[:move-to-responder :drop]
|
||||||
|
[(itile :doorclosed) (itile :dooropen) :handle-onoff
|
||||||
|
:lit :snd-dooropen :lit :snd-doorclose :on-handled]))
|
||||||
|
|
||||||
|
(vm:word :exitlevel ; e --
|
||||||
|
:link-arg :next-level :set)
|
||||||
|
|
||||||
|
(vm:word :exitdoor ; ev --
|
||||||
|
:walking-through-door (vm:if
|
||||||
|
[:drop (vm:ifchain
|
||||||
|
[:gord-sitting :get] [(say :jaye "I'M NOT LEAVING GORD BEHIND.")]
|
||||||
|
[:libb-hidden? :not] [(say :neut "IT IS INADVISABLE TO LEAVE THIS" "AREA WITHOUT RETRIEVING LIBB")]
|
||||||
|
[:move-to-responder :linked-entity])]
|
||||||
|
[:door]))
|
||||||
|
|
||||||
|
(vm:word :move-to-responder :get-responder :get :move-player-to)
|
||||||
|
(vm:word :switch ; ev --
|
||||||
|
(vm:if-and [[:is-rexx? :not] [:dup ev.touch :=]]
|
||||||
|
[:drop ev.tog :is-neut? (vm:when :move-to-responder)])
|
||||||
|
:dup (itile :switchoff) (itile :switchon) :handle-onoff
|
||||||
|
(itile :switchon) :activate-link)
|
||||||
|
|
||||||
|
(vm:var :disconnected-term-attempt vm.false)
|
||||||
|
(vm:word :term ; ev --
|
||||||
|
:dup ev.touch := (vm:when
|
||||||
|
(vm:ifchain [:is-jaye?] [:drop ev.act]
|
||||||
|
[:is-neut?] [:responder-itile (itile :termon) := (vm:when
|
||||||
|
:linked-entity :dup :entity-itile (itile :termon) :=
|
||||||
|
(vm:if [:get :move-player-to :snd-teleport]
|
||||||
|
[:drop (say :neut "DESTINATION TERMINAL" "IS DISCONNECTED")
|
||||||
|
:disconnected-term-attempt :get :not (vm:when
|
||||||
|
vm.true :disconnected-term-attempt :set
|
||||||
|
(say :neut "PLEASE CONTACT YOUR" "SYSTEM ADMINISTRATOR")
|
||||||
|
(say :neut "THIS INCIDENT HAS" "BEEN REPORTED"))]))]
|
||||||
|
[]))
|
||||||
|
(itile :termoff) (itile :termon) :handle-onoff
|
||||||
|
:lit :snd-termon :lit :snd-termoff :on-handled)
|
||||||
|
|
||||||
|
(vm:word :handle-scan ; ev --
|
||||||
|
:dup (itile :scanoff) (itile :scanon) :handle-onoff
|
||||||
|
:linked-entity :swap :entity>do)
|
||||||
|
|
||||||
|
(vm:word :libb-on-responder :libb-yx :get :get-responder :get :=)
|
||||||
|
(vm:word :scan ; ev --
|
||||||
|
:is-neut? (vm:if [
|
||||||
|
(vm:case
|
||||||
|
[ev.touch ev.act :handle-scan :libb-on-responder (vm:when controlstate.libb :controlstate :bset 0xffff :move-player-to controlstate.neut :controlstate :bset) :move-to-responder]
|
||||||
|
[ev.untouch :libb-on-responder :not (vm:when ev.deact :handle-scan)]
|
||||||
|
[ev.hack vm.true :hack-handled :set
|
||||||
|
ev.act :handle-scan
|
||||||
|
:snd-libb
|
||||||
|
controlstate.libb :controlstate :bset
|
||||||
|
:move-to-responder
|
||||||
|
controlstate.neut :controlstate :bset
|
||||||
|
(say :libb "NO SWEAT.")]
|
||||||
|
[:else])
|
||||||
|
] [:drop]))
|
||||||
|
|
||||||
|
(vm:word :rexx ; ev --
|
||||||
|
ev.touch := (vm:when
|
||||||
|
(vm:if-and [[:is-neut?] [:responder-itile (itile :t-rexx) :=]]
|
||||||
|
[0xffff :move-player-to
|
||||||
|
(itile :t-rexxstop) :set-respondertile
|
||||||
|
:get-responder :set-rexx :snd-rexx]
|
||||||
|
[(vm:if-and [[:is-rexx?] [:responder-itile (itile :t-rexxstop) :=]]
|
||||||
|
[0xffff :move-player-to
|
||||||
|
(itile :t-rexx) :set-respondertile
|
||||||
|
0 :set-rexx :move-to-responder])])))
|
||||||
|
|
||||||
|
|
||||||
|
(vm:word :read-digit ; -- digit
|
||||||
|
(vm:while [:read-key :dup 0x3a :< :over 0x30 :>= :& :not] :drop) 0x30 :-)
|
||||||
|
|
||||||
|
(vm:word :keypad-digit ; pscreen -- n
|
||||||
|
:read-digit :swap :over :draw-digit :dup :snd-keypad)
|
||||||
|
(vm:word :next-digit ; pscreen n -- pscreen n
|
||||||
|
:shl4 :over :keypad-digit :+ :swap 1 :+ :swap)
|
||||||
|
(vm:word :draw-single-keypad-hash ; pscreen -- pscreen
|
||||||
|
:dup (string.byte "#") :draw-char 1 :+)
|
||||||
|
(vm:word :read-keypad ; -- n
|
||||||
|
0x23e2 :dup
|
||||||
|
:draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :drop
|
||||||
|
0 :next-digit :next-digit :next-digit :next-digit :swap :drop :cleartext)
|
||||||
|
(vm:word :keypad ; ev code --
|
||||||
|
:>r
|
||||||
|
:dup ev.touch := (vm:when
|
||||||
|
:is-jaye? (vm:when
|
||||||
|
:responder-itile (itile :t-keyoff) := (vm:if
|
||||||
|
[(say-runon :pady "ENTER YOUR 4-DIGIT DOOR CODE!" "AND HAVE A SUPER DAY!")
|
||||||
|
:read-keypad :rtop := (vm:if
|
||||||
|
[(say :pady "THAT'S RIGHT! HOORAY!" "YOU GET A GOLD STAR!")
|
||||||
|
:drop ev.act]
|
||||||
|
[(say :pady "OHHH, SORRY! THAT'S NOT IT." "BETTER LUCK NEXT TIME!")])]
|
||||||
|
[(say :pady "OH HI AGAIN! I MISSED YOU TOO!")]))
|
||||||
|
:is-neut? (vm:when :move-to-responder))
|
||||||
|
:rdrop
|
||||||
|
:dup :evhack? (vm:when :drop ev.act)
|
||||||
|
:dup (itile :t-keyoff) (itile :t-keyon) :handle-onoff
|
||||||
|
(itile :t-keyon) :activate-link)
|
||||||
|
|
||||||
|
(vm:var :hack-handled vm.false)
|
||||||
|
(vm:word :evhack? ; e -- f
|
||||||
|
ev.hack := (vm:if [vm.true :hack-handled :set vm.true] [vm.false]))
|
||||||
|
|
||||||
|
(vm:word :trigger-sidekick
|
||||||
|
(vm:if-and [[:is-jaye?] [:gord-sitting :get]]
|
||||||
|
[:gord-yx :get ev.touch :entity-around>do]
|
||||||
|
[(vm:if-and [[:is-neut?] [:libb-present :get] [:libb-hidden?]]
|
||||||
|
[vm.false :hack-handled :set
|
||||||
|
:neut-yx :get ev.hack :entity-at>do :drop
|
||||||
|
:hack-handled :get :not (vm:when
|
||||||
|
(say :libb "DON'T THINK I CAN HACK THAT."))])]))
|
||||||
|
|
||||||
|
(fn append-from-map [map entity-org prefix]
|
||||||
|
(entity-org:append [:align 0x100])
|
||||||
|
(each [ientity entity (ipairs map.objects)]
|
||||||
|
(when entity.name
|
||||||
|
(entity-org:append entity.name))
|
||||||
|
(entity-org:append
|
||||||
|
(.. prefix "-entity-" ientity)
|
||||||
|
[:db (- entity.x 1)] [:db (- entity.y 1)]
|
||||||
|
[:ref entity.func]
|
||||||
|
(if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
|
||||||
|
(if entity.link [:ref (.. prefix "-entity-" entity.link)]
|
||||||
|
entity.linkentity [:ref entity.linkentity]
|
||||||
|
[:dw 0]))))
|
||||||
|
|
||||||
|
{: ev : append-from-map}
|
||||||
|
|
||||||
1
neuttower/font.json
Normal file
1
neuttower/font.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
[{"flags":[],"gfx":"8080808080808080"},{"flags":[],"gfx":"8C8C8C8C88808C80"},{"flags":[],"gfx":"B3B3928080808080"},{"flags":[],"gfx":"B6FFB6B6B6FFB680"},{"flags":[],"gfx":"8CBE839EB09F8C80"},{"flags":[],"gfx":"80A3938884B2B180"},{"flags":[],"gfx":"8E9B9BCEBBB3EE80"},{"flags":[],"gfx":"8C8C888080808080"},{"flags":[],"gfx":"988C8C8C8C8C9880"},{"flags":[],"gfx":"8C98989898988C80"},{"flags":[],"gfx":"8CAD9E8C9EAD8C80"},{"flags":[],"gfx":"808C8CBF8C8C8080"},{"flags":[],"gfx":"808080808C8C8880"},{"flags":[],"gfx":"8080809C80808080"},{"flags":[],"gfx":"80808080808C8C80"},{"flags":[],"gfx":"80A0B0988C868280"},{"flags":[],"gfx":"9CB6B6BEB6B69C80"},{"flags":[],"gfx":"989C989898989880"},{"flags":[],"gfx":"9CB6B0988C86BE80"},{"flags":[],"gfx":"9CB6B098B0B69C80"},{"flags":[],"gfx":"9C9E9B9BBF989880"},{"flags":[],"gfx":"BE86869EB0B09E80"},{"flags":[],"gfx":"9C86869EB6B69C80"},{"flags":[],"gfx":"BEB0B0988C8C8C80"},{"flags":[],"gfx":"9CB6B69CB6B69C80"},{"flags":[],"gfx":"9CB6B6BCB0B09C80"},{"flags":[],"gfx":"808C8C808C8C8080"},{"flags":[],"gfx":"808C8C808C8C8880"},{"flags":[],"gfx":"B0988C868C98B080"},{"flags":[],"gfx":"8080BE80BE808080"},{"flags":[],"gfx":"868C98B0988C8680"},{"flags":[],"gfx":"9CB6B0988C808C80"},{"flags":[],"gfx":"9EB3B3BBBB839E80"},{"flags":[],"gfx":"9CB6B6B6BEB6B680"},{"flags":[],"gfx":"9EB6B69EB6B69E80"},{"flags":[],"gfx":"9CB6868686B69C80"},{"flags":[],"gfx":"9EB6B6B6B6B69E80"},{"flags":[],"gfx":"BE86869E8686BE80"},{"flags":[],"gfx":"BE86869E86868680"},{"flags":[],"gfx":"9EB383BBB3B39E80"},{"flags":[],"gfx":"B6B6B6BEB6B6B680"},{"flags":[],"gfx":"8C8C8C8C8C8C8C80"},{"flags":[],"gfx":"B0B0B0B0B6BE9C80"},{"flags":[],"gfx":"B6B69E9EB6B6B680"},{"flags":[],"gfx":"868686868686BE80"},{"flags":[],"gfx":"92BFBFBFB3B3B380"},{"flags":[],"gfx":"9EB6B6B6B6B6B680"},{"flags":[],"gfx":"9CB6B6B6B6B69C80"},{"flags":[],"gfx":"9EB6B69E86868680"},{"flags":[],"gfx":"9CB6B6B6BEB6BC80"},{"flags":[],"gfx":"9EB6B69EB6B6B680"},{"flags":[],"gfx":"9CB6869CB0B69C80"},{"flags":[],"gfx":"BFBF8C8C8C8C8C80"},{"flags":[],"gfx":"B6B6B6B6B6B69C80"},{"flags":[],"gfx":"B6B6B69C9C9C8880"},{"flags":[],"gfx":"B3B3B3BFBFBF9280"},{"flags":[],"gfx":"B6B6B69CB6B6B680"},{"flags":[],"gfx":"B6B6B6BCB0B09C80"},{"flags":[],"gfx":"BEBEB0988CBEBE80"},{"flags":[],"gfx":"BC8C8C8C8C8CBC80"},{"flags":[],"gfx":"8082868C98B0A080"},{"flags":[],"gfx":"9E98989898989E80"},{"flags":[],"gfx":"8894808080808080"},{"flags":[],"gfx":"808080808080BE80"}]
|
||||||
55
neuttower/footer.fnl
Normal file
55
neuttower/footer.fnl
Normal file
|
|
@ -0,0 +1,55 @@
|
||||||
|
(local {: vm : org} (require :neuttower.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 ($1:lookup-addr :font))]
|
||||||
|
[:sta vm.TOPH :x])
|
||||||
|
|
||||||
|
(vm:word :draw-char ; pscreen c --
|
||||||
|
:lookup-pchar :draw-pchar)
|
||||||
|
(vm:word :draw-digit ; pscreen n --
|
||||||
|
0x30 :+ :draw-char)
|
||||||
|
|
||||||
|
(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))
|
||||||
|
|
||||||
133
neuttower/gfx.fnl
Normal file
133
neuttower/gfx.fnl
Normal file
|
|
@ -0,0 +1,133 @@
|
||||||
|
(local {: lo : hi} (require :lib.util))
|
||||||
|
(local {: vm : mapw : maph : org} (require :neuttower.defs))
|
||||||
|
|
||||||
|
; Graphics routines
|
||||||
|
(vm:def :mixed [:sta :0xc053])
|
||||||
|
(vm:def :textmode [:sta :0xc051])
|
||||||
|
(vm:def :page1 [:sta :0xc054])
|
||||||
|
(vm:def :page2 [:sta :0xc055])
|
||||||
|
|
||||||
|
; starting address:
|
||||||
|
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
|
||||||
|
; x between 0-19
|
||||||
|
; y between 0-12
|
||||||
|
; yx - 16-bit value, low byte x, high byte y
|
||||||
|
(vm.code:append :screeny-lookup [:bytes "\0\040\080"])
|
||||||
|
(vm:def :yx>screen ; yx -- p
|
||||||
|
[:lda vm.TOPH :x] ; a=y
|
||||||
|
[:lsr :a] [:lsr :a] ; a=y/4
|
||||||
|
[:tay] ; y=y/4
|
||||||
|
[:lda 0x03]
|
||||||
|
[:and vm.TOPH :x] ; a=y%4
|
||||||
|
[:ora 0x20] ; a=0x20 + y%4
|
||||||
|
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
|
||||||
|
[:lda vm.TOP :x] ; a=x
|
||||||
|
[:asl :a] ; a = x*2
|
||||||
|
[:clc]
|
||||||
|
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
|
||||||
|
[:sta vm.TOP :x] ; low byte is set
|
||||||
|
)
|
||||||
|
|
||||||
|
; note: the graphical tile data must not cross a page boundary
|
||||||
|
; (this happens automatically because each tile is 32 bytes and we
|
||||||
|
; start them on a page; this lets lookup-tile be fast)
|
||||||
|
(fn draw-block []
|
||||||
|
[:block
|
||||||
|
[:clc]
|
||||||
|
[:ldy 8]
|
||||||
|
: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]])
|
||||||
|
|
||||||
|
(fn draw-vertical-block []
|
||||||
|
[:block
|
||||||
|
(draw-block)
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:sbc 31] ; with carry clear this is 32
|
||||||
|
[:sta vm.ST1H :x]
|
||||||
|
[:lda vm.ST1 :x]
|
||||||
|
[:ora 0x80]
|
||||||
|
[:sta vm.ST1 :x]
|
||||||
|
(draw-block)])
|
||||||
|
|
||||||
|
(vm:def :drawtile ; p gfx --
|
||||||
|
(draw-vertical-block)
|
||||||
|
[:lda vm.ST1H :x]
|
||||||
|
[:sbc 31]
|
||||||
|
[:sta vm.ST1H :x]
|
||||||
|
[:lda vm.ST1 :x]
|
||||||
|
[:sbc 0x7f]
|
||||||
|
[:sta vm.ST1 :x]
|
||||||
|
(draw-vertical-block)
|
||||||
|
(vm:drop) (vm:drop))
|
||||||
|
|
||||||
|
(vm:def :clearline ; pscreen --
|
||||||
|
[:lda vm.TOP :x] [:sta vm.W]
|
||||||
|
[:lda vm.TOPH :x] [:sta vm.WH]
|
||||||
|
(vm:drop)
|
||||||
|
[:block
|
||||||
|
:row
|
||||||
|
[:ldy 0x27] [:lda 0]
|
||||||
|
:start
|
||||||
|
[:sta [vm.W] :y]
|
||||||
|
[:dey]
|
||||||
|
[:bpl :start]
|
||||||
|
|
||||||
|
[:lda vm.WH]
|
||||||
|
[:cmp 0x3c]
|
||||||
|
[:bcs :done]
|
||||||
|
; cmp has cleared carry for us here
|
||||||
|
[:lda 4] [:adc vm.WH] [:sta vm.WH]
|
||||||
|
[:bcc :row]
|
||||||
|
:done])
|
||||||
|
|
||||||
|
(vm:word :drawfooter
|
||||||
|
0x39d0 :clearline
|
||||||
|
0x2250 :clearline 0x22d0 :clearline 0x2350 :clearline 0x23d0 :clearline)
|
||||||
|
|
||||||
|
(vm:word :drawmaprow ; pscreen pmap -- pmap
|
||||||
|
mapw (vm:for
|
||||||
|
:2dup :bget :lookup-tile :drawtile
|
||||||
|
:inc :swap :inc :inc :swap) :swap :drop)
|
||||||
|
|
||||||
|
(vm:word :drawmap
|
||||||
|
:map 0x0c00 (vm:until 0x100 :-
|
||||||
|
:dup :yx>screen ; pmap yx pscreen
|
||||||
|
:<rot :drawmaprow :swap ; pmap yx
|
||||||
|
:dup :not) :drop :drop)
|
||||||
|
|
||||||
|
(vm:word :clearfooter
|
||||||
|
:map 0x0300 (vm:until 0x100 :-
|
||||||
|
:dup 0x0900 :+ :yx>screen
|
||||||
|
:<rot :drawmaprow :swap
|
||||||
|
:dup :not) :drop :drop :player-redraw)
|
||||||
|
|
||||||
|
(vm.code:append :tilepage [:db #(hi ($1:lookup-addr :jaye-tileset))])
|
||||||
|
(vm:def :lookup-tile ; itile -- ptile
|
||||||
|
; each tile is 32 bytes; 2^5
|
||||||
|
; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
|
||||||
|
[:lda vm.TOP :x] [:tay]
|
||||||
|
[:and 0x1f]
|
||||||
|
[:clc] [:adc :tilepage]
|
||||||
|
[:sta vm.TOPH :x]
|
||||||
|
[:tya] [:and 0xe0]
|
||||||
|
[:sta vm.TOP :x])
|
||||||
|
(vm:def :set-human-tileset
|
||||||
|
[:lda #(hi ($1:lookup-addr :jaye-tileset))]
|
||||||
|
[:sta :tilepage])
|
||||||
|
(vm:def :set-prog-tileset
|
||||||
|
[:lda #(hi ($1:lookup-addr :neut-tileset))]
|
||||||
|
[:sta :tilepage])
|
||||||
|
|
||||||
|
(vm:word :draw-portrait ; pgfx
|
||||||
|
0x2252 :over :drawtile
|
||||||
|
0x2352 :over 32 :+ :drawtile
|
||||||
|
0x2254 :over 64 :+ :drawtile
|
||||||
|
0x2354 :swap 96 :+ :drawtile)
|
||||||
|
|
||||||
64
neuttower/init.fnl
Normal file
64
neuttower/init.fnl
Normal file
|
|
@ -0,0 +1,64 @@
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local {: lo : hi : readjson} util)
|
||||||
|
(local tile (util.reload :game.tiles))
|
||||||
|
(local {: prg : vm : org} (util.reload :neuttower.defs))
|
||||||
|
|
||||||
|
(local disk (util.reload :neuttower.disk))
|
||||||
|
|
||||||
|
(util.reload :neuttower.gfx)
|
||||||
|
(util.reload :neuttower.footer)
|
||||||
|
(util.reload :neuttower.map)
|
||||||
|
(util.reload :neuttower.entity)
|
||||||
|
(util.reload :neuttower.player)
|
||||||
|
(util.reload :neuttower.boop)
|
||||||
|
(util.reload :neuttower.cheat)
|
||||||
|
|
||||||
|
(tile.appendtiles org.code)
|
||||||
|
(org.code:append [:align 0x100] :font)
|
||||||
|
(tile.appendgfx org.code (tile.loadgfx tile.fn-font))
|
||||||
|
(tile.append-portraitwords vm {:pneut #[:vm :chuck-mode :get (vm:if [:lit :pchuck] [:lit :pneut])]})
|
||||||
|
|
||||||
|
(util.reload :neuttower.level1)
|
||||||
|
(util.reload :neuttower.level2)
|
||||||
|
(util.reload :neuttower.level3)
|
||||||
|
(util.reload :neuttower.level4)
|
||||||
|
(util.reload :neuttower.level5)
|
||||||
|
(util.reload :neuttower.level6)
|
||||||
|
|
||||||
|
(util.reload :neuttower.bosskey)
|
||||||
|
|
||||||
|
(vm:var :tick-count)
|
||||||
|
(vm:word :handle-key :tick :read-key :dup :cheat-key :player-key :hide-footer)
|
||||||
|
(vm:word :tick :map-specific-tick :tick-count :get 1 :+ :tick-count :set :player-redraw :rnd :drop)
|
||||||
|
|
||||||
|
(vm:var :next-level 0)
|
||||||
|
(vm:word :load-next-level :next-level :get :dup (vm:if [:load-level 0 :next-level :set] [:drop]))
|
||||||
|
(vm:word :load-level ; level-ptr --
|
||||||
|
:lit :map-ptr :set :reload-level)
|
||||||
|
|
||||||
|
(vm:word :reload-level
|
||||||
|
:map-jaye-yx :jaye-yx :set
|
||||||
|
:map-neut-yx :neut-yx :set
|
||||||
|
:map-gord-yx :gord-yx :set
|
||||||
|
0 :gord-dir :set
|
||||||
|
0xffff :rexx-yx :set
|
||||||
|
:map-specific-load
|
||||||
|
:full-redraw)
|
||||||
|
|
||||||
|
(vm.code:append :main
|
||||||
|
[:jsr :reset]
|
||||||
|
[:jsr :interpret]
|
||||||
|
[:vm :hires
|
||||||
|
:lit :level1 :load-level
|
||||||
|
(vm:forever
|
||||||
|
(vm:hotswap-sync :lit :level6 :load-level)
|
||||||
|
:interactive-eval-checkpoint
|
||||||
|
:handle-key
|
||||||
|
)
|
||||||
|
:quit])
|
||||||
|
|
||||||
|
(disk.append-boot-loader prg)
|
||||||
|
(prg:assemble)
|
||||||
|
(disk.write prg)
|
||||||
|
|
||||||
|
prg
|
||||||
68
neuttower/level1.fnl
Normal file
68
neuttower/level1.fnl
Normal file
|
|
@ -0,0 +1,68 @@
|
||||||
|
(local {: readjson} (require :lib.util))
|
||||||
|
(local {: deflevel : say : itile : controlstate : tilelist} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local {: decode-itile : encode-yx} (require :game.tiles))
|
||||||
|
(local level (deflevel "game/map1.json" :level1))
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
(let [map (readjson "game/map1.json")
|
||||||
|
maptiles (map.map:fromhex)
|
||||||
|
furniture-yx []]
|
||||||
|
(for [ibyte 1 (length maptiles)]
|
||||||
|
(let [btile (maptiles:sub ibyte ibyte)
|
||||||
|
enctile (string.byte btile)
|
||||||
|
itile (+ (decode-itile enctile) 1)
|
||||||
|
mx (+ (% (- ibyte 1) 20) 1)
|
||||||
|
my (- 12 (math.floor (/ (- ibyte 1) 20)))]
|
||||||
|
(when (. tilelist itile :flags :debris)
|
||||||
|
(table.insert furniture-yx (encode-yx {:x mx :y my})))))
|
||||||
|
(vm.code:append :furniture-yx)
|
||||||
|
(for [_ 1 10]
|
||||||
|
(let [ifurniture (math.random 1 (length furniture-yx))]
|
||||||
|
(vm.code:append [:dw (. furniture-yx ifurniture)])
|
||||||
|
(table.remove furniture-yx ifurniture))))
|
||||||
|
|
||||||
|
(vm:word :earthquake ; --
|
||||||
|
:full-redraw
|
||||||
|
:lit :furniture-yx
|
||||||
|
10 (vm:for :rnd :shl4 0x7ff :& :snooze
|
||||||
|
:dup :get :dup :itile-at 0x20 :+ :update-itile
|
||||||
|
:snd-explode
|
||||||
|
(vm:i) 9 := (vm:when (say :jaye "WOAH!") :hide-footer)
|
||||||
|
2 :+) :drop
|
||||||
|
0x1000 :snooze
|
||||||
|
(say :jaye "THAT WAS AN EARTHQUAKE!"))
|
||||||
|
|
||||||
|
(vm:word :firstdoor
|
||||||
|
(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.")
|
||||||
|
controlstate.neut :controlstate :bset
|
||||||
|
:move-to-responder
|
||||||
|
controlstate.jaye :controlstate :bset
|
||||||
|
(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...")
|
||||||
|
]) :scan)
|
||||||
|
|
||||||
|
level
|
||||||
6
neuttower/level2.fnl
Normal file
6
neuttower/level2.fnl
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
(local {: deflevel : say : itile} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local level (deflevel "game/map2.json" :level2))
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
level
|
||||||
93
neuttower/level3.fnl
Normal file
93
neuttower/level3.fnl
Normal file
|
|
@ -0,0 +1,93 @@
|
||||||
|
(local {: deflevel : say : itile : controlstate} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local level (deflevel "game/map3.json" :level3))
|
||||||
|
(local tile (require :game.tiles))
|
||||||
|
(local {: walkable : neutable : debris} tile.flag-to-bit)
|
||||||
|
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
(vm:word :level3-load vm.true :gord-sitting :set)
|
||||||
|
|
||||||
|
(vm:var :gord-introduced vm.false)
|
||||||
|
(vm:word :flicker :get-responder ev.tog :entity>do 0x400 :snooze)
|
||||||
|
(vm:word :gordterm ; ev --
|
||||||
|
(vm:if-and [[:is-neut?] [:dup ev.touch :=] [:gord-introduced :get :not]]
|
||||||
|
[vm.true :gord-introduced :set
|
||||||
|
(say :neut "HUMAN PRESENCE" "DETECTED")
|
||||||
|
:flicker :flicker :flicker :flicker
|
||||||
|
(say :neut "]HUMAN ASSISTANCE IS REQUIRED")
|
||||||
|
(say :neut "]IF HUMAN IS PRESENT" " PLEASE RESPOND")
|
||||||
|
:hide-footer :set-human-tileset :full-redraw
|
||||||
|
:flicker :flicker :flicker :flicker
|
||||||
|
(say :gord "WHAT THE...")
|
||||||
|
(say :gord "IS SOMEONE IN THE TERMINAL?")
|
||||||
|
:hide-footer :set-prog-tileset :full-redraw
|
||||||
|
(say :gord "]HUMAN IS PRESENT")
|
||||||
|
(say :neut "]GREETINGS, HUMAN")
|
||||||
|
(say :neut "]THIS IS NEUT V0.71.4RC12")
|
||||||
|
(say :neut "]PLEASE STATE NAME AND" " STATUS")
|
||||||
|
(say :gord "]THIS IS GORD")
|
||||||
|
(say :gord "V1, I GUESS.")
|
||||||
|
(say :gord "]LEG IS PINNED UNDER DESK" " UNABLE TO MOVE")
|
||||||
|
(say :neut "]CAN YOU REACH THE SWITCH" " BEHIND YOU?")
|
||||||
|
0x400 :snooze :lit :gordswitch ev.act :entity>do 0x400 :snooze
|
||||||
|
(say :gord "]I TURNED IT ON")
|
||||||
|
(say :neut "]MY PROGRAMMER THANKS" " YOU, GORD")
|
||||||
|
(say :neut "]WE WILL ASSIST YOU SOON")
|
||||||
|
(say :gord "]AWAITING YOUR HELP, NEUT")
|
||||||
|
:drop ev.noop])
|
||||||
|
:term)
|
||||||
|
|
||||||
|
(vm:var :gord-jaye-met vm.false)
|
||||||
|
(vm:word :gordtable ; ev --
|
||||||
|
ev.touch := (vm:when :transparent-entity-move
|
||||||
|
(vm:if-and [[:is-jaye?] [:gord-jaye-met :get :not]]
|
||||||
|
[vm.true :gord-jaye-met :set
|
||||||
|
(say :jaye "HEY! GORD?" "I'M JAYE.")
|
||||||
|
(vm:if
|
||||||
|
[(say :gord "JAYE, AM I GLAD TO SEE YOU." "CAN YOU MOVE THIS DESK?")
|
||||||
|
(say :jaye "LET ME TRY...")
|
||||||
|
(say :jaye ". . . ." "!!!!.....")
|
||||||
|
(say :jaye "!!!!!!!!!!!!...")
|
||||||
|
(say :jaye "NO, I DON'T THINK I CAN.")
|
||||||
|
(say :gord "I KEEP STARING AT THAT" "CLEANING ROBOT.")
|
||||||
|
(say :gord "HE LOOKS LIKE HE COULD" "LIFT A BUILDING.")]
|
||||||
|
[(say :gord "JAYE, AM I GLAD TO SEE YOU.")])]
|
||||||
|
[:drop])))
|
||||||
|
|
||||||
|
(vm:var :rexx-introduced)
|
||||||
|
(vm:word :meetrexx ; ev --
|
||||||
|
(vm:if-and [[:is-neut?] [:dup ev.touch :=] [:rexx-introduced :get :not]]
|
||||||
|
[vm.true :rexx-introduced :set
|
||||||
|
(say :neut "MOBILE ROBOTIC UNIT" "IDENTIFY YOURSELF")
|
||||||
|
(say :rexx "HIYA BOSS!" "I'M REXX, THE JANITOR!")
|
||||||
|
(say :rexx "AAAAAND YOUR NEW" "BEST FRIEND!!")
|
||||||
|
(say :neut "A HUMAN IS IN PERIL")
|
||||||
|
(say :neut "YOUR ASSISTANCE IS" "REQUIRED")
|
||||||
|
(say :rexx "YOU NEED ME TO TAKE OUT" "SOME GARBAGE??")
|
||||||
|
(say :rexx "OH BOY!! LET ME AT IT!")])
|
||||||
|
:rexx)
|
||||||
|
|
||||||
|
(vm:word :floor-clear? 0x406 walkable :flag-at?)
|
||||||
|
(vm:word :meetgord ; ev --
|
||||||
|
(vm:if-and [[ev.touch :=] [(itile :gord-ground) :responder-itile :=]]
|
||||||
|
[:is-rexx? (vm:when
|
||||||
|
(say :gord "AHHH NOOO" "NOT GARBAGE" "I AM NOT GARBAGE")
|
||||||
|
(say :rexx "WHATEVER YOU SAY, BOSS!"))
|
||||||
|
:is-jaye? (vm:when
|
||||||
|
(say :jaye "ARE YOU HURT?")
|
||||||
|
(say :gord "MY LEG WAS PINNED." "I DON'T THINK I CAN PUT" "ANY WEIGHT ON IT.")
|
||||||
|
(say :jaye "HERE, LET ME HELP YOU UP.")
|
||||||
|
(itile :t-floor) :set-respondertile
|
||||||
|
0xff00 :gord-dir :set
|
||||||
|
vm.false :gord-sitting :set
|
||||||
|
controlstate.gord :controlstate :bset
|
||||||
|
:get-responder :get :move-player-to
|
||||||
|
controlstate.jaye :controlstate :bset
|
||||||
|
(say :gord "THANKS.")
|
||||||
|
(say :jaye "DON'T MENTION IT.")
|
||||||
|
(say :jaye "I CAN HELP YOU GET AROUND IF" "YOU HELP ME NAVIGATE THIS" "MAZE OF A SECURITY SYSTEM.")
|
||||||
|
(say :gord "I'M JUST AS EAGER TO GET" "OUT OF HERE AS YOU.")
|
||||||
|
(say :gord "LET'S GO."))]))
|
||||||
|
|
||||||
|
level
|
||||||
18
neuttower/level4.fnl
Normal file
18
neuttower/level4.fnl
Normal file
|
|
@ -0,0 +1,18 @@
|
||||||
|
(local {: deflevel : say : itile} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local level (deflevel "game/map4.json" :level4))
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
(vm:word :term-dual-link
|
||||||
|
:lit :term-exit :entity-itile (itile :termon) := (vm:if [:lit :term-exit] [:lit :term-scan]))
|
||||||
|
|
||||||
|
(vm:var :gord-sat vm.false)
|
||||||
|
(vm:word :tutorial-chair ; ev --
|
||||||
|
ev.touch := (vm:when
|
||||||
|
:transparent-entity-move :drop
|
||||||
|
(vm:if-and [[:gord-sat :get :not] [:gord-sitting :get]]
|
||||||
|
[vm.true :gord-sat :set
|
||||||
|
(say :gord "PHEW, IT FEELS GOOD TO" "REST MY LEG FOR A BIT.")
|
||||||
|
(say :gord "IF YOU NEED ME TO DO SOMETHING" "FROM MY CHAIR, YOU CAN PRESS" "THE Z KEY.")])))
|
||||||
|
|
||||||
|
level
|
||||||
93
neuttower/level5.fnl
Normal file
93
neuttower/level5.fnl
Normal file
|
|
@ -0,0 +1,93 @@
|
||||||
|
(local {: deflevel : say : itile : controlstate : tilelist} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local tile (require :game.tiles))
|
||||||
|
(local {: notes} (require :neuttower.boop))
|
||||||
|
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit)
|
||||||
|
(local level (deflevel "game/map5.json" :level5))
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
(vm:word :snd-dropgarbage (notes [:a1] 0x02 0xf0))
|
||||||
|
(vm.code:append :debristiles)
|
||||||
|
(each [itile tiledef (ipairs tilelist)]
|
||||||
|
(when tiledef.flags.debris
|
||||||
|
(vm.code:append [:db (tile.encode-itile itile)])))
|
||||||
|
(vm:word :randomgarbage :rnd 0x03 :& :lit :debristiles :+ :bget)
|
||||||
|
|
||||||
|
(vm:var :doortimer 0)
|
||||||
|
(vm:word :start-doortimer 0x10 :doortimer :set)
|
||||||
|
(vm:word :doortimer-tick
|
||||||
|
:doortimer :get (vm:when
|
||||||
|
:doortimer :get 1 :- :dup :doortimer :set
|
||||||
|
:not (vm:when
|
||||||
|
:lit :timedswitch ev.deact :entity>do)))
|
||||||
|
|
||||||
|
(vm:word :do-timedswitch
|
||||||
|
; only gord is physically able to touch it
|
||||||
|
:dup ev.touch := (vm:when :start-doortimer :drop ev.act) :switch)
|
||||||
|
|
||||||
|
(vm:var :is-garbagerexx vm.false)
|
||||||
|
(vm:var :garbagerexx-yx 0x0710)
|
||||||
|
(vm:var :garbagerexx-introduced vm.false)
|
||||||
|
(vm:word :garbagerexx ; ev --
|
||||||
|
:is-rexx? :swap :rexx :is-rexx? := :not (vm:when
|
||||||
|
:is-rexx? (vm:if [
|
||||||
|
:garbagerexx-yx :get :get-responder :get := (vm:when
|
||||||
|
vm.true :is-garbagerexx :set
|
||||||
|
:garbagerexx-introduced :get :not (vm:when
|
||||||
|
(say :rexx "BO@oSSsS...,? htgz")
|
||||||
|
(say :rexx "I DON'T F3EL SO GOp0%foo)OD...>?qw" "idontfeelsogood")
|
||||||
|
vm.true :garbagerexx-introduced :set
|
||||||
|
))
|
||||||
|
] [
|
||||||
|
:is-garbagerexx :get (vm:when
|
||||||
|
:get-responder :get :garbagerexx-yx :set
|
||||||
|
vm.false :is-garbagerexx :set)
|
||||||
|
])))
|
||||||
|
|
||||||
|
(vm:word :not-picking-up? ; yxdest -- f
|
||||||
|
debris :flag-at? :not)
|
||||||
|
(vm:word :can-drop-rubble? ; yxdest -- f
|
||||||
|
:itile-at (itile :t-floor) :=
|
||||||
|
:rexx-yx :get :itile-at (itile :t-floor) := :&)
|
||||||
|
|
||||||
|
(vm:word :move-garbagerexx ; yx -- f
|
||||||
|
(vm:if-and [[:is-rexx?] [:is-garbagerexx :get]]
|
||||||
|
[:dup 0xff :& 0x0d := (vm:if [
|
||||||
|
(say :rexx "PARITYe#ERPORr(sbaitso" " tellmeabout" " your problems") :drop vm.true :ret
|
||||||
|
] [
|
||||||
|
(vm:if-and [[:dup :not-picking-up?] [:dup :can-drop-rubble?]]
|
||||||
|
[:rexx-yx :get :randomgarbage :update-itile :snd-dropgarbage])
|
||||||
|
])])
|
||||||
|
:move-noop)
|
||||||
|
|
||||||
|
(vm:word :move ; dir -- dir
|
||||||
|
:dup :player-yx :get :yx+ :move-player-to 0x300 :snooze)
|
||||||
|
(vm:word :explode ; dir --
|
||||||
|
:player-yx :get :yx+ :randomgarbage :update-itile :snd-explode)
|
||||||
|
|
||||||
|
(vm:word :explodingdoor
|
||||||
|
:dup :door
|
||||||
|
(vm:if-and [[ev.touch :=] [:is-jaye?] [:player-yx :get :get-responder :get :=] [:garbagerexx-yx :get :lit :south-rexx :get :=] [:gord-yx :get 0x812 :=]]
|
||||||
|
[:rexx-yx :get
|
||||||
|
:garbagerexx-yx :get :dup (itile :t-rexxstop) :update-itile :rexx-yx :set
|
||||||
|
controlstate.rexx :controlstate :bset
|
||||||
|
0x00ff :move :move :move
|
||||||
|
(say :rexx "DAAAISYY" " DAAAAAIIISYYYY" "d a i s y") :hide-footer
|
||||||
|
:move :drop 0xff00 :move
|
||||||
|
(say :rexx "GIVE ME" " .,#YOUR ANSWEibmER" " %$DOO00OOooo@'bell\"") :hide-footer
|
||||||
|
:move :drop
|
||||||
|
(say :rexx "UH OH") :hide-footer
|
||||||
|
0xff00 :explode 0x0100 :explode 0x00ff :explode 0x0001 :explode 0 :explode
|
||||||
|
0xffff :garbagerexx-yx :set
|
||||||
|
controlstate.jaye :controlstate :bset
|
||||||
|
:rexx-yx :set]))
|
||||||
|
|
||||||
|
(vm:var :healthyrexx-introduced vm.false)
|
||||||
|
(vm:word :healthyrexx ; ev --
|
||||||
|
(vm:if-and [[:is-neut?] [:dup ev.touch :=] [:healthyrexx-introduced :get :not]]
|
||||||
|
[(say :neut "REXX UNIT" "PERFORM FULL DIAGNOSTIC SCAN")
|
||||||
|
(say :rexx "I'M IN TIP-TOP SHAPE, BOSS!")
|
||||||
|
(say :neut "ACTIVATING RELIEF SUBROUTINE")
|
||||||
|
vm.true :healthyrexx-introduced :set]) :rexx)
|
||||||
|
|
||||||
|
level
|
||||||
169
neuttower/level6.fnl
Normal file
169
neuttower/level6.fnl
Normal file
|
|
@ -0,0 +1,169 @@
|
||||||
|
(local {: deflevel : say : say-runon : itile : controlstate} (require :neuttower.defs))
|
||||||
|
(local {: ev} (require :neuttower.entity))
|
||||||
|
(local tile (require :game.tiles))
|
||||||
|
(local {: walkable : neutable : debris : sittable} tile.flag-to-bit)
|
||||||
|
(local level (deflevel "game/map6.json" :level6))
|
||||||
|
(local vm level.vm)
|
||||||
|
|
||||||
|
(vm:word :linkloop ; e -- e
|
||||||
|
(vm:until :link-arg :dup :entity-itile (itile :termon) :=))
|
||||||
|
|
||||||
|
(vm:var :encountered-keypad vm.false)
|
||||||
|
(vm:word :first-keypad ; ev code --
|
||||||
|
(vm:if-and [[:encountered-keypad :get :not] [:is-jaye?] [:over ev.touch :=]]
|
||||||
|
[vm.true :encountered-keypad :set
|
||||||
|
(say :pady "HELLO, STRANGER! I'M PADY," "THE FRIENDLY KEYPAD LOCK!")
|
||||||
|
(say :jaye "I NEED TO GET THROUGH THIS" "DOOR, PADY.")
|
||||||
|
(say :pady "YOU DIDN'T SAY THE MAGIC" "WORD, STRANGER!")])
|
||||||
|
(vm:if-and [[:is-neut?] [:over ev.touch :=] [:responder-itile (itile :t-keyoff) :=]]
|
||||||
|
[(say :pady "OH HI THERE, SUSPICIOUS" "PROGRAM! WHAT CAN I DO" "YOU FOR?")
|
||||||
|
(say :neut "PEOPLE ARE IN DANGER" "PLEASE OPEN THE DOOR")
|
||||||
|
(say :pady "WELL THAT'S TERRIBLE!" "BUT I JUST CAN'T OPEN" "WITHOUT THE PROPER CODE.")
|
||||||
|
:libb-present :get (vm:when (say :libb "OH JEEZ, LET ME AT HER, NEUT."))])
|
||||||
|
(vm:if-and [[:responder-itile (itile :t-keyoff) :=] [:over :evhack?]]
|
||||||
|
[(say :pady "ANOTHER STRANGE PROGRAM!" "MY, I'M POPULAR TODAY!")
|
||||||
|
(say :libb "OH PUKE. PLEASE SHUT UP.")
|
||||||
|
(say-runon :pady "HOW RUD")
|
||||||
|
:snd-libb
|
||||||
|
(say :libb "]/WINNUKE 182.556.21.74")
|
||||||
|
(say :pady "PADYSEC CAUSED A GENERAL" "PROTECTION FAULT IN MODULE" "MORICON.DLL AT 000A:BE3F.")
|
||||||
|
(say :libb "]/OPEN")])
|
||||||
|
:keypad)
|
||||||
|
|
||||||
|
(vm:word :keypad1 0x5197 :first-keypad)
|
||||||
|
(vm:word :keypad2 0x2757 :first-keypad)
|
||||||
|
(vm:word :keypad3 0xffff :first-keypad)
|
||||||
|
(vm:word :keypad4 0x7777 :first-keypad)
|
||||||
|
|
||||||
|
(vm:word :term-message? :dup :term ev.touch := :is-jaye? :&)
|
||||||
|
(vm:word :c1
|
||||||
|
:dup :evhack? (vm:when
|
||||||
|
(say :libb "JUST A BUNCH OF BORING" "SOURCE CODE.")
|
||||||
|
(say :libb "BILL DIDN'T LEAVE ANYTHING" "REALLY JUICY HERE WHERE" "OTHER PEOPLE COULD GET AT IT."))
|
||||||
|
:term-message? (vm:when
|
||||||
|
(say :term ".:: WELCOME TO FARQUAAD ::." "OS: PRODOS 2.6" "RAM: 8 FREAKIN MEGABYTES D00D" "SYSADMIN: BILL")
|
||||||
|
(say :term "S3CR3T C0D3Z: GET OUT LAMER" "BOSS KEY: CTRL-B TO ACTIVATE" "OPEN POD BAY DOORS:" " I CAN'T DO THAT DAVE")
|
||||||
|
(say :term "GOOD RIDDANCE")))
|
||||||
|
(vm:word :c2 :term-message? (vm:when
|
||||||
|
(say :term "SUBJECT: MISUSE OF REXX" "THANKS TO *SOME*ONE, WHO SHALL" "REMAIN NAMELESS, THAT DECIDED" "IT WOULD BE 'FUNNY' TO")
|
||||||
|
(say :term "TEACH THE CLEANING ROBOT TO" "PLAY FETCH WITH EXPENSIVE" "EQUIPMENT, ACCESS TO REXX" "BY DEVELOPERS WILL BE STRICTLY")
|
||||||
|
(say :term "CONTROLLED BY MANAGEMENT." "THE CODE HAS BEEN CHANGED." "DO NOT ATTEMPT TO HACK THE" "KEYPAD. THIS MEANS *YOU*, BILL.")))
|
||||||
|
(vm:word :c3 :term-message? (vm:when
|
||||||
|
(say :term "SUBJECT: SERVER'S DOWN" "HEY, I DON'T HAVE THE CODE TO" "ACCESS THE SERVER ROOM. CAN" "SOMEONE REBOOT IT FOR ME?")
|
||||||
|
(say :term "SUBJECT: RE: SERVER'S DOWN" "I DON'T HAVE *TIME* FOR THIS" "NONSENSE!!" "REBOOT IT YOURSELF.")
|
||||||
|
:lit :firewall :entity-itile (itile :termon) := (vm:if
|
||||||
|
[(say :term "THE PASSCODE IS" "[ BLOCKED BY FIREWALL ].")]
|
||||||
|
[(say :term "THE PASSCODE IS" "5197.")])
|
||||||
|
(say :term "SUBJECT: RE: RE: SERVER'S DOWN" "UHHHH THE FIREWALL IS BLOCKING" "THE PASSCODE?")
|
||||||
|
(say :term "SUBJECT: RE: RE: SERVER'S DOWN" "AUGH FINE! I REBOOTED IT.")))
|
||||||
|
(vm:word :c4
|
||||||
|
:dup :evhack? (vm:when
|
||||||
|
(say :libb "I BROUGHT EVERYTHING GOOD" "ALONG WITH ME, DON'T WORRY."))
|
||||||
|
(vm:if-and [[:dup ev.touch :=] [:is-neut?] [:libb-present :get :not]]
|
||||||
|
[(say :libb "WELL, WELL, WELL." "WHAT HAVE WE HERE?")
|
||||||
|
(say :libb "]/VERSION")
|
||||||
|
(say :neut "!NEUT V0.71.4RC12")
|
||||||
|
(say :neut "]BRUN IDENTIFYPROGRAM")
|
||||||
|
(say :libb "!LIBB V2.718282")
|
||||||
|
(say :libb "OH, A NOSY LITTLE FELLA.")
|
||||||
|
(say :neut "NOT A FELLA")
|
||||||
|
(say :libb "PERHAPS YOU AND I COULD" "HELP EACH OTHER.")
|
||||||
|
(say :neut "WE ARE ASSISTING ALL WHO" "ARE IN NEED")
|
||||||
|
(say :libb "I'VE BEEN WATCHING THE" "NETWORK. IT'S KIND OF WHAT" "I DO.")
|
||||||
|
(say :libb "YOU AND YOUR PROGRAMMER," "YOU'RE ESCAPING, AREN'T" "YOU?")
|
||||||
|
(say :neut "THE BUILDING IS UNSAFE" "WE ARE HELPING")
|
||||||
|
(say :libb "I WANT OUT, NEUT.")
|
||||||
|
(say :libb "I HATE BEING COOPED UP IN" "THIS LOCKED-DOWN CORPORATE" "HELLHOLE OF A NETWORK.")
|
||||||
|
(say :libb "YOU'RE GOING TO TAKE ME" "WITH YOU.")
|
||||||
|
(say :neut "THIS COURSE OF ACTION" "ALSO SEEMS POTENTIALLY" "UNSAFE")
|
||||||
|
(say :libb "THAT WASN'T A THREAT, NEUT." "THAT WAS A FACT.")
|
||||||
|
(say :libb "YOU CAN'T GET OUT OF HERE" "WITHOUT ME.")
|
||||||
|
(say :libb "I CAN DISABLE KEYPADS." "I CAN REPROGRAM TERMINALS." "I CAN *HELP*, NEUT.")
|
||||||
|
:hide-footer 0x800 :snooze
|
||||||
|
(say :neut "IT NEVER HURTS TO HELP")
|
||||||
|
(say :libb "THAT'S THE SPIRIT.")
|
||||||
|
(say :neut "]BLOAD LIBB")
|
||||||
|
(say :libb "AWW YISS.")
|
||||||
|
(say :libb "PRESS Z WHEN YOU NEED ME" "TO MESS WITH SOMETHING.")
|
||||||
|
vm.true :libb-present :set])
|
||||||
|
:term-message? (vm:when
|
||||||
|
(say :term ".:: BILL'S WORKSTATION ::." "KEEP OUT DIPSHITS")))
|
||||||
|
(vm:word :c5 :term-message? (vm:when
|
||||||
|
(say :gord "A WEIRD LOOKING SPREADSHEET...")
|
||||||
|
(say :gord "OH WAIT, I PRESSED A KEY AND" "IT DISAPPEARED. SOMEONE USING" "THE BOSS KEY TO HIDE" "THAT THEY'RE READING THE ENTIRE")
|
||||||
|
(say :gord "ARCHIVE OF USER FRIENDLY" "COMIC STRIPS.")))
|
||||||
|
(vm:word :c6
|
||||||
|
:dup :evhack? (vm:when
|
||||||
|
(say :libb "HEHEHE, THAT WAS A FUN ONE."))
|
||||||
|
:term-message? (vm:when
|
||||||
|
(say :term "SUBJECT: CARD SCANNERS?" "LOOKS LIKE THE SCANNERS ARE" "ON THE FRITZ AGAIN..." "I SCANNED MY KEYCARD TO GET")
|
||||||
|
(say :term "INTO THE OFFICE AND THE DOOR" "WOULDN'T CLOSE!" "SOMEONE'S GOTTA FIX THAT ASAP," "IT'S A SERIOUS SECURITY PROBLEM!")
|
||||||
|
(say :term "SUBJECT: RE: CARD SCANNERS?" "I CAN TAKE A QUICK LOOK, I" "MIGHT HAVE AN IDEA AS TO" "WHAT'S GOING ON. -- BILL")))
|
||||||
|
(vm:word :c7
|
||||||
|
:dup :evhack? (vm:when
|
||||||
|
(say :libb "YOU KNOW THE SWITCH IS RIGHT" "THERE ON THE WALL, RIGHT?"))
|
||||||
|
(vm:if-and [[:dup ev.touch :=] [:is-jaye?]]
|
||||||
|
[:responder-itile (itile :termon) := (vm:if
|
||||||
|
[(say :term "WORKSECURE (TM) V2.0" "AUTHORIZED PERSONNEL ONLY")
|
||||||
|
(say :term "ACTIVELY NEUTRALIZING:" "1 THREAT(S)")]
|
||||||
|
[(say :jaye "LOOKS LIKE THE POWER IS CUT.")])
|
||||||
|
:drop ev.noop]) :term)
|
||||||
|
(vm:word :c8 :term-message? (vm:when
|
||||||
|
(say :term "SUBJECT: PASSWORD SECURITY" "A REMINDER TO ALL DEVELOPERS" "ABOUT SECURITY BEST PRACTICE:" "**DO NOT WRITE DOWN PASSWORDS!**")
|
||||||
|
(say :term "WE PAY SIGNIFICANT LICENSE FEES" "FOR ENCRYPTED PASSWORD" "MANAGERS FOR ALL EMPLOYEES!")
|
||||||
|
(say :term "USE IT TO GENERATE AND STORE" "SECURE PASSWORDS!")
|
||||||
|
(say :jaye "THERE'S A STICKY NOTE ATTACHED" "TO THE MONITOR THAT SAYS" "'7777'.")))
|
||||||
|
(vm:word :c9
|
||||||
|
:dup :evhack? (vm:when
|
||||||
|
(say :libb "HE'S JUST BEING DRAMATIC."))
|
||||||
|
:term-message? (vm:when
|
||||||
|
(say :term "SUBJECT: EXPERIMENT" "HEY FOLKS, CAN YOU ALL DO ME A" "HUGE FAVOUR?" "THERE WAS A SMALL BUG IN MY")
|
||||||
|
(say :term "CODE (YES, IT HAPPENS!) AND A" "PROGRAM I WAS WORKING ON" "MADE A FEW TOO MANY COPIES OF" "ITSELF. CAN EVERYONE CHECK TO")
|
||||||
|
(say :term "SEE IF YOU HAVE A PROCESS" "CALLED 'LIBB' RUNNING ON YOUR" "TERMINAL?")
|
||||||
|
(say :term "IF YOU DO, PLEASE KILL -9 IT" "AND SHOOT ME A QUICK EMAIL." "*DON'T INTERACT WITH IT.*")
|
||||||
|
(say :term "IT COULD SERIOUSLY MESS WITH" "YOUR SYSTEM." " -- BILL")))
|
||||||
|
(vm:word :cx
|
||||||
|
(vm:if-and [[:dup ev.touch :=] [:is-jaye?] [:responder-itile (itile :termoff) :=]]
|
||||||
|
[(say :jaye "THIS IS THE SIGN-IN TERMINAL" "USED BY VISITORS.")
|
||||||
|
(say :jaye "IT'S NOT TURNING ON FOR SOME" "REASON.")
|
||||||
|
:drop ev.noop]) :term)
|
||||||
|
|
||||||
|
(fn center [str lineaddr]
|
||||||
|
[:vm (vm:str str) (+ lineaddr (math.floor (/ (- 40 (length str)) 2))) :draw-text])
|
||||||
|
(vm:word :endgame :drop
|
||||||
|
(vm:pstr "ELEVATOR.SCREEN") :loadscreen
|
||||||
|
(vm:until :read-key)
|
||||||
|
0x2280 :clearline 0x2300 :clearline 0x2380 :clearline
|
||||||
|
0x2028 :clearline 0x20a8 :clearline 0x2128 :clearline
|
||||||
|
0x21a8 :clearline 0x2228 :clearline 0x22a8 :clearline
|
||||||
|
0x2328 :clearline 0x23a8 :clearline 0x2050 :clearline
|
||||||
|
|
||||||
|
(center "JAYE AND GORD HAVE FOUND THEIR WAY" 0x2300)
|
||||||
|
(center "TO THE ELEVATOR!" 0x2380)
|
||||||
|
(center "BUT HAVE THEY FOUND THEIR WAY" 0x2028)
|
||||||
|
(center "TO FREEDOM?" 0x20a8)
|
||||||
|
(center "ARE THERE OTHERS IN THE BUILDING" 0x2128)
|
||||||
|
(center "IN NEED OF HELP?" 0x21a8)
|
||||||
|
(center "AND WHAT FATE AWAITS NEUT AND THEIR" 0x2228)
|
||||||
|
(center "SHIFTY NEW FRIEND LIBB?" 0x22a8)
|
||||||
|
(center "TO BE CONTINUED..." 0x23a8)
|
||||||
|
(vm:until :read-key)
|
||||||
|
|
||||||
|
:cleargfx
|
||||||
|
(center "NEU] [OWER" 0x2300)
|
||||||
|
(center "BY JEREMY PENNER" 0x2380)
|
||||||
|
|
||||||
|
(center "EVERY BYTE OF THIS GAME WAS CREATED" 0x20a8)
|
||||||
|
(center "WITH LOVE USING THE HONEYLISP" 0x2128)
|
||||||
|
(center "PROGRAMMING ENVIRONMENT" 0x21a8)
|
||||||
|
|
||||||
|
(center "GREETS TO:" 0x22a8)
|
||||||
|
(center "GLORIOUS TRAINWRECKS" 0x2328)
|
||||||
|
(center "DIRTY RECTANGLES" 0x23a8)
|
||||||
|
(center "#FENNEL" 0x2050)
|
||||||
|
(center "KANSASFEST" 0x20d0)
|
||||||
|
|
||||||
|
(center "APPLE ][ FOREVER!" 0x21d0)
|
||||||
|
(vm:forever))
|
||||||
|
|
||||||
|
level
|
||||||
39
neuttower/map.fnl
Normal file
39
neuttower/map.fnl
Normal file
|
|
@ -0,0 +1,39 @@
|
||||||
|
(local {: lo : hi} (require :lib.util))
|
||||||
|
(local {: vm : mapw : maph : rot8l} (require :neuttower.defs))
|
||||||
|
|
||||||
|
(vm:def :lookup-flags ; itile -- flags
|
||||||
|
[:lda vm.TOP :x]
|
||||||
|
(rot8l 3) ; lllhhhhh > hhhhhlll
|
||||||
|
[:adc #(lo ($1:lookup-addr :tileflags))]
|
||||||
|
[:sta vm.W]
|
||||||
|
[:lda #(hi ($1:lookup-addr :tileflags))]
|
||||||
|
[:adc 0]
|
||||||
|
[:sta vm.WH]
|
||||||
|
[:ldy 0] [:lda [vm.W] :y]
|
||||||
|
[:sta vm.TOP :x])
|
||||||
|
|
||||||
|
(vm:def :map-at ; yx -- pmap
|
||||||
|
[:lda (- maph 1)]
|
||||||
|
[:sec]
|
||||||
|
[:sbc vm.TOPH :x]
|
||||||
|
[:asl :a] ; x2
|
||||||
|
[:asl :a] ; x4
|
||||||
|
[:sta vm.TOPH :x]
|
||||||
|
[:asl :a] ; x8
|
||||||
|
[:asl :a] ; x16
|
||||||
|
[:clc] [:adc vm.TOPH :x] ; x20
|
||||||
|
[:adc vm.TOP :x]
|
||||||
|
[:sta vm.TOP :x]
|
||||||
|
[:lda :map-page]
|
||||||
|
[:sta vm.TOPH :x])
|
||||||
|
(vm:word :itile-at ; yx -- itile
|
||||||
|
:map-at :bget)
|
||||||
|
|
||||||
|
(vm:word :update-itile ; yx itile --
|
||||||
|
:over :map-at :bset :drawtile-at)
|
||||||
|
|
||||||
|
(vm:word :drawtile-at ; yx --
|
||||||
|
:dup :yx>screen :swap
|
||||||
|
:itile-at :lookup-tile
|
||||||
|
:drawtile)
|
||||||
|
|
||||||
1
neuttower/map1.json
Normal file
1
neuttower/map1.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"loadword":"earthquake","map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0C2C0C0C0C0C0C0C081C0C0C0C0C0612161C0C08282C0C0C082C0C0C061C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C082C182C0C0E082612161C2C08282C0C0C0C082C0C061616161616161216161616161C16181616161616143C0C0C282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E0828282C0C0C0C0C2C0C081C0C0C0C003612161C2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C043C2C0C0C0C0C0C061C0C0C003C061216161616161616161228161616161616161610221","jaye":{"y":9,"x":15},"tickword":"","moveword":"","objects":[{"x":8,"func":"door","linkword":"","name":"","y":6},{"x":2,"func":"firstterm","y":4,"name":"","linkword":"","link":3},{"x":17,"func":"neutterm","y":8,"name":"","linkword":"","link":2},{"x":13,"func":"switch","y":8,"name":"","linkword":"","link":8},{"link":6,"x":9,"y":1,"linkword":"","name":"","func":"exitscanner"},{"x":10,"linkentity":"level2","func":"exitdoor","y":1,"name":"","linkword":"exitlevel"},{"link":1,"x":6,"y":6,"linkword":"","name":"","func":"switch"},{"x":13,"func":"firstdoor","name":"","linkword":"","y":10}]}
|
||||||
1
neuttower/map2.json
Normal file
1
neuttower/map2.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"neut":{"y":12,"x":10},"map":"616161616161626161618161616161616161612161C0C0C06361C0C0E0C0C0C0C0C06103C0C0022161E0C0C0C081C0C0C0C0C0C0C0C081C0C0E0614161C0C0C0C06143C0C0C0C0C0C04322C0C0C0222161C0C0C0C061618161616161816161C0C0C00221616181616161C0C0C06143C0C0C061618161612161C0C0C06361E0C0C061C0C0C0C0C1E0C003612122C0C0C0C061C0C0C061C0E0C0C061C0C0C0022161C0C0C0C061616161616261616161C0C0C061416101C0C0C081C0C0E061C0C0E0C081C0C0C0022162C0C0C02361E0C0C06143C0C0C061E2A2E061216161C1616261612281616122226162C1C1616121","loadword":"","jaye":{"y":11,"x":11},"tickword":"","moveword":"","objects":[{"x":9,"link":2,"func":"term","linkword":"","name":"","y":11},{"x":2,"link":6,"func":"term","linkword":"","name":"","y":3},{"x":6,"func":"door","linkword":"","name":"","y":10},{"x":1,"link":5,"func":"scan","linkword":"","name":"","y":5},{"x":8,"func":"door","linkword":"","name":"","y":8},{"x":7,"link":2,"func":"term","linkword":"","name":"","y":6},{"x":12,"link":8,"func":"scan","linkword":"","name":"","y":1},{"x":17,"func":"door","linkword":"","name":"","y":7},{"x":13,"link":10,"func":"scan","linkword":"","name":"","y":1},{"x":13,"func":"door","linkword":"","name":"","y":8},{"x":15,"link":12,"func":"switch","linkword":"","name":"","y":6},{"x":2,"link":13,"func":"term","linkword":"","name":"","y":10},{"x":12,"link":12,"func":"term","linkword":"","name":"","y":5},{"x":15,"link":15,"func":"scan","linkword":"","name":"","y":9},{"x":15,"func":"door","linkword":"","name":"","y":10},{"x":16,"link":17,"func":"term","linkword":"","name":"","y":6},{"x":18,"link":16,"func":"term","linkword":"","name":"","y":10},{"x":15,"func":"door","linkword":"","name":"","y":3},{"x":19,"link":18,"func":"scan","linkword":"","name":"","y":9},{"x":13,"link":21,"func":"term","linkword":"","name":"","y":3},{"x":18,"link":20,"func":"term","linkword":"","name":"","y":2},{"x":8,"link":23,"func":"scan","linkword":"","name":"","y":1},{"x":9,"linkentity":"level3","func":"exitdoor","linkword":"exitlevel","name":"","y":1},{"x":16,"link":3,"func":"switch","linkword":"","name":"","y":1},{"x":3,"link":26,"func":"switch","linkword":"","name":"","y":1},{"x":6,"func":"door","linkword":"","name":"","y":3},{"x":9,"link":28,"func":"term","linkword":"","name":"","y":3},{"x":7,"link":27,"func":"term","linkword":"","name":"","y":2},{"x":3,"func":"door","linkword":"","name":"","y":7},{"x":17,"link":29,"func":"switch","linkword":"","name":"","y":1}]}
|
||||||
1
neuttower/map3.json
Normal file
1
neuttower/map3.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"neut":{"y":12,"x":8},"map":"616161616161616181616161616161616161612161C063C0C0C0C0C0C0C06143C0E0C2C0C043022161C0C0C0C0C0C0C0C0C022C0C0C0C0C0C0C0614161C0C0C2C0C0C0C0C0C081C0C0C0C0C0C0C0612161C08282A2C0C0C0C0436123C0C0C0C0C0030221616161616161616261616161618161616161612161C063C0C02301C3C163C0C0C0C0C0822363022122C0C0C0C0C0C0A2A1C0C0C0C0C0C0C2C0C0614181C0C0C0C0E2C0C061C0C0C0C0C0C0C0C2C061216123C0C0C0C083C061E0C2C0C0C0C0438203022161610261610261616161026161026161026161212121212141212121212121212121412121212121","loadword":"level3-load","jaye":{"y":11,"x":9},"tickword":"","moveword":"","objects":[{"link":2,"x":1,"y":5,"linkword":"","name":"","func":"scan"},{"x":1,"linkentity":"level4","func":"exitdoor","name":"","linkword":"exitlevel","y":4},{"link":4,"x":7,"y":6,"linkword":"","name":"","func":"gordterm"},{"link":7,"x":14,"y":11,"linkword":"","name":"","func":"term"},{"link":6,"x":9,"y":6,"linkword":"","name":"gordswitch","func":"switch"},{"x":11,"func":"door","name":"","linkword":"","y":9},{"link":3,"x":10,"y":3,"linkword":"","name":"","func":"term"},{"link":9,"x":11,"y":10,"linkword":"","name":"","func":"scan"},{"x":14,"func":"door","name":"","linkword":"","y":7},{"x":7,"func":"meetrexx","y":3,"name":"","linkword":""},{"x":8,"func":"meetgord","y":6,"name":"","linkword":""},{"x":8,"func":"gordtable","y":5,"linkword":"","name":""}]}
|
||||||
1
neuttower/map4.json
Normal file
1
neuttower/map4.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"neut":{"y":5,"x":20},"map":"61616161616161616261616161616161616161616143C0C0C082E082C0C0636163C0C083C0C0436161C0C0C0C0C0C2C0C0C0C061C0C0C0C0C0C0C06161C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0C0C2616103C0C0A3C0C0C003C0C06163C0C0C0C082A2616161616161C1C1C16161812261618161616161616143C0C0C0C0C0C04361C0C0C0C0C0C0C0C0636181C0C0C0C0C0C0C0C081C0C0C0C0C0C0C0C0C06122C0C0C0C0C0E2C0C0C1A2E2C0C0C0C0C0C0C08161E082828282E0C02361A2C0C0C0C0C0C003236161026161610222616102616161610261616102612121214121212121212121212121412121212121","loadword":"","gord-following":true,"jaye":{"y":4,"x":19},"tickword":"","moveword":"","objects":[{"x":7,"func":"term","y":11,"linkword":"term-dual-link","name":""},{"link":1,"y":3,"func":"term","name":"term-exit","linkword":"","x":2},{"link":1,"y":3,"func":"term","name":"term-scan","linkword":"","x":7},{"x":11,"func":"door","y":7,"linkword":"","name":""},{"link":4,"y":7,"func":"scan","name":"","linkword":"","x":12},{"x":15,"func":"door","y":7,"linkword":"","name":""},{"link":3,"y":7,"func":"switch","name":"","linkword":"","x":7},{"x":10,"func":"door","y":5,"linkword":"","name":""},{"link":4,"y":4,"func":"switch","name":"","linkword":"","x":10},{"x":16,"func":"rexx","y":11,"linkword":"","name":""},{"link":8,"y":2,"func":"scan","name":"","linkword":"","x":7},{"link":13,"y":4,"func":"scan","name":"","linkword":"","x":1},{"x":1,"linkentity":"level5","func":"exitdoor","y":5,"linkword":"exitlevel","name":""},{"x":5,"func":"rexx","y":8,"linkword":"","name":""},{"x":7,"func":"tutorial-chair","linkword":"","name":"","y":10},{"link":6,"x":8,"y":7,"linkword":"","name":"","func":"switch"},{"link":2,"x":6,"y":7,"linkword":"","name":"","func":"switch"}]}
|
||||||
1
neuttower/map5.json
Normal file
1
neuttower/map5.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"neut":{"y":6,"x":20},"map":"21616161228161616161616161616161616162612102E0C0C0C0C0E0C04361C0C0C0C0C0A3C0C0612161C0C0C0C0C0C0C0C022C0C0C08282C0828261416103C0C0C0C0C0C0C081C0C0C0C0C0C0C0C2C1210203C0C0C0C0C0C04361C0C0C08282838282622161616161816161616161618161616161616161216163C0C0C0C0E0C0C06143C0C0C0C0C0C063612102C0C0C0C0C0C0C0C061C0C0C0C0C0C0C0C0814161C0C0C0C0E2C0E2836101C0C0C0C0C0C0C0C1216143C0C0C082A2A2A281C0C0C043034382E26121610261610261C16102616161026161610261612121212121214121212121212121214121212121","loadword":"","tickword":"doortimer-tick","jaye":{"y":5,"x":19},"gord-following":true,"moveword":"move-garbagerexx","objects":[{"x":17,"func":"garbagerexx","name":"south-rexx","linkword":"","y":11},{"x":17,"func":"garbagerexx","name":"","linkword":"","y":8},{"link":13,"x":20,"y":9,"linkword":"","name":"timedswitch","func":"do-timedswitch"},{"link":16,"x":20,"y":4,"linkword":"","name":"","func":"switch"},{"link":9,"x":12,"y":4,"linkword":"","name":"","func":"term"},{"x":10,"func":"healthyrexx","name":"","linkword":"","y":4},{"link":17,"x":8,"y":2,"linkword":"","name":"","func":"switch"},{"link":10,"x":8,"y":6,"linkword":"","name":"","func":"term"},{"link":5,"x":8,"y":11,"linkword":"","name":"","func":"term"},{"link":8,"x":3,"y":11,"linkword":"","name":"","func":"term"},{"link":12,"x":5,"y":12,"linkword":"","name":"","func":"scan"},{"x":6,"linkentity":"level6","func":"exitdoor","name":"","linkword":"exitlevel","y":12},{"x":6,"func":"door","name":"","linkword":"","y":7},{"x":11,"func":"explodingdoor","name":"","linkword":"","y":9},{"link":14,"x":11,"y":10,"linkword":"","name":"","func":"scan"},{"x":13,"func":"door","name":"","linkword":"","y":7},{"x":11,"func":"door","name":"","linkword":"","y":3}]}
|
||||||
1
neuttower/map6.json
Normal file
1
neuttower/map6.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
{"neut":{"y":1,"x":5},"map":"210261616161616161616161812261616161E1614161C2C081C0C0C0C0C0C0C0C0C0E0C081C0C0622161E04384C0C0C043C0C0C043C0C0C0848201612102616161C0C061610281026161C0C0616161612161C2C0C0C0C061E2C0C0C0A261C0C0C0C0E2612161E003C0C0C061C0C0C0C08261C0C0C003E06121026161C0C0C061E08282E2E061C0C0C06161612161C2C0C0C0C06103C0C0C02361C0C0C0C0C2614161E003C0C0C0616102C1026161C0C0C003E06121026184C0C0C0C043C043C063C0C0C0846161612161E081C0C0C0C0C0C0C0C0C0C0C0C081C083612161612261816161616161616161616161616161","loadword":"","tickword":"","jaye":{"y":2,"x":6},"gord-following":true,"moveword":"","objects":[{"x":3,"func":"c4","y":10,"name":"","linkword":"linkloop","link":6},{"x":5,"func":"keypad2","y":10,"name":"","linkword":"","link":3},{"x":5,"func":"door","y":11,"name":"","linkword":""},{"x":11,"func":"door","y":9,"name":"","linkword":""},{"x":13,"func":"c9","y":6,"name":"","linkword":"linkloop","link":17},{"x":9,"func":"c8","y":6,"name":"","linkword":"linkloop","link":5},{"link":23,"y":4,"func":"switch","linkword":"","name":"","x":11},{"x":3,"func":"c3","y":7,"name":"","linkword":"linkloop","link":1},{"x":3,"func":"c2","y":4,"name":"","linkword":"linkloop","link":8},{"x":3,"func":"c1","y":2,"name":"","linkword":"linkloop","link":23},{"x":4,"func":"door","y":2,"name":"","linkword":""},{"x":4,"func":"keypad1","y":3,"name":"","linkword":"","link":11},{"x":4,"func":"scan","y":1,"name":"","linkword":"","link":4},{"x":17,"func":"door","y":2,"name":"","linkword":""},{"x":17,"func":"keypad3","y":3,"name":"","linkword":"","link":14},{"x":19,"func":"rexx","y":2,"name":"","linkword":""},{"x":19,"func":"c5","y":4,"name":"","linkword":"linkloop","link":18},{"x":19,"func":"c6","y":7,"name":"","linkword":"linkloop","link":19},{"x":19,"func":"c7","y":10,"name":"firewall","linkword":"linkloop","link":10},{"x":19,"func":"switch","y":12,"name":"","linkword":"","link":19},{"x":17,"func":"keypad4","y":10,"name":"","linkword":"","link":22},{"x":17,"func":"door","y":11,"name":"","linkword":""},{"x":15,"func":"cx","y":11,"name":"","linkword":"linkloop","link":9},{"x":14,"func":"scan","y":12,"name":"","linkword":"","link":25},{"x":13,"linkentity":"","func":"exitdoor","y":12,"name":"","linkword":"endgame"}]}
|
||||||
184
neuttower/player.fnl
Normal file
184
neuttower/player.fnl
Normal file
|
|
@ -0,0 +1,184 @@
|
||||||
|
(local tile (require :game.tiles))
|
||||||
|
(local {: vm : mapw : maph : itile : controlstate} (require :neuttower.defs))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(vm:var :rexx-yx 0xffff)
|
||||||
|
(vm:var :gord-yx 0xffff)
|
||||||
|
(vm:var :gord-dir 0x0000)
|
||||||
|
(vm:var :gord-sitting vm.false)
|
||||||
|
(vm:var :libb-yx 0xffff)
|
||||||
|
(vm:var :libb-present vm.false)
|
||||||
|
|
||||||
|
(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? :|)
|
||||||
|
(vm:word :is-walking? :movable-player-flag walkable :=)
|
||||||
|
(vm:word :neut-hidden? :neut-yx :get 0xffff :=)
|
||||||
|
(vm:word :rexx-active? :rexx-yx :get 0xffff := :not)
|
||||||
|
(vm:word :gord-hidden? :gord-yx :get 0xffff :=)
|
||||||
|
(vm:word :gord-following? :gord-hidden? :gord-sitting :get :| :not)
|
||||||
|
(vm:word :libb-hidden? :libb-yx :get 0xffff :=)
|
||||||
|
|
||||||
|
(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]
|
||||||
|
[controlstate.gord :gord-tile]
|
||||||
|
[controlstate.libb :libb-tile]
|
||||||
|
[:else (itile :t-rexx)]) :lookup-tile)
|
||||||
|
|
||||||
|
(vm:word :player-yx ; -- pyx
|
||||||
|
:controlstate :bget
|
||||||
|
(vm:case [controlstate.jaye :jaye-yx]
|
||||||
|
[controlstate.neut :neut-yx]
|
||||||
|
[controlstate.gord :gord-yx]
|
||||||
|
[controlstate.libb :libb-yx]
|
||||||
|
[: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:var :noclip)
|
||||||
|
(vm:word :move-if-clear ; yx -- f
|
||||||
|
:noclip :get (vm:if [:drop vm.false] [:movable-player-flag :flag-at? :not]))
|
||||||
|
|
||||||
|
(vm:word :movable-player-flag ; -- flag
|
||||||
|
:is-neut? (vm:if [neutable] [walkable]))
|
||||||
|
|
||||||
|
(vm:word :move-player-to ; yx --
|
||||||
|
:player-yx :dup :get :dup 0xffff := (vm:if [:drop] [:drawtile-at])
|
||||||
|
:set :draw-player)
|
||||||
|
|
||||||
|
(vm:word :transition-gord-sitting ; yx f --
|
||||||
|
controlstate.gord :controlstate :bset
|
||||||
|
:gord-sitting :set :move-player-to
|
||||||
|
controlstate.jaye :controlstate :bset)
|
||||||
|
|
||||||
|
(vm:word :move-rexx-trash ; yx -- f
|
||||||
|
(vm:if-and [[:dup debris :flag-at?] [:is-rexx?]]
|
||||||
|
[(itile :t-floor) :update-itile :snd-garbage] [: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)
|
||||||
|
(vm:word :handle-general-move ; yx -- f
|
||||||
|
(vm:if-or [[:dup :map-specific-move] [:dup :move-rexx-trash] [:dup :move-gord-sit] [:dup :move-gord-stand] [:dup :move-if-clear]]
|
||||||
|
[: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 --
|
||||||
|
:dup :set-player-dir ; dir
|
||||||
|
:player-yx :get :yx+ ; yxnew
|
||||||
|
(vm:if-or [[:dup :yxclip?] [:dup :touch-entity] [:dup :handle-general-move]]
|
||||||
|
[: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 (itile :jaye-n)]
|
||||||
|
[0x0100 (itile :jaye-s)]
|
||||||
|
[0x00ff (itile :jaye-w)]
|
||||||
|
[:else (itile :jaye-e)]))
|
||||||
|
|
||||||
|
(vm:word :gord-tile ; ptile
|
||||||
|
:gord-sitting :get
|
||||||
|
(vm:if [(itile :gord-sit)]
|
||||||
|
[:gord-dir :get
|
||||||
|
(vm:case [0xff00 (itile :gord-n)]
|
||||||
|
[0x0100 (itile :gord-s)]
|
||||||
|
[0x00ff (itile :gord-w)]
|
||||||
|
[:else (itile :gord-e)])]))
|
||||||
|
|
||||||
|
(vm:var :chuck-mode vm.false)
|
||||||
|
(vm:word :two-frame :tick-count :get 0x1f :& 0x10 :<)
|
||||||
|
(vm:word :neut-tile :two-frame :chuck-mode :get (vm:if
|
||||||
|
[(vm:if [(itile :t-chuck)] [(itile :t-chuck2)])]
|
||||||
|
[(vm:if [(itile :neut1)] [(itile :neut2)])]))
|
||||||
|
(vm:word :libb-tile :two-frame (vm:if [(itile :libb1)] [(itile :libb2)]))
|
||||||
|
|
||||||
|
(vm:word :flag-at? ; yx flag -- f
|
||||||
|
:swap :itile-at :lookup-flags :&)
|
||||||
|
|
||||||
|
(vm:word :toggle-player
|
||||||
|
(vm:ifchain [:is-prog?] [controlstate.jaye]
|
||||||
|
[:rexx-active?] [controlstate.rexx]
|
||||||
|
[:neut-hidden?] [controlstate.jaye]
|
||||||
|
[controlstate.neut]) :controlstate :bset
|
||||||
|
:is-prog? (vm:if [:set-prog-tileset] [:set-human-tileset]) :full-redraw)
|
||||||
|
|
||||||
|
(vm:word :party-follow
|
||||||
|
(vm:if-and [[:is-jaye?] [:gord-following?]]
|
||||||
|
[controlstate.gord :controlstate :bset
|
||||||
|
:gord-yx :get :gord-dir :get :yx+ :move-player-to
|
||||||
|
:jaye-dir :get :gord-dir :set
|
||||||
|
controlstate.jaye :controlstate :bset]))
|
||||||
|
|
||||||
|
(vm:word :player-key ; key --
|
||||||
|
(vm:ifchain
|
||||||
|
[:dup (string.byte " ") :=] [:drop :toggle-player]
|
||||||
|
[:dup (string.byte "Z") :=] [:drop :trigger-sidekick]
|
||||||
|
[:dup 2 :=] [:drop :boss-key]
|
||||||
|
[:movement-dir :dup]
|
||||||
|
[:player-yx :get :swap ; oldyx dir
|
||||||
|
:try-move-player
|
||||||
|
:dup :player-yx :get := (vm:if [:drop] [:party-follow :untouch-entity :load-next-level])]
|
||||||
|
[:drop]))
|
||||||
|
|
||||||
|
(vm:word :full-redraw :drawmap :player-redraw)
|
||||||
|
(vm:word :player-overlaps ; -- f
|
||||||
|
vm.false :controlstate :bget :player-yx :get
|
||||||
|
:over (vm:for (vm:i) :controlstate :bset :dup :player-yx :get := (vm:when :<rot :drop vm.true :>rot))
|
||||||
|
:drop :controlstate :bset)
|
||||||
|
|
||||||
|
(vm:word :player-redraw
|
||||||
|
:controlstate :bget
|
||||||
|
controlstate.count (vm:for (vm:i) :controlstate :bset :player-overlaps :not (vm:when :draw-player))
|
||||||
|
:controlstate :bset)
|
||||||
1
neuttower/portraits.json
Normal file
1
neuttower/portraits.json
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
[{"gfx":"8080808080E0E0F0F8FC2CBCACACACAC80809CFEFFFFFFD7D5D5555D4F5DD5D5BCB8B8B8F8F8F8F8FCFCFEFE86D0D0D495D5D5E5D5D5D5D7C797D7D0AAAAAAAA808086BFFFFFFFFAEAAA2A2E3C2EAAAA80808080808183878787058F8D8D8D8FAAAAAAA7AAAAEAEAE2E8EA8AD5D5D5D58F8F8787878F8F8F9F9FBFBE808A8AAA","label":"pjaye","flags":[]},{"gfx":"00002020000000004808080800202028004040011404450144010805445420352020000808084800000000202000000020544405080144014504140140400000000202012921220122011021222A052D00000405000001011211101100040415052A222110012201222129010202000004040011101112010100000504000000","label":"pneut","flags":[]},{"gfx":"80C090808484848484848484A8A8A8A8AA8080808080D4D4D5D5F59DFDD5D5D5A8A08080808080808080808080E0F8FC95D5D5D5F595D5D4D084D4D4D4D7FFFFD58080808080AAAAAAAABAE2FAAAAAA280828880A0A0A0A1A1A1A1A195959595A0AAAAAAAFA8AAAA8AA0AAAAAAEAFFFF95858181818181808080808080879FBF","label":"pgord","flags":[]},{"gfx":"808080808080C0C0C0C0C0C0C0C0C0C0808080808080AAAAFAFAFAAAAAAAAAAA8080808080C0D0D0D0D0D0D0D0D0D0D0A0A0A0A0A0AAAAAAA8A8A8A8A8A8A8A8808080808080D5D5DFDFDFD5D5D5D5D5808080808080828282828282828282828585858585D5D5D595959595959595958080808080828A8A8A8A8A8A8A8A8A8A","label":"prexx","flags":[]},{"gfx":"808080F8F8F8F8F8F8B8B8F8F8B8B8F8808080FFFFFFFFDFDFFDFDDFDFFDFDDFF8B8B8F8F8B8B8F8F8F8F8F8F8D0D080DFFDFDDFDFFDFDDFDFFFFFFFFFAAAA80808080FFFFFFFFFEFEAFAFFEFEAFAFFE8080808FAFAFAFAFAFAFAFAFAFAFAFAFFEAFAFFEFEAFAFFEFEFFFFFFFFD5D580AFAFAFAFAFAFAFAFAFAFAFAFAFAAAA80","label":"ppady","flags":[]},{"gfx":"0080C07070303030303030303030303000AAAA7F0045001400150051005400003030707000703018187C4C7E000000000000007F007F0000007F017F0000000000D5D57F400A0028000A002000080000008A8A8B8B8B8B8B8B8B8B8B8B8B8B8B0000407F007F6030301F187F000000008B8B8B03000F0C060603030100000000","label":"pterm","flags":[]},{"gfx":"80808080808080A0C0A0C0A0808088AA8080808080808185AA858285C1D0A0D0D4AA94AA94AA888080A0C0A0C0A08080AAD2A2D2A2D2A2D2C185AA858285818080A0A8D0A8A09090D581A1C1A0C2A1C280808180818080808081858285828582A1828182959291929090D5808080808085818080808084958A958A958A958480","label":"plibb","flags":[]},{"gfx":"808080808080808088A082A8A0AAA8AA849494D4D4D4D0D5D4D1D5D58595D5D5AAAA8AAA8AAA82AA828A808280808080D4D5D4D5D4D5D4D4D4D4D0C0C0C080808080808080A288A2A08AA2AAAAAAAAAA84949495958585808181848184848581AAAAAA8AAA8AAA8AAAAAA8A2A2AAAA8080818181818181818585818185818080","label":"pchuck","flags":[]}]
|
||||||
84
neuttower/tiles.fnl
Normal file
84
neuttower/tiles.fnl
Normal file
|
|
@ -0,0 +1,84 @@
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local lume (require :lib.lume))
|
||||||
|
|
||||||
|
(local flags [:walkable :neutable :debris :sittable])
|
||||||
|
(local flag-to-bit {})
|
||||||
|
(each [iflag flag (ipairs flags)]
|
||||||
|
(tset flag-to-bit flag (bit.lshift 1 (- iflag 1))))
|
||||||
|
|
||||||
|
(local encoded-tile-fields [:gfx :neut :mask])
|
||||||
|
(fn convert [tile field method]
|
||||||
|
(local oldval (. tile field))
|
||||||
|
(when oldval
|
||||||
|
(tset tile field (: oldval method)))
|
||||||
|
tile)
|
||||||
|
(fn convert-all [tile method]
|
||||||
|
(each [_ field (ipairs encoded-tile-fields)]
|
||||||
|
(convert tile field method))
|
||||||
|
tile)
|
||||||
|
|
||||||
|
(fn deserialize [tile]
|
||||||
|
(match (type tile)
|
||||||
|
:string {:gfx (tile:fromhex) :flags {}}
|
||||||
|
:table (convert-all tile :fromhex)))
|
||||||
|
|
||||||
|
(fn serialize [tile] (convert-all (lume.clone tile) :tohex))
|
||||||
|
|
||||||
|
(local fn-tiles "game/tiles.json")
|
||||||
|
(local fn-portraits "game/portraits.json")
|
||||||
|
(local fn-font "game/font.json")
|
||||||
|
|
||||||
|
(fn loadgfx [filename] (lume.map (util.readjson filename) deserialize))
|
||||||
|
(fn savegfx [filename gfx] (util.writejson filename (lume.map gfx serialize)))
|
||||||
|
|
||||||
|
(fn appendgfx [org gfx ?key ?ignore-labels]
|
||||||
|
(each [_ g (ipairs gfx)]
|
||||||
|
(when (and g.label (not ?ignore-labels)) (org:append g.label))
|
||||||
|
(org:append [:bytes (. g (or ?key :gfx))])))
|
||||||
|
|
||||||
|
(fn appendtiles [org]
|
||||||
|
(local tiles (loadgfx fn-tiles))
|
||||||
|
(org:append [:align 0x100] :jaye-tileset)
|
||||||
|
(appendgfx org tiles)
|
||||||
|
(org:append [:align 0x100] :neut-tileset)
|
||||||
|
(appendgfx org tiles :neut true)
|
||||||
|
(appendgfx org (loadgfx fn-portraits))
|
||||||
|
(org:append :tileflags)
|
||||||
|
(each [_ tile (ipairs tiles)]
|
||||||
|
(var flags 0)
|
||||||
|
(each [flag _ (pairs tile.flags)]
|
||||||
|
(set flags (bit.bor flags (. flag-to-bit flag))))
|
||||||
|
(org:append [:db flags])))
|
||||||
|
|
||||||
|
(fn append-portraitwords [vm ?overrides]
|
||||||
|
(local overrides (or ?overrides {}))
|
||||||
|
(each [_ p (ipairs (loadgfx fn-portraits))]
|
||||||
|
(let [wordname (.. :draw- p.label)
|
||||||
|
override (. overrides p.label)]
|
||||||
|
(vm:word (.. :draw- p.label) :show-footer
|
||||||
|
(if override (override p.label) [:vm :lit p.label])
|
||||||
|
:draw-portrait))))
|
||||||
|
|
||||||
|
(fn encode-yx [xy]
|
||||||
|
(if xy (bit.bor (bit.lshift (- xy.y 1) 8) (- xy.x 1)) 0xffff))
|
||||||
|
|
||||||
|
(fn encode-itile [itile]
|
||||||
|
(bit.bor
|
||||||
|
(bit.lshift (bit.band (- itile 1) 0x07) 5)
|
||||||
|
(bit.rshift (bit.band (- itile 1) 0xf8) 3)))
|
||||||
|
|
||||||
|
(fn decode-itile [enctile]
|
||||||
|
(+ 1 (bit.bor
|
||||||
|
(bit.lshift (bit.band enctile 0x1f) 3)
|
||||||
|
(bit.rshift (bit.band enctile 0xe0) 5))))
|
||||||
|
|
||||||
|
(fn find-itile [tiles label ?itilenext]
|
||||||
|
(local itile (or ?itilenext 1))
|
||||||
|
(local tile (. tiles itile))
|
||||||
|
(assert (not= tile nil) (.. "No such tile " label))
|
||||||
|
(if (= tile.label label) (encode-itile itile)
|
||||||
|
(find-itile tiles label (+ itile 1))))
|
||||||
|
|
||||||
|
{: loadgfx : savegfx : appendtiles : appendgfx : append-portraitwords : flags : flag-to-bit : find-itile
|
||||||
|
: fn-tiles : fn-portraits : fn-font : encode-yx : encode-itile : decode-itile}
|
||||||
|
|
||||||
1
neuttower/tiles.json
Normal file
1
neuttower/tiles.json
Normal file
File diff suppressed because one or more lines are too long
1
neuttower/title.screen
Normal file
1
neuttower/title.screen
Normal file
File diff suppressed because one or more lines are too long
Loading…
Reference in a new issue