Refactor logging module

modules/ces/entity.scm

@@ -11,7 +11,6 @@
   #:use-module (hoot hashtables)
   #:use-module (hoot match)
   #:use-module (lib ihashtable)
-  #:use-module (logging)
   #:export (game-entity?
             game-entity-id
             game-entity-components
@@ -43,11 +42,6 @@
 (define (set-entity-components entity new-components)
   "Returns a copy of the provided entity with components set to new-components.
 Returns false on error."
-  (write-log! "Running entity:set-entity-components"
-              (when (game-entity? entity)
-                (game-entity-id entity))
-              (when (ihashtable? new-components)
-                (ihashtable-keys new-components)))
   (if (and (game-entity? entity)
            (ihashtable? new-components))
       (let ((id (game-entity-id entity))

modules/ces/system.scm

@@ -20,7 +20,6 @@
   #:use-module (scheme case-lambda)
   #:use-module ((hoot syntax) #:select (define*))
   #:use-module (ces entity)
-  #:use-module (logging)
   #:export (create-system
             system-name
             system?
@@ -59,7 +58,6 @@
                         (post-process #f)
                         (entity-added-hook #f)
                         (entity-removed-hook #f))
-  (write-log! "Running system:create-system")
   (make-system predicate
                process
                pre-process
@@ -79,14 +77,9 @@ which takes a time delta and entity as an input and returns
 a proceedure that takes a time delta.
 This is essentially a partial application of the system's
 process proceedure."
-  (write-log! "Running system:apply-system-to-entity"
-              "System?" (system? system)
-              "System process" (system-process-entity system)
-              "System name" (system-name system))
   (let* ((sys-proc (system-process-entity system))
          (wrapped-proc (lambda (dt)
                          (sys-proc entity dt))))
-    (write-log! "System-applied to entity successfully")
     wrapped-proc))
 
 (define (run-system-on-entity! system dt entity . entities)

modules/lib/ihashtable.scm

@@ -4,7 +4,6 @@
   #:use-module (scheme case-lambda)
   #:use-module (hoot hashtables)
   #:use-module ((hoot syntax) #:select (define*))
-  #:use-module (logging)
   #:export (ihashtable?
             ihashtable-entries
             create-ihashtable

modules/lib/string-util.scm

@@ -0,0 +1,48 @@
+(define-module (lib string-util)
+  #:pure
+  #:use-module (scheme base)
+  #:use-module (hoot hashtables)
+  #:use-module (lib ihashtable)
+  #:use-module (ces entity)
+  #:use-module (ces system)
+  #:export (make-pretty-string))
+
+(define (%hashtable->pairs table)
+  (let ((pair-list (list)))
+    (hashtable-for-each
+     (lambda (k v)
+       (set! pair-list
+             (cons (list k v)
+                   pair-list)))
+     table)
+    pair-list))
+
+(define (make-pretty-string v . rest)
+  (cond
+   ((not (null? rest))
+    (string-append (make-pretty-string v)
+                   " "
+                   (apply make-pretty-string rest)))
+   ((null? v) "")
+   ((procedure? v) "<proc>")
+   ((boolean? v) (if v "#t" "#f"))
+   ((string? v) v)
+   ((symbol? v) (string-append "'" (symbol->string v)))
+   ((number? v) (number->string v))
+   ((list? v)
+    (string-append "(" (apply make-pretty-string v) ")"))
+   ((vector? v)
+    (string-append "[" (apply make-pretty-string (vector->list v)) "]"))
+   ((hashtable? v)
+    (string-append "#{" (apply make-pretty-string (%hashtable->pairs v)) "}"))
+   ((ihashtable? v)
+    (string-append "#ihashtable[contents=" (make-pretty-string (ihashtable-entries v)) "]"))
+   ((game-entity? v)
+    (string-append "#entity[id=" (make-pretty-string (game-entity-id v))
+                   ",components=" (make-pretty-string (get-entity-components v)) "]"))
+   ((system? v)
+    (string-append "#system[system-name=" (make-pretty-string (system-name v))
+                   ",system-predicate?=" (make-pretty-string (system-predicate? v))
+                   ",system-process-entity=" (make-pretty-string (system-process-entity v))
+                   "]"))
+   (else "unknown D:")))

modules/logging.scm

@@ -3,47 +3,17 @@
   #:use-module (scheme base)
   #:use-module (hoot hashtables)
   #:use-module ((hoot write) #:select (display))
+  #:use-module (lib string-util)
   #:export (*logger*
-            %make-string
             write-log!
             pprint!))
 
-(define (%hashtable->pairs table)
-  (let ((pair-list (list)))
-    (hashtable-for-each
-     (lambda (k v)
-       (set! pair-list
-             (cons (list k v)
-                   pair-list)))
-     table)
-    pair-list))
-
-(define (%make-string v . rest)
-  (cond
-   ((not (null? rest))
-    (string-append (%make-string v)
-                   " "
-                   (apply %make-string rest)))
-   ((null? v) "")
-   ((procedure? v) "<proc>")
-   ((boolean? v) (if v "#t" "#f"))
-   ((string? v) v)
-   ((symbol? v) (string-append "'" (symbol->string v)))
-   ((number? v) (number->string v))
-   ((list? v)
-    (string-append "(" (apply %make-string v) ")"))
-   ((vector? v)
-    (string-append "[" (apply %make-string (vector->list v)) "]"))
-   ((hashtable? v)
-    (string-append "#{" (apply %make-string (%hashtable->pairs v)) "}"))
-   (else "unknown D:")))
-
 (define (pprint! val . v)
-  (display (%make-string val))
+  (display (make-pretty-string val))
   (unless (null? v)
     (display " ")
     (for-each (lambda (val)
-                (display (%make-string val))
+                (display (make-pretty-string val))
                 (display " "))
               v))
   (display "\n")