From c2cd4cdbfa8f5a83f00d3f2c0a2091161584177f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@vistahigherlearning.com>
Date: Sun, 18 Apr 2021 10:30:01 -0400
Subject: Implement basic game states with placeholder art.

---
 assets/fonts/monogram_extended.ttf | Bin 0 -> 34164 bytes
 assets/images/darkness.png         | Bin 0 -> 1933 bytes
 assets/images/dialog-box.png       | Bin 0 -> 620 bytes
 assets/images/dialog-box.xcf       | Bin 0 -> 867 bytes
 assets/images/room.png             | Bin 0 -> 2048 bytes
 assets/images/room.xcf             | Bin 0 -> 4849 bytes
 assets/images/scanner.png          | Bin 0 -> 600 bytes
 assets/images/scanner.xcf          | Bin 0 -> 694 bytes
 game.scm                           | 209 ++++++++++++++++++++++++++++++++-----
 pre-inst-env.in                    |  13 +++
 run-game                           |   2 +-
 11 files changed, 194 insertions(+), 30 deletions(-)
 create mode 100644 assets/fonts/monogram_extended.ttf
 create mode 100644 assets/images/darkness.png
 create mode 100644 assets/images/dialog-box.png
 create mode 100644 assets/images/dialog-box.xcf
 create mode 100644 assets/images/room.png
 create mode 100644 assets/images/room.xcf
 create mode 100644 assets/images/scanner.png
 create mode 100644 assets/images/scanner.xcf

diff --git a/assets/fonts/monogram_extended.ttf b/assets/fonts/monogram_extended.ttf
new file mode 100644
index 0000000..948c06a
Binary files /dev/null and b/assets/fonts/monogram_extended.ttf differ
diff --git a/assets/images/darkness.png b/assets/images/darkness.png
new file mode 100644
index 0000000..e9995fa
Binary files /dev/null and b/assets/images/darkness.png differ
diff --git a/assets/images/dialog-box.png b/assets/images/dialog-box.png
new file mode 100644
index 0000000..48adaf8
Binary files /dev/null and b/assets/images/dialog-box.png differ
diff --git a/assets/images/dialog-box.xcf b/assets/images/dialog-box.xcf
new file mode 100644
index 0000000..d5263c9
Binary files /dev/null and b/assets/images/dialog-box.xcf differ
diff --git a/assets/images/room.png b/assets/images/room.png
new file mode 100644
index 0000000..3864023
Binary files /dev/null and b/assets/images/room.png differ
diff --git a/assets/images/room.xcf b/assets/images/room.xcf
new file mode 100644
index 0000000..0f8f489
Binary files /dev/null and b/assets/images/room.xcf differ
diff --git a/assets/images/scanner.png b/assets/images/scanner.png
new file mode 100644
index 0000000..02ce824
Binary files /dev/null and b/assets/images/scanner.png differ
diff --git a/assets/images/scanner.xcf b/assets/images/scanner.xcf
new file mode 100644
index 0000000..2d06c6e
Binary files /dev/null and b/assets/images/scanner.xcf differ
diff --git a/game.scm b/game.scm
index b5f1aed..43e1daf 100644
--- a/game.scm
+++ b/game.scm
@@ -1,15 +1,20 @@
-(use-modules (chickadee graphics color)
-             (chickadee graphics font)
-             (chickadee graphics texture)
-             (chickadee graphics viewport)
-             (chickadee math vector)
-             (oop goops)
-             (starling asset)
-             (starling gui)
-             (starling kernel)
-             (starling node)
-             (starling node-2d)
-             (starling scene))
+(define-module (game)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics font)
+  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee graphics viewport)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee scripting)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (starling asset)
+  #:use-module (starling gui)
+  #:use-module (starling kernel)
+  #:use-module (starling node)
+  #:use-module (starling node-2d)
+  #:use-module (starling scene)
+  #:duplicates (merge-generics)
+  #:export (launch-game))
 
 
 ;;;
@@ -20,6 +25,7 @@
 (define window-height 720)
 (define game-width 640)
 (define game-height 360)
+(define player-display-name "")
 
 
 ;;;
@@ -29,6 +35,7 @@
 (define-asset dialog-box-texture (load-image "assets/images/dialog-box.png"))
 (define-asset darkness (load-image "assets/images/darkness.png"))
 (define-asset room-background (load-image "assets/images/room.png"))
+(define-asset scanner-texture (load-image "assets/images/scanner.png"))
 (define-asset monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
 
 
@@ -39,6 +46,15 @@
 (define-class <text-box> (<widget>)
   (text #:accessor text #:init-keyword #:text #:init-value "" #:watch? #t))
 
+(define-method (on-change (text-box <text-box>) slot-name old new)
+  (case slot-name
+    ((text)
+     (let ((l (& text-box text)))
+       (when l
+         (set! (text l) new))))
+    (else
+     (next-method))))
+
 (define-method (apply-theme (text-box <text-box>))
   (next-method)
   (replace text-box
@@ -53,6 +69,32 @@
                            (asset-ref
                             (font text-box))))))))
 
+
+;;;
+;;; Device
+;;;
+
+;; An object you can interact with by clicking.
+(define-class <device> (<margin-container>)
+  (texture #:accessor texture #:init-keyword #:texture
+           #:init-value null-texture #:watch? #t))
+
+(define-method (on-change (device <device>) slot-name old new)
+  (case slot-name
+    ((texture)
+     (let ((sprite (& device sprite)))
+       (when sprite
+         (set! (texture sprite) new))))
+    (else
+     (next-method))))
+
+(define-method (apply-theme (device <device>))
+  (next-method)
+  (replace device
+    (make <sprite>
+      #:name 'sprite
+      #:texture (texture device))))
+
 
 ;;;
 ;;; Game
@@ -63,18 +105,99 @@
               (font monogram-font)))
 
 (define-class <game> (<gui-scene>)
-  (state #:accessor state #:init-value #f))
+  (state #:accessor state #:init-value #f)
+  (friendship #:accessor friendship #:init-value 0)
+  (dialog-container #:accessor dialog-container)
+  (click-channel #:getter click-channel #:init-thunk make-channel))
+
+(define-method (detach-all (game <game>))
+  (for-each detach (children game)))
+
+(define-method (dialog (game <game>) name line)
+  (let ((old-state (state game))
+        (c (dialog-container game)))
+    (set! (state game) 'dialog)
+    (attach-to game c)
+    (set! (text (& c name-margin name)) name)
+    (set! (text (& c text-box)) line)
+    (channel-get (click-channel game))
+    (detach c)
+    (set! (state game) old-state)))
 
 (define-method (intro (game <game>))
   (set! (state game) 'intro)
-  (parameterize ((current-theme gui-theme))
-    (attach-to game
-               (make <sprite>
-                 #:texture darkness)
-               (make <text-box>
-                 #:text "Hello"
-                 #:width game-width
-                 #:height 50.0))))
+  (attach-to game
+             (make <sprite>
+               #:name 'intro-darkness
+               #:texture darkness))
+  (dialog game player-display-name "> ...")
+  (dialog game player-display-name "> Where am I?")
+  (dialog game player-display-name "> What is this place?")
+  (detach-all game)
+  (explore game))
+
+(define-method (explore (game <game>))
+  (define (tint-all color)
+    (set! (tint (& game room-background)) color)
+    (set! (tint (& game scanner sprite)) color))
+  (define (fade-in)
+    (tween 60 black white tint-all
+           #:interpolate color-lerp))
+  (define (fade-out)
+    (tween 60 white black tint-all
+           #:interpolate color-lerp))
+  (define (end-game)
+    (run-script game
+      (fade-out)
+      (detach-all game)
+      (if (> (friendship game) 3)
+          (good-ending game)
+          (bad-ending-1 game))))
+  (attach-to game
+             (make <sprite>
+              #:name 'room-background
+              #:texture room-background)
+             (make <device>
+               #:name 'scanner
+               #:rank 1
+               #:texture scanner-texture
+               #:position (vec2 586.0 196.0)
+               #:listeners
+               `((click . ,(lambda (widget button)
+                             (if (eq? button 'left)
+                                 (begin
+                                   (end-game)
+                                   #t)
+                                 #f))))))
+  (fade-in))
+
+(define-method (good-ending (game <game>))
+  (set! (state game) 'good-ending)
+  (attach-to game
+             (make <sprite>
+               #:name 'darkness
+               #:texture darkness)
+             (make <label>
+               #:name 'message
+               #:font monogram-font
+               #:text "this is the good ending. I am so proud of you. congratulations."
+               #:align 'center
+               #:vertical-align 'center
+               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0)))))
+
+(define-method (bad-ending-1 (game <game>))
+  (set! (state game) 'bad-ending-1)
+  (attach-to game
+             (make <sprite>
+               #:name 'darkness
+               #:texture darkness)
+             (make <label>
+               #:name 'message
+               #:font monogram-font
+               #:text "uh oh this is the bad ending. sorry, bucko."
+               #:align 'center
+               #:vertical-align 'center
+               #:position (vec2 (/ game-width 2.0) (/ game-height 2.0)))))
 
 (define-method (on-boot (game <game>))
   (set! (cameras game)
@@ -82,11 +205,39 @@
                 #:resolution (vec2 game-width game-height)
                 #:viewport (make-viewport 0 0 window-width window-height
                                           #:clear-color black))))
-  (intro game))
-
-(boot-kernel (make <kernel>
-               #:window-config (make <window-config>
-                                 #:title "Spring Lisp Game Jam 2021"
-                                 #:width window-width
-                                 #:height window-height))
-             (lambda () (make <game>)))
+  ;; Dialog nodes.
+  (parameterize ((current-theme gui-theme))
+    (set! (dialog-container game)
+          (make <vertical-container>
+            #:name 'dialog-container
+            #:rank 999
+            #:children
+            (list (make <margin-container>
+                    #:name 'name-margin
+                    #:margin 4.0
+                    #:children
+                    (list (make <label>
+                            #:name 'name
+                            #:font monogram-font)))
+                  (make <text-box>
+                    #:name 'text-box
+                    #:width game-width
+                    #:height 50.0)))))
+  (run-script game
+    (intro game)))
+
+(define-method (on-mouse-release (game <game>) button x y)
+  (case (state game)
+    ('dialog
+     (when (eq? button 'left)
+       (channel-put! (click-channel game) #t)))
+    (else
+     (next-method))))
+
+(define (launch-game)
+  (boot-kernel (make <kernel>
+                 #:window-config (make <window-config>
+                                   #:title "Spring Lisp Game Jam 2021"
+                                   #:width window-width
+                                   #:height window-height))
+               (lambda () (make <game>))))
diff --git a/pre-inst-env.in b/pre-inst-env.in
index 5298282..ef25760 100644
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -6,6 +6,19 @@ abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
 export GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
 export GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
 
+if [ -n "$LOCAL_CHICKADEE" ]
+then
+    export GUILE_LOAD_PATH=$LOCAL_CHICKADEE:$GUILE_LOAD_PATH
+    export GUILE_LOAD_COMPILED_PATH=$LOCAL_CHICKADEE:$GUILE_LOAD_COMPILED_PATH
+    export CHICKADEE_DATADIR=$LOCAL_CHICKADEE/data
+fi
+
+if [ -n "$LOCAL_STARLING" ]
+then
+    export GUILE_LOAD_PATH=$LOCAL_STARLING:$GUILE_LOAD_PATH
+    export GUILE_LOAD_COMPILED_PATH=$LOCAL_STARLING:$GUILE_LOAD_COMPILED_PATH
+fi
+
 PATH="$abs_top_builddir/scripts:$PATH"
 export PATH
 
diff --git a/run-game b/run-game
index a50c20c..0fb9b15 100755
--- a/run-game
+++ b/run-game
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-DEV_MODE=1 ./pre-inst-env guile game.scm
+DEV_MODE=1 ./pre-inst-env guile -c '(use-modules (game)) (launch-game)'
-- 
cgit v1.2.3