honeylisp/game/boop.fnl

74 lines
1.7 KiB
Fennel

(local {: vm} (require :game.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-teleport (notes [:e4 :d#4 :d4 :g#4] 0x1a 0x50))
{: note : notes}