# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1479760194 0
# Node ID ad512d2a802fd728ec141e0cca7e4dc4edeb30e4
# Parent  553c97ea41b7286b1be74db3f98a2e9786a7788a
Add some overengineered-to-hell sound

diff -r 553c97ea41b7 -r ad512d2a802f cl-chip8.asd
--- a/cl-chip8.asd	Mon Nov 21 17:57:45 2016 +0000
+++ b/cl-chip8.asd	Mon Nov 21 20:29:54 2016 +0000
@@ -11,6 +11,7 @@
                :losh
                :cl-arrows
                :bordeaux-threads
+               :cl-portaudio
                :qtools
                :qtcore
                :qtgui
diff -r 553c97ea41b7 -r ad512d2a802f src/debugger.lisp
--- a/src/debugger.lisp	Mon Nov 21 17:57:45 2016 +0000
+++ b/src/debugger.lisp	Mon Nov 21 20:29:54 2016 +0000
@@ -149,14 +149,18 @@
   (cond
     ((<= row 15) (format nil "V~X" row))
     ((= row 16) "I")
-    ((= row 17) "PC")))
+    ((= row 17) "PC")
+    ((= row 18) "DT")
+    ((= row 19) "ST")))
 
 (defun registers-value (chip row)
   (cond
     ((<= row 15) (format nil "~2,'0X"
                          (aref (chip8::chip-registers chip) row)))
     ((= row 16) (format nil "~4,'0X" (chip8::chip-index chip)))
-    ((= row 17) (format nil "~3,'0X" (chip8::chip-program-counter chip)))))
+    ((= row 17) (format nil "~3,'0X" (chip8::chip-program-counter chip)))
+    ((= row 18) (format nil "~2,'0X" (chip8::chip-delay-timer chip)))
+    ((= row 19) (format nil "~2,'0X" (chip8::chip-sound-timer chip)))))
 
 
 ;;;; Model
@@ -170,12 +174,12 @@
 
 (define-override (registers-model row-count) (index)
   (declare (ignore index))
-  18)
+  20)
 
 
 (defun registers-index-valid-p (index)
   (and (q+:is-valid index)
-       (< (q+:row index) 18)))
+       (< (q+:row index) 20)))
 
 (define-override (registers-model data) (index role)
   (let ((row (q+:row index))
diff -r 553c97ea41b7 -r ad512d2a802f src/emulator.lisp
--- a/src/emulator.lisp	Mon Nov 21 17:57:45 2016 +0000
+++ b/src/emulator.lisp	Mon Nov 21 20:29:54 2016 +0000
@@ -286,7 +286,7 @@
     (if (not paused) ; if we're not paused, we never need to wait
       nil
       (if take-step
-        (progn (setf take-step nil ; if we're paused, but are ready to step, go 
+        (progn (setf take-step nil ; if we're paused, but are ready to step, go
                      print-needed t)
                nil)
         t)))) ; otherwise we're fully paused -- wait
@@ -533,6 +533,82 @@
   (draw-sprite chip (register rx) (register ry) size))
 
 
+;;;; Sound --------------------------------------------------------------------
+(defconstant +pi+ (float pi 1.0))
+(defconstant +tau+ (* 2 +pi+))
+(defconstant +sample-rate+ 44100d0)
+(defconstant +audio-buffer-size+ 1024)
+(defconstant +audio-buffer-time+ (* +audio-buffer-size+ (/ +sample-rate+)))
+
+(deftype angle ()
+  `(single-float 0.0 ,+tau+))
+
+(deftype audio-buffer ()
+  `(simple-array single-float (,+audio-buffer-size+)))
+
+
+(declaim
+  (ftype (function (angle) (single-float -1.0 1.0))
+         square sine)
+  (ftype (function (audio-buffer function angle angle) angle)
+         fill-buffer)
+  (inline square sine fill-buffer))
+
+
+(defun make-audio-buffer ()
+  (make-simple-array 'single-float +audio-buffer-size+ :initial-element 0.0))
+
+
+(defun square (angle)
+  (declare (optimize (debug 0) (safety 0) (speed 3)))
+  (if (< angle +pi+)
+    1.0
+    -1.0))
+
+(defun sine (angle)
+  (declare (optimize (debug 0) (safety 0) (speed 3)))
+  (sin angle))
+
+
+(defun fill-buffer (buffer function rate start)
+  ; (declare (optimize (debug 0) (safety 0) (speed 3)))
+  (iterate
+    (declare (iterate::declare-variables))
+    (for (the fixnum i) :index-of-vector buffer)
+    (for (the angle angle) :first start :then (mod (+ angle rate) +tau+))
+    (setf (aref buffer i) (funcall function angle))
+    (finally (return angle))))
+
+(defun fill-square (buffer rate start)
+  (fill-buffer buffer #'square rate start))
+
+(defun fill-sine (buffer rate start)
+  (fill-buffer buffer #'sine rate start))
+
+
+(defun audio-rate (frequency)
+  (float (* (/ +tau+ +sample-rate+) frequency) 1.0))
+
+(defun run-sound (chip)
+  (portaudio:with-audio
+    (portaudio:with-default-audio-stream
+        (audio-stream 0 1
+                      :sample-format :float
+                      :sample-rate +sample-rate+
+                      :frames-per-buffer +audio-buffer-size+)
+      (with-chip (chip)
+        (iterate (with buffer = (make-audio-buffer))
+                 (with angle = 0.0)
+                 (with rate = (audio-rate 440))
+                 (while running)
+                 (if (and (plusp sound-timer)
+                          (not (debugger-paused-p debugger)))
+                   (progn
+                     (setf angle (fill-square buffer rate angle))
+                     (portaudio:write-stream audio-stream buffer))
+                   (sleep +audio-buffer-time+)))))))
+
+
 ;;;; Timers -------------------------------------------------------------------
 (declaim
   (ftype (function (chip) null) decrement-timers run-timers))
@@ -655,6 +731,7 @@
     (load-rom chip rom-filename)
     (bt:make-thread (curry #'run-cpu chip))
     (bt:make-thread (curry #'run-timers chip))
+    (bt:make-thread (curry #'run-sound chip))
     (chip8.gui::run-gui chip)))