From: Javier Sancho Date: Sun, 19 Aug 2012 19:15:50 +0000 (+0200) Subject: Extensions for main loop (meshes, controllers, etc) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=31270934f62a3dbaefdf717d559195016e3385d0;p=gacela.git Extensions for main loop (meshes, controllers, etc) --- diff --git a/src/gacela.scm b/src/gacela.scm index 70ac867..90e8581 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -118,7 +118,7 @@ (to-origin) (refresh-active-mobs) (run-mobs) - (draw-meshes) + (run-extensions) (flip-screen) (delay-frame)))) (quit-video)) @@ -130,6 +130,26 @@ loop-flag) +;;; Extensions to main loop + +(define extensions '()) + +(define (add-extension! proc pri) + "Add an extension with a priority to the main loop" + (set! extensions + (sort (assoc-set! extensions proc pri) + (lambda (a b) + (< (cdr a) (cdr b)))))) + +(define (remove-extension! proc) + "Remove an extension from the main loop" + (set! extensions + (assoc-remove! extensions proc))) + +(define (run-extensions) + (for-each (lambda (x) ((car x))) extensions)) + + ;;; Game Properties (define *title* "Gacela") @@ -338,18 +358,6 @@ ,@body)) -;;; Views Factory - -(define default-view (make-hash-table)) - -(define* (draw-meshes #:optional (meshes (hash-map->list (lambda (k v) v) default-view))) - (cond ((not (null? meshes)) - (catch #t - (lambda () ((car meshes) 'draw)) - (lambda (key . args) #f)) - (draw-meshes (cdr meshes))))) - - (module-map (lambda (sym var) (if (not (eq? sym '%module-public-interface)) (module-export! (current-module) (list sym)))) diff --git a/src/views.scm b/src/views.scm index 9aa3006..f8e93e2 100644 --- a/src/views.scm +++ b/src/views.scm @@ -21,6 +21,18 @@ #:use-module ((gacela gl) #:select (glPushMatrix glPopMatrix)) #:use-module (ice-9 optargs)) + +(define default-view (make-hash-table)) + +(define* (draw-meshes #:optional (meshes (hash-map->list (lambda (k v) v) default-view))) + (cond ((not (null? meshes)) + (catch #t + (lambda () (mesh-draw (car meshes))) + (lambda (key . args) #f)) + (draw-meshes (cdr meshes))))) + +(add-extension! draw-meshes 50) + (define-macro (define-view name content) `(begin (hash-set! active-views ',name (lambda () (video:glmatrix-block ,content))) @@ -86,13 +98,20 @@ "property-set!" (set! properties (assoc-set! properties prop-name value)))))))) -(define mesh-properties-set! - (let ((f (record-accessor mesh-type 'properties-set!))) - (lambda (mesh new-properties) - ((f mesh) new-properties)))) +(define (mesh-draw mesh) + (((record-accessor mesh-type 'draw) mesh))) + +(define (mesh-inner-property mesh prop-name) + (((record-accessor mesh-type 'inner-property) mesh) prop-name)) + +(define (mesh-properties mesh) + (((record-accessor mesh-type 'properties) mesh))) + +(define (mesh-properties-set! mesh new-properties) + (((record-accessor mesh-type 'properties-set!) mesh) new-properties)) (define* (show mesh #:optional (view default-view)) - (let ((id (mesh 'inner-property 'id))) + (let ((id (mesh-inner-property mesh 'id))) (if (not (hash-ref view id)) (hash-set! view id mesh))))