samples/bounce.scm

@@ -39,7 +39,7 @@
   rigidbody-2d?
   (velocity rigidbody-2d-velocity set-rigidbody-2d-velocity!))
 
-(define +gravity+ (make-vector 0 9.8))
+(define +gravity+ (vector 0 9.8))
 (define +friction+ -0.1)
 
 (add-system
@@ -62,7 +62,7 @@
 		(when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
 		  (set-rigidbody-2d-velocity! rbody
 					      (v* (rigidbody-2d-velocity rbody)
-						  (make-vector 1 -1)))))))
+						  (vector 1 -1)))))))
 
 (add-system
  (make-system 'apply-wall-bounce
@@ -74,7 +74,7 @@
 			  (< (vector-x (position transform)) (+ 0 +ball-radius+)))
 		  (set-rigidbody-2d-velocity! rbody
 					      (v* (rigidbody-2d-velocity rbody)
-						  (make-vector -1 1)))))))
+						  (vector -1 1)))))))
 
 (add-system
  (make-system 'apply-friction
@@ -111,56 +111,35 @@
 					      (v* 2
 						  (rigidbody-2d-velocity rbody)))))))
 
-(create-entity
+(define (make-ball position velocity color)
+  (create-entity
    (make-visual-2d
     (make-circle-2d
-   (make-vector 0 0)
+     (vector 0 0)
      +ball-radius+
      #t)
-  (make-color 0 0 1 1)
+    color
     0)
    (make-screen-transform
-  (make-vector 100 100)
-  (make-vector 0 0)
+    position
+    (vector 0 0)
     0
-  (make-vector 1 1)
+    (vector 1 1)
     'center
     'none)
- (make-rigidbody-2d (make-vector 5 1)))
+   (make-rigidbody-2d velocity)))
 
-(create-entity
- (make-visual-2d
-  (make-circle-2d
-   (make-vector 0 0)
-   +ball-radius+
-   #t)
-  (make-color 0 1 0 1)
-  0)
- (make-screen-transform
-  (make-vector 100 100)
-  (make-vector 0 0)
-  0
-  (make-vector 1 1)
-  'center
-  'none)
- (make-rigidbody-2d (make-vector -2 -2)))
+(make-ball (vector 100 100)
+	   (vector 5 1)
+	   (make-color 0 0 1 1))
 
-(create-entity
- (make-visual-2d
-  (make-circle-2d
-   (make-vector 0 0)
-   +ball-radius+
-   #t)
-  (make-color 1 0 0 1)
-  0)
- (make-screen-transform
-  (make-vector 100 100)
-  (make-vector 0 0)
-  0
-  (make-vector 1 1)
-  'center
-  'none)
- (make-rigidbody-2d (make-vector 10 -5)))
+(make-ball (vector 300 300)
+	   (vector -2 -2)
+	   (make-color 0 1 0 1))
+
+(make-ball (vector 600 600)
+	   (vector -2 -2)
+	   (make-color 1 0 0 1))
 
 (create-window)
 )