engine/core.scm

@@ -162,7 +162,7 @@
 (define (make-system name priority mode criteria process)
   (assert (symbol? name))
   (assert (integer? priority))
-  (assert (member mode '(entity batch global)))
+  (assert (member mode '(entity batch)))
   (assert (every symbol? criteria))
   (assert (procedure? process))
   (int:make-system name priority mode criteria process))
@@ -266,12 +266,10 @@
 ;; Execute a single system
 (define (execute-system system)
   (assert (system? system))
-  (if (eqv? (system-mode system) 'global)
-      ((system-process system))
   (let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
     (cond 
      ((eqv? (system-mode system) 'batch) ((system-process system) entities))
-	 ((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities))))))
+     ((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities)))))
 
 (define (execute-systems)
   (for-each

samples/bounce.scm

@@ -4,14 +4,11 @@
 	raylib
 	(engine core)
 	(engine components core)
-	(srfi 1)
+	(srfi 1))
-	(srfi 99))
 
 (*window-title* "Bounce!")
 (*target-fps* 60)
 
-(define +ball-radius+ 50)
-
 (add-system
  (make-system 'draw-circles
 	      0
@@ -28,125 +25,19 @@
 					    ((if (circle-2d-filled? circle)
 						 draw-circle
 						 draw-circle-lines)
-					     (inexact->exact (round (+ (vector-x (position transform))
+					     (+ (vector-x (position transform))
-								       (vector-x (circle-2d-center circle)))))
+						(vector-x (circle-2d-center circle)))
-					     (inexact->exact (round (+ (vector-y (position transform))
+					     (+ (vector-y (position transform))
-								       (vector-y (circle-2d-center circle)))))
+						(vector-y (circle-2d-center circle)))
 					     (circle-2d-radius circle)
 					     (use-color (visual-2d-color vis-2d)))))))))))
 
 
-(define-record-type <rigidbody-2d>
-  (make-rigidbody-2d velocity)
-  rigidbody-2d?
-  (velocity rigidbody-2d-velocity set-rigidbody-2d-velocity!))
-
-(define +gravity+ (make-vector2 0 9.8))
-(define +friction+ -0.1)
-
-(add-system
- (make-system 'apply-gravity
-	      0
-	      'entity
-	      '(<rigidbody-2d>)
-	      (lambda (body)
-		(let ((rbody (find rigidbody-2d? body)))
-		  (set-rigidbody-2d-velocity! rbody
-					      (vector-+ (rigidbody-2d-velocity rbody)
-							(vector-*
-							 (make-vector2 (get-frame-time)
-								       (get-frame-time))
-							 +gravity+)))))))
-
-(add-system
- (make-system 'apply-bounce
-	      1
-	      'entity
-	      '(<rigidbody-2d> <screen-transform>)
-	      (lambda (ball)
-		(let ((rbody (find rigidbody-2d? ball))
-		      (transform (find screen-transform? ball)))
-		  (when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
-		    (set-rigidbody-2d-velocity! rbody
-						(make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody))))))))))
-
-(add-system
- (make-system 'apply-wall-bounce
-	      1
-	      'entity
-	      '(<rigidbody-2d> <screen-transform>)
-	      (lambda (ball)
-		(let ((rbody (find rigidbody-2d? ball))
-		      (transform (find screen-transform? ball)))
-		  (when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+))
-			    (< (vector-x (position transform)) (+ 0 +ball-radius+)))
-		    (set-rigidbody-2d-velocity! rbody
-						(make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody)))))))))
-
-(add-system
- (make-system 'apply-friction
-	      2
-	      'entity
-	      '(<rigidbody-2d>)
-	      (lambda (ball)
-		(let ((rbody (find rigidbody-2d? ball)))
-		  (set-rigidbody-2d-velocity! rbody
-					      (vector-+ (rigidbody-2d-velocity rbody)
-							(vector-*
-							 (make-vector2 (* (get-frame-time) +friction+) (* (get-frame-time) +friction+))
-							 (rigidbody-2d-velocity rbody))))))))
-
-(add-system
- (make-system 'move-rigidbody
-	      3
-	      'entity
-	      '(<rigidbody-2d> <screen-transform>)
-	      (lambda (ball)
-		(let ((rbody (find rigidbody-2d? ball))
-		      (transform (find screen-transform? ball)))
-		  (set-position! transform
-				 (vector-+ (rigidbody-2d-velocity rbody)
-					   (position transform)))))))
-
-(define-record-type <key-press>
-  (make-key-press key)
-  key-press?
-  (key key-press-key))
-
-(add-system
- (make-system 'input
-	      0
-	      'global
-	      '()
-	      (lambda ()
-		(when (key-pressed? KEY_SPACE)
-		  (push-event 'input 'boost (make-key-press 'space))))))
-
-(add-system
- (make-system 'boost-rigidbody
-	      2
-	      'entity
-	      '(<rigidbody-2d>)
-	      (lambda (ball)
-		(let ((rbody (find rigidbody-2d? ball)))
-		  (when (peek-event 'input 'boost)
-		    (set-rigidbody-2d-velocity! rbody
-						(vector-* (make-vector2 2 2)
-							  (rigidbody-2d-velocity rbody))))))))
-
-(add-system
- (make-system 'clear-boost-input
-	      10
-	      'global
-	      '()
-	      (lambda ()
-		(pop-event 'input 'boost))))
-
 (create-entity
  (make-visual-2d
   (make-circle-2d
    (make-vector2 0 0)
-   +ball-radius+
+   50
    #t)
   (make-color 0 0 1 1)
   0)
@@ -156,42 +47,7 @@
   0
   (make-vector2 1 1)
   'center
-  'none)
+  'none))
- (make-rigidbody-2d (make-vector2 5 1)))
-
-(create-entity
- (make-visual-2d
-  (make-circle-2d
-   (make-vector2 0 0)
-   +ball-radius+
-   #t)
-  (make-color 0 1 0 1)
-  0)
- (make-screen-transform
-  (make-vector2 100 100)
-  (make-vector2 0 0)
-  0
-  (make-vector2 1 1)
-  'center
-  'none)
- (make-rigidbody-2d (make-vector2 -2 -2)))
-
-(create-entity
- (make-visual-2d
-  (make-circle-2d
-   (make-vector2 0 0)
-   +ball-radius+
-   #t)
-  (make-color 1 0 0 1)
-  0)
- (make-screen-transform
-  (make-vector2 100 100)
-  (make-vector2 0 0)
-  0
-  (make-vector2 1 1)
-  'center
-  'none)
- (make-rigidbody-2d (make-vector2 10 -5)))
 
 (create-window)
 )