Refactor logging module
This commit is contained in:
parent
dada7bd7c4
commit
a5ce22cbd3
5 changed files with 51 additions and 47 deletions
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
48
modules/lib/string-util.scm
Normal file
48
modules/lib/string-util.scm
Normal 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:")))
|
|
@ -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")
|
||||
|
|
Loading…
Reference in a new issue