SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Re-import Neu] [ower to coexist with 8-bitsy, probably broke both

Browse source
This commit is contained in:
Jeremy Penner 2021-06-21 22:40:46 -04:00
parent 35808f061b
commit 16a6830b20
39 changed files with 1720 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
game/boop.fnl → bitsy/boop.fnl
View file

@ -1,4 +1,4 @@
(local {: vm} (require :game.defs))
(local {: vm} (require :bitsy.defs))
(local speaker :0xc030)
(vm:def :blipmem ; count p --

2
game/defs.fnl → bitsy/defs.fnl
View file

@ -154,7 +154,7 @@
(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 (. files.game.levels ilevel))
(local entity (require :game.entity))
(local entity (require :bitsy.entity))
(append-map map org label)
(entity.append-from-map map org label)
(set level.vm.code org)

2
game/disk.fnl → bitsy/disk.fnl
View file

@ -3,7 +3,7 @@
(local Prodos (require :asm.prodos))
(local util (require :lib.util))
(local {: lo : hi} util)
(local {: org} (require :game.defs))
(local {: org} (require :bitsy.defs))
(fn append-boot-loader [prg]
(local vm prg.vm)

2
game/entity.fnl → bitsy/entity.fnl
View file

@ -1,6 +1,6 @@
(local util (require :lib.util))
(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)
; Entity memory layout:

2
game/footer.fnl → bitsy/footer.fnl
View file

@ -1,4 +1,4 @@
(local {: vm : org} (require :game.defs))
(local {: vm : org} (require :bitsy.defs))
(local {: hi : lo} (require :lib.util))
(vm:def :draw-pchar ; pscreen pchar --

2
game/gfx.fnl → bitsy/gfx.fnl
View file

@ -1,5 +1,5 @@
(local {: lo : hi} (require :lib.util))
(local {: vm : mapw : maph : org} (require :game.defs))
(local {: vm : mapw : maph : org} (require :bitsy.defs))
; Graphics routines
(vm:def :mixed [:sta :0xc053])

16
game/init.fnl → bitsy/init.fnl
View file

@ -1,17 +1,17 @@
(local util (require :lib.util))
(local {: lo : hi : readjson} util)
(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 disk (util.reload :game.disk))
(local disk (util.reload :bitsy.disk))
(util.reload :game.gfx)
(util.reload :game.footer)
(util.reload :game.map)
(util.reload :game.entity)
(util.reload :game.player)
(util.reload :game.boop)
(util.reload :bitsy.gfx)
(util.reload :bitsy.footer)
(util.reload :bitsy.map)
(util.reload :bitsy.entity)
(util.reload :bitsy.player)
(util.reload :bitsy.boop)
(tile.appendtiles org.code)
(org.code:append [:align 0x100] :font)

2
game/map.fnl → bitsy/map.fnl
View file

@ -1,5 +1,5 @@
(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
[:lda vm.TOP :x]

2
game/player.fnl → bitsy/player.fnl
View file

@ -1,5 +1,5 @@
(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)

2
editor/8bitsy.fnl
View file

@ -22,7 +22,7 @@
(util.nested-tset action [:lines 4] (line4:sub 1 33))
y))
(fn [action vm]
(local {: say} (require :game.defs))
(local {: say} (require :bitsy.defs))
(say action.character (table.unpack (lume.map action.lines #($1:upper))))))
(actions.register :warp

86
neuttower/boop.fnl Normal file
View 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
View 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
View 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
View 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
View 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
View file

File diff suppressed because one or more lines are too long

234
neuttower/entity.fnl Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View file

File diff suppressed because one or more lines are too long

1
neuttower/title.screen Normal file
View file

File diff suppressed because one or more lines are too long