From 0b5067494a8904c999bdfbb78a88d0813500ea49 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Sun, 15 Jul 2018 22:08:43 +0200
Subject: Add minimal support for conversations.

---
 scenes/game.scm | 45 ++++++++++++++++++++++++++++++++++-----------
 1 file changed, 34 insertions(+), 11 deletions(-)

diff --git a/scenes/game.scm b/scenes/game.scm
index 4c052e6..d2c820e 100644
--- a/scenes/game.scm
+++ b/scenes/game.scm
@@ -42,7 +42,6 @@
 
 (define %width 320)
 (define %height 240)
-(define %game-over #f)
 
 
 (define-class <character> (<node-2d>)
@@ -87,7 +86,8 @@
   (weight #:accessor weight #:init-form 50)
   (music #:accessor music #:init-form 50)
   (career #:accessor career #:init-form 50)
-  (curiosity #:accessor curiosity #:init-form 50))
+  (curiosity #:accessor curiosity #:init-form 50)
+  (talking? #:accessor talking? #:init-form #f))
 
 (define (load-atlas file-name tile-width tile-height)
   (split-texture (load-image file-name) tile-width tile-height))
@@ -133,6 +133,7 @@
 (define-asset test-map (load-tile-map "assets/maps/01.tmx"))
 
 (define-class <game> (<scene>)
+  (status #:accessor status #:init-form 'playing)
   (tile-map #:accessor tile-map #:init-form test-map)
   (collision-hitbox #:getter collision-hitbox #:init-form (make-rect 0.0 0.0 0.0 0.0)))
 
@@ -143,6 +144,8 @@
   (load-tile-font "assets/fonts/bubblemad_8x8.png" 8 8
                   " !\"©_%❤'()*+,-./0123456789:←<=>?@abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 
+(define-asset text-bubble
+  (load-image "assets/images/paper.png"))
 
 (define-method (populate (game <game>))
   (let ((player (make <player>
@@ -270,6 +273,17 @@
                (- 0 (vec2-x pos))
                (- 0 (vec2-y pos))))))
 
+(define-method (talk (player <player>) who)
+  (unless (talking? player)
+    (let ((bubble (child-ref (parent (parent player)) 'text-bubble)))
+      (set! (visible? bubble) #t))
+    (set! (talking? player) who)))
+
+(define-method (stop-talking (player <player>))
+  (when (talking? player)
+    (set! (visible? (child-ref (parent (parent player)) 'text-bubble)) #f)
+    (set! (talking? player) #f)))
+
 (define-method (draw (stats <stats>) alpha)
   (let* ((pos (position stats))
          (x (vec2-x pos))
@@ -309,16 +323,25 @@
                  #:layers (list 4)))
 
 
-(define (decrease-lifetime)
-  (let ((current-lifetime (lifetime %player)))
-    (if (< current-lifetime 0)
-        (set! %game-over 'old-age)
-        (set! (lifetime %player) (- current-lifetime 1)))))
-
 (define (game)
   (let ((game (make <game>
                 #:origin (vec2 (- (/ %width 2))
                                (- (/ %height 2))))))
-    (with-agenda (agenda game)
-                 (schedule-every 120 decrease-lifetime))
-    game))
+    (with-agenda
+     (agenda game)
+     (schedule-every
+      120 (lambda _
+            (let* ((player (child-ref game 'player))
+                   (current-lifetime (lifetime player)))
+              (if (< current-lifetime 0)
+                  (set! (status game) 'game-over)
+                  (set! (lifetime player) (- current-lifetime 1)))))))
+    (make <node-2d>
+      #:children
+      (list game
+            (make <sprite>
+              #:name 'text-bubble
+              #:region (make-rect 0.0 0.0 300.0 100.0)
+              #:position (vec2 0 0)
+              #:visible? #f
+              #:texture (asset-ref text-bubble))))))
-- 
cgit v1.2.3