win/loss screens and music

modules/music.scm

@@ -0,0 +1,77 @@
+(module (bd music) *
+(import scheme
+	(chicken base)
+	(chicken module)
+	(chicken foreign)
+	raylib
+	(imugi core)
+	foreigners
+	(srfi 69)
+	(srfi 99))
+
+(foreign-declare "#include <raylib.h>")
+
+(define-foreign-record-type (Music "struct Music")
+  (constructor: make-music)
+  (destructor: free-music))
+
+(define load-music-stream
+  (foreign-lambda* Music ((c-string filepath))
+    "
+Music * music = malloc(sizeof(Music));
+*music = LoadMusicStream(filepath);
+C_return(music);"))
+
+(define unload-music-stream
+  (foreign-lambda* void ((Music music))
+    "
+UnloadMusicStream(*music);
+"))
+
+(define play-music-stream
+  (foreign-lambda* void ((Music music))
+    "
+PlayMusicStream(*music);
+"))
+
+(define update-music-stream
+  (foreign-lambda* void ((Music music))
+    "
+UpdateMusicStream(*music);
+"))
+
+(define stop-music-stream
+  (foreign-lambda* void ((Music music))
+    "
+StopMusicStream(*music);
+"))
+
+(define set-music-volume
+  (foreign-lambda* void ((Music music) (float volume))
+    "
+SetMusicVolume(*music, volume);
+"))
+
+(define current-music #f)
+(define current-music-path "")
+
+(define-record-type <music-player>
+  (music-player path)
+  music-player?
+  (path music-player-path))
+
+(define handle-music-players
+  (make-system
+   'handle-music-players
+   0
+   'entity
+   '(<music-player>)
+   (lambda (_ player)
+     (if (not (equal? current-music-path (music-player-path player)))
+	 (begin (when current-music
+		  (unload-music-stream current-music))
+		(set! current-music (load-music-stream (music-player-path player)))
+		(set! current-music-path (music-player-path player))
+		(play-music-stream current-music))
+	 (update-music-stream current-music)))))
+)

src/arena.scm

@@ -11,6 +11,9 @@
 	(bd random)
 	(bd attack)
 	(bd grid)
+	(bd music)
+	(win-screen)
+	(lose-screen)
 	(srfi 1)
 	(srfi 99))
 
@@ -34,29 +37,10 @@
   (stance unit-stance set-unit-stance!))
 
 (define player-unit
-  (unit
+  '())
-    player
-    3
-    ;; Place player
-    (vec (rand-int grid-size)
-	 (rand-int grid-size))
-    (hand-direction 'mid 'right)
-    'mid))
 
 (define enemy-unit
-  (unit
+  '())
-    enemy
-    3
-    ;; Place enemy
-    (let loop ()
-      (let ((p-x (rand-int grid-size))
-	    (p-y (rand-int grid-size)))
-	(if (not (v= (vec p-x p-y)
-		     (unit-pos player-unit)))
-	    (vec p-x p-y)
-	    (loop))))
-    (hand-direction 'mid 'left)
-    'mid))
 
 (define-record-type <order>
   (order movement attack stance)
@@ -112,6 +96,14 @@
 	(else (rotate-pos (unit-hand-pos enemy-unit))))))
     o))
 
+(define (win)
+  (display "Win!")
+  (newline))
+
+(define (lose)
+  (display "Lose!")
+  (newline))
+
 (define (attempt-attack attack-dir unit)
   (display (unit-type unit))
   (newline)
@@ -125,7 +117,10 @@
 	  (display (conc (unit-type unit) " hits!"))
 	  (set-unit-health! target (- (unit-health target) 1))
 	  (when (= 0 (unit-health target))
-	    (set! battle-state 'ended)))
+	    (set! battle-state 'ended)
+	    (if (eqv? player (unit-type target))
+		(lose)
+		(win))))
 	(display (conc (unit-type unit) " misses!")))
     (newline)
     (set-unit-hand-pos! unit (opposite-pos attack-dir))))
@@ -163,7 +158,38 @@
 			  (else empty))))))))))
 
 (export arena)
-(define (arena)
+(define (arena menu-scene)
+  ;; Reset state
+  (set! battle-state 'active)
+  (set! player-unit
+    (unit
+      player
+      3
+      ;; Place player
+      (vec (rand-int grid-size)
+	   (rand-int grid-size))
+      (hand-direction 'mid 'right)
+      'mid))
+  (set! enemy-unit
+    (unit
+      enemy
+      3
+      ;; Place enemy
+      (let loop ()
+	(let ((p-x (rand-int grid-size))
+	      (p-y (rand-int grid-size)))
+	  (if (not (v= (vec p-x p-y)
+		       (unit-pos player-unit)))
+	      (vec p-x p-y)
+	      (loop))))
+      (hand-direction 'mid 'left)
+      'mid))
+  
+  (set! win (lambda ()
+	      ((win-screen arena menu-scene))))
+  (set! lose (lambda ()
+	       ((lose-screen arena menu-scene))))
+  
   (scene
    push-actions
    process-dynamic-labels
@@ -171,6 +197,11 @@
    draw-labels
    draw-grid
    handle-buttons
+   handle-music-players
+   
+   (entity
+    (music-player
+     "../res/music/Fight.wav"))
    
    ;; Level heading
    (entity

src/bitter-duel.scm

@@ -9,9 +9,11 @@
 
 (register-action 'click 'mouse-press MOUSE_BUTTON_LEFT)
 
+(init-audio-device)
+
 ((main-menu (lambda ()
 	      (display "Loading game scene...")
 	      (newline)
-	      ((arena)))))
+	      ((arena main-menu)))))
 
 (create-window))

src/lose-screen.scm

@@ -0,0 +1,66 @@
+(module (lose-screen) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	raylib
+	(imugi core)
+	(imugi input)
+	(imugi scene)
+	(imugi math)
+	(bd ui))
+
+(export lose-screen)
+(define (lose-screen arena-scene menu-scene)
+  (play-sound (load-sound "../res/music/Lose.wav"))
+  (scene
+
+   push-actions
+   draw-labels
+   handle-buttons
+
+   (entity
+    (title
+     (vec
+      0
+      (/ (cdr (*window-size*))
+	 6))
+     "You have lost!"
+     centered: (cons #t #f)))
+
+   (entity
+    (button
+     ;; Roughly centered.
+     ;; these are ugly, hardcoded values.
+     (vec (- (/ (car (*window-size*))
+		2)
+	     50)
+	  (- (/ (car (*window-size*))
+		2)
+	     100))
+     ;; Nested footer text
+     (footer
+      (vec 0 0) ;; this vec doesn't matter, it's overwritten internally
+      "Play Again?")
+     (lambda ()
+       ((arena-scene menu-scene)))))
+
+   (entity
+    (button
+     ;; Roughly centered.
+     ;; these are ugly, hardcoded values.
+     (vec (- (/ (car (*window-size*))
+		2)
+	     50)
+	  (- (/ (car (*window-size*))
+		2)
+	     170))
+     ;; Nested footer text
+     (footer
+      (vec 0 0) ;; this vec doesn't matter, it's overwritten internally
+      "Back to Menu")
+     (lambda ()
+       ((menu-scene
+	 (lambda ()
+	   ((arena-scene menu-scene))))))))))
+)
+

src/main-menu.scm

@@ -6,7 +6,8 @@
 	(imugi input)
 	(imugi scene)
 	(imugi math)
-	(bd ui))
+	(bd ui)
+	(bd music))
 
 (export main-menu)
 (define (main-menu play-callback)
@@ -14,6 +15,11 @@
    push-actions
    draw-labels
    handle-buttons
+   handle-music-players
+
+   (entity
+    (music-player
+     "../res/music/Main Menu.wav"))
    
 ;;; Text
    ;; Title

src/win-screen.scm

@@ -0,0 +1,66 @@
+(module (win-screen) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	raylib
+	(imugi core)
+	(imugi input)
+	(imugi scene)
+	(imugi math)
+	(bd ui))
+
+(export win-screen)
+(define (win-screen arena-scene menu-scene)
+  (play-sound (load-sound "../res/music/Win.wav"))
+  (scene
+
+   push-actions
+   draw-labels
+   handle-buttons
+   
+   (entity
+    (title
+     (vec
+      0
+      (/ (cdr (*window-size*))
+	 6))
+     "You have won!"
+     centered: (cons #t #f)))
+
+   (entity
+    (button
+     ;; Roughly centered.
+     ;; these are ugly, hardcoded values.
+     (vec (- (/ (car (*window-size*))
+		2)
+	     50)
+	  (- (/ (car (*window-size*))
+		2)
+	     100))
+     ;; Nested footer text
+     (footer
+      (vec 0 0) ;; this vec doesn't matter, it's overwritten internally
+      "Play Again?")
+     (lambda ()
+       ((arena-scene menu-scene)))))
+
+   (entity
+    (button
+     ;; Roughly centered.
+     ;; these are ugly, hardcoded values.
+     (vec (- (/ (car (*window-size*))
+		2)
+	     50)
+	  (- (/ (car (*window-size*))
+		2)
+	     170))
+     ;; Nested footer text
+     (footer
+      (vec 0 0) ;; this vec doesn't matter, it's overwritten internally
+      "Back to Menu")
+     (lambda ()
+       ((menu-scene
+	 (lambda ()
+	   ((arena-scene menu-scene))))))))))
+)
+