From bc2ecb951a837db673b13def15f2c31f7134415a Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Mon, 1 Mar 2021 00:08:40 +0100
Subject: WIP

---
 utils.scm | 170 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 170 insertions(+)
 create mode 100644 utils.scm

(limited to 'utils.scm')

diff --git a/utils.scm b/utils.scm
new file mode 100644
index 0000000..5c31621
--- /dev/null
+++ b/utils.scm
@@ -0,0 +1,170 @@
+;;; The Inevitable Game
+;;; Copyright © 2018, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (utils)
+  #:use-module (chickadee)
+  #:use-module (chickadee audio)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics font)
+  #:use-module (chickadee graphics path)
+  #:use-module (chickadee graphics sprite)
+  #:use-module (chickadee graphics texture)
+  #:use-module (chickadee graphics tiled)
+  #:use-module (chickadee scripting)
+  #:use-module (config)
+  #:use-module (engine assets)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:export (arrange-text
+
+            <label>
+            draw-label
+            visible?
+            
+            <sprite>
+            agenda
+            position
+            texture
+            tint
+
+            draw
+
+            <animated-sprite>
+            atlas
+
+            draw-animated-sprite
+            update-animated-sprite
+            change-sprite-animation
+
+            <character>
+            name
+            velocity
+            walk-speed
+            direction
+            conversations
+            accepted-messages
+            speaking?
+
+            walk))
+
+(define* (arrange-text text font #:key
+                       (margin 0.0)
+                       (max-width %width))
+  "Take the string TEXT and split it at spaces so that it fits in the
+given MAX-WIDTH.  Return a list of lines."
+  (match (fold (lambda (chunk acc)
+                 (match acc
+                   ((#:width width #:result (and (current-line . tail) lines))
+                    (let* ((new-line (string-append current-line " " chunk))
+                           (new-width (font-line-width font new-line)))
+                      (if (< (+ new-width margin) max-width)
+                          `(#:width ,new-width
+                            #:result ,(cons new-line tail))
+                          `(#:width ,(font-line-width font chunk)
+                            #:result ,(cons chunk lines)))))))
+               '(#:width 0 #:result (""))
+               (string-tokenize text))
+    ((#:width _ #:result lines)
+     (reverse lines))))
+
+(define-class <label> ()
+  (position #:accessor position #:init-keyword #:position)
+  (visible? #:accessor visible? #:init-keyword #:visible?)
+  (font #:accessor font #:init-keyword #:font)
+  (text #:accessor text #:init-form "" #:init-keyword #:text))
+
+(define-method (draw-label label alpha)
+  (when (visible? label)
+    (draw-text (text label) (position label)
+               #:font (asset-ref (font label)))))
+
+(define-class <sprite> ()
+  (agenda #:getter agenda #:init-form (make-agenda))
+  (position #:accessor position #:init-keyword #:position)
+  (texture #:accessor texture #:init-keyword #:texture)
+  (tint #:accessor tint #:init-keyword #:tint #:init-form white))
+
+(define-method (draw (sprite <sprite>) alpha)
+  (draw-sprite (asset-ref (texture sprite))
+               (position sprite)
+               #:tint (tint sprite)))
+
+(define-class <animated-sprite> (<sprite>)
+  (atlas #:accessor atlas #:init-keyword #:atlas)
+  (animations #:accessor animations #:init-keyword #:animations)
+  (frame-duration #:accessor frame-duration #:init-keyword #:frame-duration)
+  (current-animation #:accessor current-animation
+                     #:init-keyword #:current-animation)
+  (start-time #:accessor start-time #:init-form 0))
+
+(define (draw-animated-sprite sprite offset)
+  (draw-sprite (asset-ref (texture sprite))
+               (vec2+ offset (position sprite))
+               #:tint (tint sprite)))
+
+(define (update-animated-sprite sprite dt)
+  (let* ((anim (assq-ref (animations sprite) (current-animation sprite)))
+         (frame-duration (frame-duration sprite))
+         (anim-duration (* frame-duration (vector-length anim)))
+         (time (modulo (- (agenda-time) (start-time sprite)) anim-duration))
+         (frame (vector-ref anim (floor (/ time frame-duration))))
+         (texture-region (texture-atlas-ref (asset-ref (atlas sprite)) frame)))
+    (set! (texture sprite) texture-region)))
+
+(define (change-sprite-animation sprite name)
+  (set! (current-animation sprite) name)
+  (set! (start-time sprite) (with-agenda (agenda sprite) (agenda-time))))
+
+(define-class <character> (<animated-sprite>)
+  (name #:getter name #:init-keyword #:name)
+  (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
+  (walk-speed #:accessor walk-speed #:init-form 0.8)
+  (direction #:accessor direction #:init-form '(idle))
+  (conversations #:accessor conversations #:init-keyword #:conversations)
+  (accepted-messages #:accessor accepted-messages #:init-form '((hello "Hello there!")))
+  (speaking? #:accessor speaking? #:init-form #false))
+
+(define-method (walk (character <character>) directions . rest)
+  (let ((stop? (member 'stop rest)))
+    (unless (and (equal? (direction character) directions)
+                 (not stop?))
+      (let ((speed  (if stop? 0.0 (walk-speed character))))
+        (change-sprite-animation character (last directions))
+        (for-each (lambda (dir)
+                    (case dir
+                      ((right)
+                       (set-vec2-x! (velocity character) speed))
+                      ((left)
+                       (set-vec2-x! (velocity character) (* -1.0 speed)))
+                      ((up)
+                       (set-vec2-y! (velocity character) speed))
+                      ((down)
+                       (set-vec2-y! (velocity character) (* -1.0 speed)))
+                      ((idle)
+                       (set-vec2-x! (velocity character) 0.0)
+                       (set-vec2-y! (velocity character) 0.0)
+                       (change-sprite-animation
+                        character
+                        (case (last (direction character))
+                          ((right) 'idle-right)
+                          ((left)  'idle-left)
+                          ((up)    'idle-back)
+                          ((down)  'idle-front))))))
+                  directions)
+        (set! (direction character) directions)))))
-- 
cgit v1.2.3