Systems, bug fixes, and first samples

engine/components.scm

@@ -2,12 +2,14 @@
 (import scheme
 	(chicken base)
 	(chicken module)
+	(engine guards)
 	(srfi 1)
+	(srfi 4)
 	(srfi 99))
 
 ;; Vector exports
-(export make-vector2 vector2? vector2-x
-	set-vector2-x! vector2-y set-vector2-y!)
+(export make-vector2 vector2? vector-x
+	set-vector-x! vector-y set-vector-y!)
 
 ;; 2D Vector type
 ;; TODO: this could be done with a macro to save some definitions
@@ -162,7 +164,7 @@
 		       magnitude))))))
 
 ;; Color exports
-(export make-color color-r color-g color-b color-a
+(export make-color use-color color-r color-g color-b color-a
 	set-color-r! set-color-g! set-color-b! set-color-a!)
 
 ;; Color type
@@ -174,6 +176,14 @@
   (b color-b int:set-color-b!)
   (a color-a int:set-color-a!))
 
+;; Get a raylib color vector from a color
+(define (use-color col)
+  (assert (color? col))
+  (u8vector (floor (* 255 (color-r col)))
+	    (floor (* 255 (color-g col)))
+	    (floor (* 255 (color-b col)))
+	    (floor (* 255 (color-a col)))))
+
 ;; Type safe color constructor
 (define (make-color r g b a)
   (assert (and (number? r) (<= 0 r 1)))
@@ -222,7 +232,7 @@
   (parent screen-transform-parent int:set-screen-transform-parent!))
 
 ;; Type safe constructor
-(define (make-screen-transform position rotation scale anchor parent)
+(define (make-screen-transform position pivot rotation scale anchor parent)
   (assert (vector2? position))
   (assert (real? rotation))
   (assert (vector2? scale))
@@ -230,7 +240,7 @@
 							  center-left center center-right
 							  bottom-left bottom-middle bottom-right))))
   (assert (and (symbol? parent)))
-  (int:make-screen-transform position rotation scale anchor parent))
+  (int:make-screen-transform position pivot rotation scale anchor parent))
 
 ;; Generic accessors and mutators for position, rotation, scale, anchor, and parent
 ;; This allows us to abstract across different transform types - (position) will work for
@@ -344,7 +354,7 @@
 
 (export circle-2d? make-circle-2d circle-2d-center
 	set-circle-2d-center! circle-2d-radius set-circle-2d-radius!
-	circle-2d-filled set-circle-2d-filled!)
+	circle-2d-filled? set-circle-2d-filled!)
 (define-record-type <circle-2d>
   (int:make-circle-2d center radius filled)
   circle-2d?
@@ -368,7 +378,7 @@
 ;; TODO: might be nicer to have the origin and width/height inside a rect-2d type or similar
 (export rectangle-2d? make-rectangle-2d rectangle-2d-origin
 	set-rectangle-2d-origin! rectangle-2d-width set-rectangle-2d-width!
-	rectangle-2d-height set-rectangle-2d-height! rectangle-2d-filled
+	rectangle-2d-height set-rectangle-2d-height! rectangle-2d-filled?
 	set-rectangle-2d-filled! rectangle-2d-thickness set-rectangle-2d-thickness!)
 (define-record-type <rectangle-2d>
   (int:make-rectangle-2d origin width height filled thickness)
@@ -399,15 +409,15 @@
   (guarded-mutator rectangle-2d? 'thickness (conjoin integer? positive?)))
 
 (export triangle-2d? make-triangle-2d triangle-2d-vertex-1
-	triangle-2d-set-vertex-1! triangle-2d-vertex-2 triangle-2d-set-vertex-2!
-	triangle-2d-vertex-3 triangle-2d-set-vertex-3! triangle-2d-filled set-triangle-2d-filled!)
+	set-triangle-2d-vertex-1! triangle-2d-vertex-2 set-triangle-2d-vertex-2!
+	triangle-2d-vertex-3 set-triangle-2d-vertex-3! triangle-2d-filled? set-triangle-2d-filled!)
 (define-record-type <triangle-2d>
   (int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
   triangle-2d?
   (vertex-1 triangle-2d-vertex-1 int:set-triangle-2d-vertex-1!)
   (vertex-2 triangle-2d-vertex-2 int:set-triangle-2d-vertex-2!)
   (vertex-3 triangle-2d-vertex-3 int:set-triangle-2d-vertex-3!)
-  (filled triangle-2d-filled int:set-triangle-2d-filled!))
+  (filled triangle-2d-filled? int:set-triangle-2d-filled!))
 
 (define (make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
   (assert (vector2? vertex-1))
@@ -422,7 +432,7 @@
   (guarded-mutator triangle-2d? 'vertex-2 vector2?))
 (define set-triangle-2d-vertex-3!
   (guarded-mutator triangle-2d? 'vertex-3 vector2?))
-(define set-triangle-2d-vertex-filled!
+(define set-triangle-2d-filled!
   (guarded-mutator triangle-2d? 'filled boolean?))
 
 ;; Visual component
@@ -436,12 +446,13 @@
   (layer visual-2d-layer int:set-visual-2d-layer!))
 
 (define (make-visual-2d draw color layer)
-  (assert ((conjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
+  (assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
   (assert (color? color))
-  (assert (integer? layer)))
+  (assert (integer? layer))
+  (int:make-visual-2d draw color layer))
 
 (define set-visual-2d-draw!
-  (guarded-mutator visual-2d? 'draw (conjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
+  (guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
 (define set-visual-2d-color!
   (guarded-mutator visual-2d? 'color color?))
 (define set-visual-2d-layer!