Initial commit.

2 files changed, 340 insertions, 0 deletions

diff --git a/scenes/game.scm b/scenes/game.scm
new file mode 100644
index 0000000..c7aaba7
--- /dev/null
+++ b/scenes/game.scm
@@ -0,0 +1,276 @@
+;;; The Inevitable Game
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;;
+;;; 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 (scenes game)
+  #:use-module (chickadee input keyboard)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render color)
+  #:use-module (chickadee render font)
+  #:use-module (chickadee render shapes)
+  #:use-module (chickadee render texture)
+  #:use-module (chickadee render tiled)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (engine assets)
+  #:use-module (engine node)
+  #:use-module (engine node-2d)
+  #:use-module (engine scene)
+  #:use-module (oop goops)
+  #:export (game))
+
+(use-modules (chickadee)
+;             (chickadee render sprite)
+             (chickadee scripting))
+
+
+(define %width 320)
+(define %height 240)
+(define %game-over #f)
+
+
+(define-class <character> (<node-2d>)
+  (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
+  (walk-speed #:accessor walk-speed #:init-form 1.0)
+  (direction #:accessor direction #:init-form '(idle))
+  (hitbox #:getter hitbox #:init-form (make-rect 0.0 0.0 32.0 32.0)))
+
+(define-class <stats> (<node-2d>)
+  (player #:accessor player #:init-form #f #:init-keyword #:player))
+
+(define-method (walk (character <character>) directions . rest)
+  (unless (equal? (direction character) directions)
+    (let ((sprite (child-ref character 'sprite))
+          (speed  (if (member 'stop rest) 0.0 (walk-speed character))))
+      (change-animation sprite (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-animation sprite (case (last (direction character))
+                                                ((right) 'idle-right)
+                                                ((left)  'idle-left)
+                                                ((up)    'idle-back)
+                                                ((down)  'idle-front))))))
+                directions)
+      (set! (direction character) directions))))
+
+(define-class <player> (<character>)
+  (previous-key-presses #:accessor previous-key-presses #:init-form (list))
+  (lifetime #:accessor lifetime #:init-form 100)
+  (happiness #:accessor happiness #:init-form 50)
+  (weight #:accessor weight #:init-form 50)
+  (music #:accessor music #:init-form 50)
+  (career #:accessor career #:init-form 50)
+  (curiosity #:accessor curiosity #:init-form 50))
+
+(define (load-atlas file-name tile-width tile-height)
+  (split-texture (load-image file-name) tile-width tile-height))
+
+(define-asset player-atlas
+  (load-atlas "assets/images/thing.png" 32 32))
+
+(define-method (populate (player <player>))
+  (list
+   (make <animated-sprite>
+     #:name 'sprite
+     #:atlas player-atlas
+     #:animations '((idle-right . #(0 1))
+                    (idle-left  . #(2 3))
+                    (idle-front . #(0 1)) ; TODO
+                    (idle-back  . #(0 1))  ; TODO
+                    (right      . #(0 1))
+                    (left       . #(2 3))
+                    (up         . #(0 1))  ; TODO
+                    (down       . #(2 3)))  ; TODO
+     #:current-animation 'idle-front
+     #:frame-duration 15)))
+
+
+(define-asset test-map (load-tile-map "assets/maps/01.tmx"))
+
+(define-class <game> (<scene>)
+  (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)))
+
+(define-asset game-font
+  (load-tile-font "assets/fonts/bubblemad_8x8.png" 8 8
+                  " !\"©_%❤'()*+,-./0123456789:←<=>?@abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+
+;; TODO: hack :(
+;; TODO: It's ugly to use the global variable %player here, but
+;; (player stats) below always returns #f.
+(define %player #f)
+
+(define-method (populate (game <game>))
+  (let ((player (make <player>
+                  #:name 'player
+                  #:position (vec2 620.0 1100.0))))
+    (set! %player player)
+    (list player
+          (make <filled-rect>
+            #:name 'hit
+            #:region (make-rect 0.0 0.0 0.0 0.0)
+            #:position (vec2 0 0)
+            #:color (transparency 0.2))
+          (make <stats>
+            #:name 'stats #:player player
+            #:position (vec2 10.0 (- %height 10.0))))))
+
+(define* (collides? player game #:key (layer "collision"))
+  (let* ((pos (position player))
+         (offset (origin game))
+         (player-hitbox (hitbox player))
+         (hitbox (collision-hitbox game))
+         (hit-vis (region (child-ref game 'hit))))
+    (set-rect-x! hitbox (+ (- (vec2-x offset)) (vec2-x pos) (rect-x player-hitbox)))
+    (set-rect-y! hitbox (+ (- (vec2-y offset)) (vec2-y pos) (rect-y player-hitbox)))
+    (set-rect-width! hitbox (rect-width player-hitbox))
+    (set-rect-height! hitbox (rect-height player-hitbox))
+
+    ;; TODO: memoize objects and shapes as they don't change.
+    (any (lambda (obj)
+           (let* ((r-wrong (map-object-shape obj))
+                  ;; TODO: chickadee parses the object layer
+                  ;; incorrectly, so all objects are flipped vertically.
+                  (r (make-rect (rect-x r-wrong)
+                                (- (rect-y r-wrong) (rect-height r-wrong))
+                                (rect-width r-wrong)
+                                (rect-height r-wrong))))
+             (if (rect-intersects? hitbox r)
+                 (begin
+                   (set-rect-x! hit-vis (+ (rect-x r) (vec2-x offset)))
+                   (set-rect-y! hit-vis (+ (rect-y r) (vec2-y offset)))
+                   (set-rect-width! hit-vis (rect-width r))
+                   (set-rect-height! hit-vis (rect-height r))
+                   #t)
+                 #f)))
+         (object-layer-objects
+          (tile-map-layer-ref (asset-ref (tile-map game)) layer)))))
+
+(define-method (update (game <game>) dt)
+  (let ((player (child-ref game 'player)))
+    ;; Stop any motion in a direction when the matching key has just
+    ;; been released.
+    (let ((released (filter key-released? (previous-key-presses player))))
+      (unless (null? released)
+        (walk player released 'stop)))
+
+    ;; React to current key presses
+    (let ((active (fold (lambda (direction acc)
+                          (if (key-pressed? direction)
+                              (cons direction acc)
+                              acc))
+                        '()
+                        '(left right up down))))
+      (if (null? active)
+          (walk player '(idle))
+          (walk player active))
+      (set! (previous-key-presses player) active))
+
+    ;; Only move when the new position does not result in a collision.
+    (let* ((pos (position player))
+           (vel (velocity player)))
+      (vec2-add! pos vel)
+      (when (collides? player game #:layer "collision")
+        (vec2-sub! pos vel))
+
+      ;; TODO: express this on the map instead?
+      ;; (when (> (vec2-x pos) 294.0)
+      ;;   (set-vec2-x! pos 294.0))
+      ;; (when (< (vec2-x pos) -6.0)
+      ;;   (set-vec2-x! pos -6.0))
+      ;; (when (> (vec2-y pos) (- %height 32.0))
+      ;;   (set-vec2-y! pos (- %height 32.0)))
+      ;; (when (< (vec2-y pos) 0.0)
+      ;;   (set-vec2-y! pos 0.0))
+
+      ;; Keep the player in the centre
+      (move-to game
+               (- 0 (vec2-x pos))
+               (- 0 (vec2-y pos))))))
+
+(define-method (draw (stats <stats>) alpha)
+  (let* ((pos (position stats))
+         (x (vec2-x pos))
+         (y (vec2-y pos))
+         (step 5)
+         (thickness 2)
+         (properties (list lifetime
+                           happiness
+                           weight
+                           music
+                           career
+                           curiosity))
+         ;; FIXME
+         (player %player;(player stats)
+          ))
+    (for-each (lambda (property index)
+                (let* ((value (property player))
+                       (start (vec2 x (- y (* step index))))
+                       (end-y (- y (* step index)))
+                       (end   (vec2 (+ x 100) end-y)))
+                  (draw-line start end
+                             #:thickness thickness #:color red)
+                  (when (> value 0)
+                    (draw-line start (vec2 (+ x value) end-y)
+                               #:thickness thickness #:color green))))
+              properties
+              (iota (length properties)))))
+
+(define-method (draw (game <game>) alpha)
+  (draw-tile-map (asset-ref (tile-map game))
+                 #:position (position game)
+                 #:layers (list 0 1 2 3 4)
+                 ;; (list "tiles"
+                 ;;       "decoration"
+                 ;;       "fence"
+                 ;;       "collision"
+                 ;;       "objects")
+                 )
+  (next-method)
+  ;; Top-most layer
+  (draw-tile-map (asset-ref (tile-map game))
+                 #:position (position game)
+                 #:layers (list 5))
+  )
+
+
+(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))
diff --git a/scenes/intro.scm b/scenes/intro.scm
new file mode 100644
index 0000000..640bdc8
--- /dev/null
+++ b/scenes/intro.scm
@@ -0,0 +1,64 @@
+;;; The Inevitable Game
+;;; Copyright © 2018 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 (scenes intro)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render font)
+  #:use-module (engine assets)
+  #:use-module (engine node)
+  #:use-module (engine node-2d)
+  #:use-module (engine scene)
+  #:use-module (engine shell)
+  #:use-module (scenes game)
+  #:use-module (oop goops)
+  #:export (<intro>))
+
+(define-class <intro> (<scene>))
+
+(define-asset intro-font
+  (load-tile-font "assets/fonts/bubblemad_8x8.png" 8 8
+                  " !\"©_%❤'()*+,-./0123456789:←<=>?@abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+
+
+(define texts
+  '("The void has been suspended for a while.\nYou exist for now."
+    "Confusion gave way to a brief burst of consciousness.\nHere you are."
+    "The haze clears and you can see that you are here now.\nYou did not ask for this."
+    "You rise from deepest waters and take your first breath.\nYou wonder: will this last?"
+    "History yields to the present.\nThe present crumbles underfoot,\nso you begin to run."
+    "A leaf has turned.\nThe sunshine warms and blinds.\nThe leaf begins to dry."))
+
+(set! *random-state* (random-state-from-platform))
+
+(define-method (populate (intro <intro>))
+  (list
+   (make <label>
+     #:name 'welcome
+     #:font intro-font
+     #:text (list-ref texts (random (length texts)))
+     #:position (vec2 16.0 120.0))
+   (make <label>
+     #:name 'press-enter
+     #:font intro-font
+     #:text "press enter to start."
+     #:position (vec2 72.0 80.0))))
+
+(define-method (on-key-press (intro <intro>) key mods repeat?)
+  (when (eq? key 'return)
+    (switch-scene (root-node)
+                  (game))))