From a5ce22cbd380b2b3edcc777e59ccfda79a1094fd Mon Sep 17 00:00:00 2001 From: TakeV Date: Tue, 28 May 2024 01:21:01 -0400 Subject: [PATCH] Refactor logging module --- modules/ces/entity.scm | 6 ----- modules/ces/system.scm | 7 ------ modules/lib/ihashtable.scm | 1 - modules/lib/string-util.scm | 48 +++++++++++++++++++++++++++++++++++++ modules/logging.scm | 36 +++------------------------- 5 files changed, 51 insertions(+), 47 deletions(-) create mode 100644 modules/lib/string-util.scm diff --git a/modules/ces/entity.scm b/modules/ces/entity.scm index f95bcf6..d1f9529 100644 --- a/modules/ces/entity.scm +++ b/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)) diff --git a/modules/ces/system.scm b/modules/ces/system.scm index b70fea3..283397e 100644 --- a/modules/ces/system.scm +++ b/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) diff --git a/modules/lib/ihashtable.scm b/modules/lib/ihashtable.scm index 91e71bf..052ce77 100644 --- a/modules/lib/ihashtable.scm +++ b/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 diff --git a/modules/lib/string-util.scm b/modules/lib/string-util.scm new file mode 100644 index 0000000..913583f --- /dev/null +++ b/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) "") + ((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:"))) diff --git a/modules/logging.scm b/modules/logging.scm index 8d493f0..44315bc 100644 --- a/modules/logging.scm +++ b/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) "") - ((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")