Renamed waveform -> sound and make-tune -> music. Started on shooter …

…example.

audio.rkt

@@ -40,14 +40,19 @@ All rights reserved.
 
          ; find the first, stopped voice available
          [avail-channels (dropf channels in-use)])
-    (unless (null? avail-channels)
-      (thunk (first avail-channels)))))
+    (if (null? avail-channels)
+        #f
+        (let ([chan (first avail-channels)])
+          (thunk chan)
+
+          ; return the channel for stop, pause, etc.
+          chan))))
 
 ;; ----------------------------------------------------
 
 (define (play-sound sound #:volume [volume 100.0] #:pitch [pitch 1.0] #:loop [loop #f])
   (with-channel (λ (channel)
-                  (sfSound_setBuffer channel (sound-buffer sound))
+                  (sfSound_setBuffer channel (waveform-buffer sound))
 
                   ; channel settings
                   (sfSound_setVolume channel volume)
@@ -60,15 +65,20 @@ All rights reserved.
 ;; ----------------------------------------------------
 
 (define (stop-sound channel)
-  (void))
+  (sfSound_stop channel))
+
+;; ----------------------------------------------------
+
+(define sound? waveform?)
+(define music? tune?)
 
 ;; ----------------------------------------------------
 
-(define make-tune transcribe-notes)
+(define music transcribe-notes)
 
 ;; ----------------------------------------------------
 
-(define music
+(define music-channel
   (let ([pointer (u8vector->cpointer riff-header)]
         [length (u8vector-length riff-header)])
     (sfMusic_createFromMemory pointer length)))
@@ -79,20 +89,20 @@ All rights reserved.
   (stop-music)
 
   ; set the new, active music tune
-  (set! music (tune-music tune))
+  (set! music-channel (tune-music tune))
 
   ; start playing the new music
-  (sfMusic_setVolume music volume)
-  (sfMusic_setPitch music pitch)
-  (sfMusic_setLoop music loop)
-  (sfMusic_play music))
+  (sfMusic_setVolume music-channel volume)
+  (sfMusic_setPitch music-channel pitch)
+  (sfMusic_setLoop music-channel loop)
+  (sfMusic_play music-channel))
 
 ;; ----------------------------------------------------
 
 (define (pause-music [pause #t])
-  ((if pause sfMusic_pause sfMusic_play) music))
+  ((if pause sfMusic_pause sfMusic_play) music-channel))
 
 ;; ----------------------------------------------------
 
 (define (stop-music)
-  (sfMusic_stop music))
+  (sfMusic_stop music-channel))

draw.rkt

@@ -106,7 +106,7 @@ All rights reserved.
 
 ;; ----------------------------------------------------
 
-(define (text x y s)
+(define (text x y s #:bg [bg #f])
   (for ([i (range x (width) 4)] [ch (~a s)])
     (let ([n (char->integer ch)])
       (when (<= 33 n 127)

examples/shooter.rkt

@@ -0,0 +1,171 @@
+#lang racket
+
+(require r-cade)
+
+;; ----------------------------------------------------
+
+(struct game-obj [(x #:mutable) (y #:mutable) sprite])
+(struct ship game-obj [color])
+(struct bullet game-obj [dx dy])
+(struct star game-obj [dx])
+(struct boom game-obj [anim])
+
+;; ----------------------------------------------------
+
+(define player (ship 0 0 '(#x60 #x76 #xfc #x7c #xfc #x76 #x60) 2))
+
+;; ----------------------------------------------------
+
+(define player-speed 1)
+
+;; ----------------------------------------------------
+
+(define shoot-sound (sweep 800 600 0.05 #:instrument square-wave #:envelope z-envelope))
+(define boom-sound (tone 100 1.0 #:instrument sawtooth-wave #:envelope fade-out-envelope))
+
+;; ----------------------------------------------------
+
+(define ships null)
+(define bullets null)
+(define stars null)
+(define booms null)
+
+;; ----------------------------------------------------
+
+(define-action move-up btn-up)
+(define-action move-down btn-down)
+(define-action move-right btn-right)
+(define-action move-left btn-left)
+
+;; ----------------------------------------------------
+
+(define-action fire btn-z 6)
+
+;; ----------------------------------------------------
+
+(define (spawn-bullet b)
+  (set! bullets (cons b bullets)))
+
+;; ----------------------------------------------------
+
+(define (spawn-stars [n 30])
+  (set! stars (for/list ([i (range n)])
+                (star (random 256) (random 128) '(#x80) (random)))))
+
+;; ----------------------------------------------------
+
+(define (draw-game-obj obj)
+  (draw (game-obj-x obj) (game-obj-y obj) (game-obj-sprite obj)))
+
+;; ----------------------------------------------------
+
+(define (draw-ship ship)
+  (color (ship-color ship))
+  (draw-game-obj ship))
+
+;; ----------------------------------------------------
+
+(define (draw-player)
+  (draw-ship player))
+
+;; ----------------------------------------------------
+
+(define (draw-bullets)
+  (color 10)
+  (for ([b bullets])
+    (draw-game-obj b)))
+
+;; ----------------------------------------------------
+
+(define (draw-stars)
+  (color 6)
+  (for ([star stars])
+    (draw-game-obj star)))
+
+;; ----------------------------------------------------
+
+(define (advance-bullets)
+  (set! bullets (for/list ([b bullets] #:when (and (< -8 (game-obj-x b) (width))
+                                                   (< -1 (game-obj-y b) (height))))
+                  (set-game-obj-x! b (+ (game-obj-x b) (bullet-dx b)))
+                  (set-game-obj-y! b (+ (game-obj-y b) (bullet-dy b)))
+
+                  ; keep bullets on screen
+                  b)))
+
+;; ----------------------------------------------------
+
+(define (scroll-stars)
+  (for ([star stars])
+    (let ([nx (- (game-obj-x star) (star-dx star))])
+      (when (< nx -1)
+        (set! nx (+ (width) (random (width))))
+        (set-game-obj-y! star (random (height))))
+      (set-game-obj-x! star nx))))
+
+;; ----------------------------------------------------
+
+(define (shoot-bullet from-ship dx dy)
+  (let ([x (game-obj-x from-ship)]
+        [y (game-obj-y from-ship)])
+    (spawn-bullet (if (> dx 0)  ; player bullets move to the right
+                      (bullet (+ x 5) (+ y 1) '(#xe0 #x00 #x00 #x00 #xe0) dx dy)
+                      (bullet (- x 1) (+ y 3) '(#xf0) dx dy)))))
+
+;; ----------------------------------------------------
+
+(define (setup)
+  (spawn-stars)
+
+  ; clear object lists
+  (set! bullets null)
+  (set! booms null)
+
+  ; reset the player
+  (set-game-obj-x! player 16)
+  (set-game-obj-y! player 62))
+
+;; ----------------------------------------------------
+
+(define (new-game)
+  (setup)
+
+  ; main game loop
+  (λ ()
+    (cls)
+
+    ; move bullets, collide with ships
+    (advance-bullets)
+    (scroll-stars)
+
+    ; draw the player, enemies, and all bullets
+    (draw-stars)
+    (draw-player)
+    (draw-bullets)
+
+    ; move the player around
+    (when (move-up)
+      (set-game-obj-y! player (- (game-obj-y player) player-speed)))
+    (when (move-down)
+      (set-game-obj-y! player (+ (game-obj-y player) player-speed)))
+    (when (move-right)
+      (set-game-obj-x! player (+ (game-obj-x player) player-speed)))
+    (when (move-left)
+      (set-game-obj-x! player (- (game-obj-x player) player-speed)))
+
+    ; clamp player motion
+    (set-game-obj-x! player (max (game-obj-x player) 0))
+
+    ; let the player shoot
+    (when (fire)
+      (play-sound shoot-sound)
+      (shoot-bullet player 3 0))
+
+    ; check for game quit
+    (when (btn-quit)
+      (quit))))
+
+;; ----------------------------------------------------
+
+(define (play)
+  (run (new-game) 256 128 #:scale 3 #:title "Shooter"))

examples/tetris.rkt

@@ -275,11 +275,11 @@
 
 ;; ----------------------------------------------------
 
-(define song (make-tune ".--E4-B3C4D-CB3A-AC4E-DCB3-C4D-E-C-A3-A-.D4-FA-GFE-CE-DCB3-BC4D-E-C-A3-A-.E4---C---D---B3---C4---A3---Ab---B-E4---C---D---B3--C4--E-A4--Ab---.E4-B3C4D-CB3A-AC4E-DCB3-C4D-E-C-A3-A-.D4-FA-GFE-CE-DCB3-BC4D-E-C-A3-A-"
-                        #:bpm 280
-                        #:instrument triangle-wave))
+(define theme (music ".--E4-B3C4D-CB3A-AC4E-DCB3-C4D-E-C-A3-A-.D4-FA-GFE-CE-DCB3-BC4D-E-C-A3-A-.E4---C---D---B3---C4---A3---Ab---B-E4---C---D---B3--C4--E-A4--Ab---.E4-B3C4D-CB3A-AC4E-DCB3-C4D-E-C-A3-A-.D4-FA-GFE-CE-DCB3-BC4D-E-C-A3-A-"
+                     #:bpm 280
+                     #:instrument triangle-wave))
 
 (define (play)
   (spawn-tetrinome)
-  (play-music song)
+  (play-music theme)
   (run tetris 48 52 #:scale 6 #:fps 30 #:title "R-cade: Tetris"))