diff options
Diffstat (limited to 'entity.scm')
| -rw-r--r-- | entity.scm | 97 |
1 files changed, 43 insertions, 54 deletions
@@ -7,8 +7,11 @@ ;; Entities = plists with shared keys (#:type, #:x, #:y, #:width, #:height, ...). - (define (entity-ref entity key #!optional default) - (get-keyword key entity (if (procedure? default) default (lambda () default)))) +(define (make-entity x y w h) + (list #:type 'none #:x x #:y y #:width w #:height h)) + +(define (entity-ref entity key #!optional default) + (get-keyword key entity (if (procedure? default) default (lambda () default)))) (define (entity-type entity) (entity-ref entity #:type #f)) @@ -36,57 +39,43 @@ (let ((skips (entity-ref entity #:skip-pipelines '()))) (and (pair? skips) (memq step skips)))) - ;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the - ;; binding from THIS module — works across compiled unit boundaries. - ;; - ;; Syntax: - ;; (define-pipeline (name skip-sym) (entity-formal ...) - ;; guard: guard-expr ;; optional — entity returned unchanged when #f - ;; body ...) - (define-syntax define-pipeline - (er-macro-transformer - (lambda (form rename _compare) - (let* ((name-skip (cadr form)) - (name (car name-skip)) - (skip (cadr name-skip)) - (formals (caddr form)) - (f1 (car formals)) - (rest (cdddr form)) - (has-guard? (and (pair? rest) (pair? (cdr rest)) - (eq? (car rest) guard:))) - (guard-expr (and has-guard? (cadr rest))) - (body (if has-guard? (cddr rest) rest)) - (%define (rename 'define)) - (%if (rename 'if)) - (%let (rename 'let)) - (%not (rename 'not)) - (%quote (rename 'quote)) - (%skip? (rename 'entity-skips-pipeline?))) - (if has-guard? - `(,%define (,name ,@formals) - (,%if (,%skip? ,f1 (,%quote ,skip)) - ,f1 - (,%if (,%not ,guard-expr) - ,f1 - (,%let () ,@body)))) - `(,%define (,name ,@formals) - (,%if (,%skip? ,f1 (,%quote ,skip)) - ,f1 - (,%let () ,@body)))))))) +;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the +;; binding from THIS module — works across compiled unit boundaries. +;; +;; Syntax: +;; (define-pipeline (name skip-sym) (entity-formal ...) +;; guard: guard-expr ;; optional — entity returned unchanged when #f +;; body ...) +(define-syntax define-pipeline + (er-macro-transformer + (lambda (form rename _compare) + (let* ((name-skip (cadr form)) + (name (car name-skip)) + (skip (cadr name-skip)) + (formals (caddr form)) + (f1 (car formals)) + (rest (cdddr form)) + (has-guard? (and (pair? rest) (pair? (cdr rest)) + (eq? (car rest) guard:))) + (guard-expr (and has-guard? (cadr rest))) + (body (if has-guard? (cddr rest) rest)) + (%define (rename 'define)) + (%if (rename 'if)) + (%let (rename 'let)) + (%not (rename 'not)) + (%quote (rename 'quote)) + (%skip? (rename 'entity-skips-pipeline?))) + (if has-guard? + `(,%define (,name ,@formals) + (,%if (,%skip? ,f1 (,%quote ,skip)) + ,f1 + (,%if (,%not ,guard-expr) + ,f1 + (,%let () ,@body)))) + `(,%define (,name ,@formals) + (,%if (,%skip? ,f1 (,%quote ,skip)) + ,f1 + (,%let () ,@body)))))))) - (define (make-player-entity x y width height) - (list #:type 'player - #:x x - #:y y - #:width width - #:height height - #:vx 0 - #:vy 0 - #:gravity? #t - #:on-ground? #f - #:tile-id 29 - #:input-map '((left . (-2 . 0)) - (right . ( 2 . 0)) - (down . ( 0 . 2))))) -) +) ;; End of entity |