Refactor logging module

This commit is contained in:
TakeV 2024-05-28 01:21:01 -04:00
parent dada7bd7c4
commit a5ce22cbd3
Signed by: TakeV
GPG key ID: A64F41345C7400AF
5 changed files with 51 additions and 47 deletions

View file

@ -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))

View file

@ -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)

View file

@ -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

View file

@ -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:")))

View file

@ -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")