Move logging to its own module

game.scm

@@ -20,6 +20,7 @@
 
 (import (scheme base)
         (scheme inexact)
+        (hoot atomics)
         (hoot debug)
         (hoot ffi)
         (hoot hashtables)
@@ -43,42 +44,63 @@
         (ces system-manager)
         (ces entity-manager)
         (game-core)
-        (game game-objects))
+        (game game-objects)
+        (logging))
 
-(log-to-console! "Getting canvas")
+;; Canvas settings
 (define canvas (get-element-by-id "canvas"))
 (define context (get-context canvas "2d"))
 
-(log-to-console! "Creating canvas renderer")
-#;(define canvas-renderer
-(create-rendering-system context
-(lambda (_)
-(request-animation-frame draw-callback))))
+(define game-width 640.0)
+(define game-height 480.0)
 
-(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
+(parameterize ((*logger* log-to-console!))
 
-(log-to-console! "Creating entity manager")
-(define e-manager
-  (create-entity-manager))
+  (write-log! "Creating entity manager")
+  (define e-manager
+    (create-entity-manager))
 
-(log-to-console! "Creating system manager")
-(define s-manager
-  (create-system-manager))
+  (write-log! "Creating system manager")
+  (define s-manager
+    (create-system-manager))
 
-(define image:player       (make-image "assets/images/ball.png"))
-#; (define game
-(make-game e-manager
-s-manager
-0
-dt))
+  (write-log! "Getting player image.")
+  (define image:player       (make-image "assets/images/ball.png"))
 
-;;(start-game! game dt)
+  (write-log! "Creating game")
+  (define game (make-game e-manager s-manager 0))
+
+  (write-log! "Defining draw callback maker")
+  (define (make-game-draw-callback game)
+    (let* ((game-atom (make-atomic-box #f)))
+      (begin
+        (write-log! "Called draw callback maker")
+        (atomic-box-set! game-atom (initialize-game! game))
+        (write-log! "Initialized game.")
+        (lambda (dt)
+          (begin 
+            (write-log! "Hit pre-game step")
+            (let* ((last-game-state (atomic-box-ref game-atom))
+                   (next-game-state (step-game! last-game-state dt)))
+              (begin
+                (write-log! (string-append "Looped at - " dt))
+                (atomic-box-set! game-atom next-game-state))))))))
+
+  (write-log! "Setting canvas size")
+  (set-element-width! canvas (exact game-width))
+  (set-element-height! canvas (exact game-height))
+
+  (write-log! "Defining draw callback")
+  (define draw-callback (procedure->external
+                         (make-game-draw-callback game)))
+
+  (write-log! "Requesting initial animation frame.")
+  (request-animation-frame draw-callback))
 
 
 ;; Canvas and event loop setup
 ;; Preserved for reference.
-;;(set-element-width! canvas (exact game-width))
-;;(set-element-height! canvas (exact game-height))
+;;
 ;;(add-event-listener! (current-document) "keydown"
 ;;                     (procedure->external on-key-down))
 ;;(add-event-listener! (current-document) "keyup"

modules/game-core.scm

@@ -3,6 +3,7 @@
 
 (define-module (game-core)
   :pure
+  :use-module (logging)
   :use-module (scheme base)
   :use-module (ces system)
   :use-module (ces component)
@@ -13,22 +14,17 @@
             make-game
             initialize-game!
             step-game!
-            start-game!
             get-entity-manager
             get-system-manager
 
-            write-log!
-            *logger*
-
             %entity-manager-parameter
             %system-manager-parameter))
 
 (define-record-type <game>
-    (make-game entity-manager system-manager previous-time current-time)
+    (make-game entity-manager system-manager previous-time)
   game?
   (entity-manager game-entity-manager)
   (system-manager game-system-manager)
-  (previous-time game-previous-time)
   (current-time game-current-time))
 
 ;;; Both entity and system managers are parameterized which means that
@@ -37,12 +33,6 @@
 (define *entity-manager-parameter* (make-parameter #f))
 (define *system-manager-parameter* (make-parameter #f))
 
-;; Logger should be a proceedure which takes a string
-(define *logger* (make-parameter #f))
-
-(define (write-log! msg)
-  (when (*logger*)
-    ((*logger*) msg)))
 
 (define (get-entity-manager)
   (*entity-manager-parameter*))
@@ -51,32 +41,34 @@
 
 (define (initialize-game! game)
   "Returns the initial game state after setting up each system"
-  (begin (write-log! "Initializing game.")
-         (let ((e-manager (game-entity-manager game))
-               (s-manager (game-system-manager game)))
-           (parameterize ((*entity-manager-parameter* e-manager)
-                          (*system-manager-parameter* s-manager))
-             (vector-for-each (lambda (entity)
-                                (apply-systems-to-entity! s-manager entity))
-                              (get-current-entities e-manager))
-             (make-game e-manager
-                        s-manager
-                        0)))))
+  (let ((e-manager (game-entity-manager game))
+        (s-manager (game-system-manager game)))
+    (begin
+      (write-log! "Initializing game.")
+      (parameterize ((*entity-manager-parameter* e-manager)
+                     (*system-manager-parameter* s-manager))
+        (vector-for-each (lambda (entity)
+                           (apply-systems-to-entity! s-manager entity))
+                         (get-current-entities e-manager))
+        (make-game e-manager
+                   s-manager
+                   0)))))
 
 (define (step-game! game dt)
   "Returns a new game-state after dt"
-  (begin (write-log! "Executing game step.")
-         (let* ((e-manager (game-entity-manager game))
-                (s-manager (game-system-manager game)))
-           (parameterize ((*entity-manager-parameter* e-manager)
-                          (*system-manager-parameter* s-manager))
-             (run-systems-pre-process! s-manager)
-             (run-systems! s-manager dt)
-             (run-systems-post-process! s-manager)
-             (vector-for-each (lambda (entity)
-                                (apply-systems-to-entity! s-manager entity))
-                              (get-updated-entities e-manager))
-             (let ((next-manager (get-next-generation e-manager)))
-               (make-game next-manager
-                          s-manager
-                          dt))))))
+  (let* ((e-manager (game-entity-manager game))
+         (s-manager (game-system-manager game)))
+    (begin
+      (write-log! "Running game step")
+      (parameterize ((*entity-manager-parameter* e-manager)
+                     (*system-manager-parameter* s-manager))
+        (run-systems-pre-process! s-manager)
+        (run-systems! s-manager dt)
+        (run-systems-post-process! s-manager)
+        (vector-for-each (lambda (entity)
+                           (apply-systems-to-entity! s-manager entity))
+                         (get-updated-entities e-manager))
+        (let ((next-manager (get-next-generation e-manager)))
+          (make-game next-manager
+                     s-manager
+                     dt))))))

modules/logging.scm

@@ -0,0 +1,12 @@
+(define-module (logging)
+  #:pure
+  #:use-module (scheme base)
+  #:export (*logger*
+            write-log!))
+
+;; Logger should be a proceedure which takes a string
+(define *logger* (make-parameter #f))
+
+(define (write-log! msg)
+  (when (*logger*)
+    ((*logger*) msg)))