Musical sound effects!

game/boop.fnl

@@ -1,7 +1,7 @@
 (local {: vm} (require :game.defs))
 
 (local speaker :0xc030)
-  (vm:def :blipmem ; count p --
+(vm:def :blipmem ; count p --
   [:block
     [:lda [vm.ST1 :x]]
     [:tay]
@@ -18,5 +18,58 @@
     [:bne :sample]]
     (vm:drop) (vm:drop))
 
-(vm:word :snd-explode 0x40 :lit :randombytes :blipmem)
+(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] 8))
+(vm:word :snd-doorclose (notes [:e1 :c1] 8))
+(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))
+
+{: note : notes}

game/entity.fnl

@@ -72,12 +72,23 @@
   :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 --
-  :<rot (vm:case
+  :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]
-    [ev.tog :dup :responder-itile := (vm:if [:drop :set-respondertile] [:set-respondertile :drop])]
     [: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 --
@@ -93,7 +104,8 @@
 (vm:word :door ; ev --
   :walking-through-door (vm:if
     [:move-to-responder :drop]
-    [(itile :doorclosed) (itile :dooropen) :handle-onoff]))
+    [(itile :doorclosed) (itile :dooropen) :handle-onoff
+     :lit :snd-dooropen :lit :snd-doorclose :on-handled]))
 
 (vm:word :exitlevel ; e --
   :link-arg :next-level :set)
@@ -126,7 +138,8 @@
                                           (say :neut "PLEASE CONTACT YOUR" "SYSTEM ADMINISTRATOR")
                                           (say :neut "THIS INCIDENT HAS" "BEEN REPORTED"))]))]
                 []))
-  (itile :termoff) (itile :termon) :handle-onoff)
+  (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