Move drawing code to it's own module and simplify draw interface

engine/components.scm

@@ -2,65 +2,12 @@
 (import scheme
 	(chicken base)
 	(chicken module)
+	(engine core)
 	(engine guards)
 	(engine math)
 	(srfi 1)
-	(srfi 4)
 	(srfi 99))
 
-;; Color exports
-(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
-(define-record-type <color>
-  (int:make-color r g b a)
-  color?
-  (r color-r int:set-color-r!)
-  (g color-g int:set-color-g!)
-  (b color-b int:set-color-b!)
-  (a color-a int:set-color-a!))
-
-;; Get a raylib color vec 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)))
-  (assert (and (number? g) (<= 0 g 1)))
-  (assert (and (number? b) (<= 0 b 1)))
-  (assert (and (number? a) (<= 0 a 1)))
-  (int:make-color r g b a))
-
-;; Type safe color setter
-(define (set-color-r! color r)
-  (assert (color? color))
-  (assert (and (number? r) (<= 0 r 1)))
-  (int:set-color-r! color r))
-
-;; Type safe color setter
-(define (set-color-g! color g)
-  (assert (color? color))
-  (assert (and (number? g) (<= 0 g 1)))
-  (int:set-color-g! color g))
-
-;; Type safe color setter
-(define (set-color-b! color b)
-  (assert (color? color))
-  (assert (and (number? b) (<= 0 b 1)))
-  (int:set-color-b! color b))
-
-;; Type safe color setter
-(define (set-color-a! color a)
-  (assert (color? color))
-  (assert (and (number? a) (<= 0 a 1)))
-  (int:set-color-a! color a))
-
 ;; Screen transform record and exports
 (export make-screen-transform screen-transform?)
 
@@ -84,7 +31,7 @@
   (assert (and (symbol? anchor) (member anchor '(top-left top-middle top-right
 							  center-left center center-right
 							  bottom-left bottom-middle bottom-right))))
-  (assert (and (symbol? parent)))
+  (assert (or (null? parent) (screen-transform? parent)))
   (int:make-screen-transform position pivot rotation scale anchor parent))
 
 ;; Generic accessors and mutators for position, rotation, scale, anchor, and parent
@@ -95,7 +42,10 @@
 
 (define (position component)
   (assert (record? component))
-  ((rtd-accessor (record-rtd component) 'position) component))
+  (if (null? (parent component))
+      ((rtd-accessor (record-rtd component) 'position) component)
+      (v+ ((rtd-accessor (record-rtd component) 'position) component)
+	  (position (parent component)))))
 
 (define (set-position! component position)
   (assert (record? component))
@@ -157,149 +107,4 @@
    ((screen-transform? component)
     (assert (symbol? anchor))))
   ((rtd-mutator (record-rtd component) 'parent) component parent))
-
-;; Visuals
-;; Primitive shape visual types
-(export pixel-2d? make-pixel-2d
-	pixel-2d-position set-pixel-2d-position!)
-(define-record-type <pixel-2d>
-  (int:make-pixel-2d position)
-  pixel-2d?
-  (position pixel-2d-position int:set-pixel-2d-position!))
-
-(define (make-pixel-2d position)
-  (assert (vec2? position))
-  (int:make-pixel-2d position))
-
-(define set-pixel-2d-position!
-  (guarded-mutator pixel-2d? 'position vec2?))
-
-(export line-2d? make-line-2d line-2d-start-pos
-	set-line-2d-start-pos! line-2d-end-pos set-line-2d-end-pos!
-	line-2d-thickness set-line-2d-thickness!)
-(define-record-type <line-2d>
-  (int:make-line-2d start-pos end-pos thickness)
-  line-2d?
-  (start-pos line-2d-start-pos int:set-line-2d-start-pos!)
-  (end-pos line-2d-end-pos int:set-line-2d-end-pos!)
-  (thickness line-2d-thickness int:set-line-2d-thickness!))
-
-(define (make-line-2d start-pos end-pos thickness)
-  (assert (vec2? start-pos))
-  (assert (vec2? end-pos))
-  (assert ((conjoin integer? positive?) thickness))
-  (int:make-line-2d start-pos end-pos thickness))
-
-(define set-line-2d-start-pos!
-  (guarded-mutator line-2d? 'start-pos vec2?))
-(define set-line-2d-end-pos!
-  (guarded-mutator line-2d? 'end-pos vec2?))
-(define set-line-2d-thickness!
-  (guarded-mutator line-2d? 'start-pos (conjoin integer? positive?)))
-
-(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!)
-(define-record-type <circle-2d>
-  (int:make-circle-2d center radius filled)
-  circle-2d?
-  (center circle-2d-center int:set-circle-2d-center!)
-  (radius circle-2d-radius int:set-circle-2d-radius!)
-  (filled circle-2d-filled? int:set-circle-2d-filled!))
-
-(define (make-circle-2d center radius filled)
-  (assert (vec2? center))
-  (assert ((conjoin integer? positive?) radius))
-  (assert (boolean? filled))
-  (int:make-circle-2d center radius filled))
-
-(define set-circle-2d-center!
-  (guarded-mutator circle-2d? 'center vec2?))
-(define set-circle-2d-radius!
-  (guarded-mutator circle-2d? 'radius (conjoin integer? positive?)))
-(define set-circle-2d-filled!
-  (guarded-mutator circle-2d? 'filled boolean?))
-
-;; 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?
-	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)
-  rectangle-2d?
-  (origin rectangle-2d-origin int:set-rectangle-2d-origin!)
-  (width rectangle-2d-width int:set-rectangle-2d-width!)
-  (height rectangle-2d-height int:set-rectangle-2d-height!)
-  (filled rectangle-2d-filled? int:set-rectangle-2d-filled!)
-  (thickness rectangle-2d-thickness int:set-rectangle-2d-thickness))
-
-(define (make-rectangle-2d origin width height filled thickness)
-  (assert (vec2? origin))
-  (assert ((conjoin integer? positive?) width))
-  (assert ((conjoin integer? positive?) height))
-  (assert (boolean? filled))
-  (assert ((conjoin integer? positive?) thickness))
-  (int:make-rectangle-2d origin width height filled thickness))
-
-(define set-rectangle-2d-origin!
-  (guarded-mutator rectangle-2d? 'origin vec2?))
-(define set-rectangle-2d-width!
-  (guarded-mutator rectangle-2d? 'width (conjoin integer? positive?)))
-(define set-rectangle-2d-height!
-  (guarded-mutator rectangle-2d? 'height (conjoin integer? positive?)))
-(define set-rectangle-2d-filled!
-  (guarded-mutator rectangle-2d? 'filled boolean?))
-(define set-rectangle-2d-thickness!
-  (guarded-mutator rectangle-2d? 'thickness (conjoin integer? positive?)))
-
-(export triangle-2d? make-triangle-2d triangle-2d-vertex-1
-	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!))
-
-(define (make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
-  (assert (vec2? vertex-1))
-  (assert (vec2? vertex-2))
-  (assert (vec2? vertex-3))
-  (assert (boolean? filled))
-  (int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled))
-
-(define set-triangle-2d-vertex-1!
-  (guarded-mutator triangle-2d? 'vertex-1 vec2?))
-(define set-triangle-2d-vertex-2!
-  (guarded-mutator triangle-2d? 'vertex-2 vec2?))
-(define set-triangle-2d-vertex-3!
-  (guarded-mutator triangle-2d? 'vertex-3 vec2?))
-(define set-triangle-2d-filled!
-  (guarded-mutator triangle-2d? 'filled boolean?))
-
-;; Visual component
-(export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw!
-	visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!)
-(define-record-type <visual-2d>
-  (int:make-visual-2d draw color layer)
-  visual-2d?
-  (draw visual-2d-draw int:set-visual-2d-draw!) ;; NOTE: Typing here: pixel-2d, line-2d, circle-2d, rectangle-2d, triangle-2d etc
-  (color visual-2d-color int:set-visual-2d-color!)
-  (layer visual-2d-layer int:set-visual-2d-layer!))
-
-(define (make-visual-2d draw color layer)
-  (assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
-  (assert (color? color))
-  (assert (integer? layer))
-  (int:make-visual-2d draw color layer))
-
-(define set-visual-2d-draw!
-  (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!
-  (guarded-mutator visual-2d? 'layer integer?))
 )

engine/drawing.scm

@@ -0,0 +1,230 @@
+(module (engine drawing) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	raylib
+	(engine guards)
+	(engine math)
+	(srfi 4)
+	(srfi 99))
+
+;; Color exports
+(export make-color color-r color-g color-b color-a
+	set-color-r! set-color-g! set-color-b! set-color-a!)
+
+;; Color type
+(define-record-type <color>
+  (int:make-color r g b a)
+  color?
+  (r color-r int:set-color-r!)
+  (g color-g int:set-color-g!)
+  (b color-b int:set-color-b!)
+  (a color-a int:set-color-a!))
+
+;; Get a raylib color vec 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)))
+  (assert (and (number? g) (<= 0 g 1)))
+  (assert (and (number? b) (<= 0 b 1)))
+  (assert (and (number? a) (<= 0 a 1)))
+  (int:make-color r g b a))
+
+;; Type safe color setter
+(define (set-color-r! color r)
+  (assert (color? color))
+  (assert (and (number? r) (<= 0 r 1)))
+  (int:set-color-r! color r))
+
+;; Type safe color setter
+(define (set-color-g! color g)
+  (assert (color? color))
+  (assert (and (number? g) (<= 0 g 1)))
+  (int:set-color-g! color g))
+
+;; Type safe color setter
+(define (set-color-b! color b)
+  (assert (color? color))
+  (assert (and (number? b) (<= 0 b 1)))
+  (int:set-color-b! color b))
+
+;; Type safe color setter
+(define (set-color-a! color a)
+  (assert (color? color))
+  (assert (and (number? a) (<= 0 a 1)))
+  (int:set-color-a! color a))
+
+
+;; Visuals
+;; Primitive shape visual types
+;; Pixel
+(export pixel-2d? make-pixel-2d
+	pixel-2d-position set-pixel-2d-position!)
+(define-record-type <pixel-2d>
+  (int:make-pixel-2d position)
+  pixel-2d?
+  (position pixel-2d-position int:set-pixel-2d-position!))
+
+(define (make-pixel-2d position)
+  (assert (vec2? position))
+  (int:make-pixel-2d position))
+
+(define set-pixel-2d-position!
+  (guarded-mutator pixel-2d? 'position vec2?))
+
+;; Line2D
+(export line-2d? make-line-2d line-2d-start-pos
+	set-line-2d-start-pos! line-2d-end-pos set-line-2d-end-pos!
+	line-2d-thickness set-line-2d-thickness!)
+(define-record-type <line-2d>
+  (int:make-line-2d start-pos end-pos thickness)
+  line-2d?
+  (start-pos line-2d-start-pos int:set-line-2d-start-pos!)
+  (end-pos line-2d-end-pos int:set-line-2d-end-pos!)
+  (thickness line-2d-thickness int:set-line-2d-thickness!))
+
+(define (make-line-2d start-pos end-pos thickness)
+  (assert (vec2? start-pos))
+  (assert (vec2? end-pos))
+  (assert ((conjoin integer? positive?) thickness))
+  (int:make-line-2d start-pos end-pos thickness))
+
+(define set-line-2d-start-pos!
+  (guarded-mutator line-2d? 'start-pos vec2?))
+(define set-line-2d-end-pos!
+  (guarded-mutator line-2d? 'end-pos vec2?))
+(define set-line-2d-thickness!
+  (guarded-mutator line-2d? 'start-pos (conjoin integer? positive?)))
+
+;; Circle2D
+(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!)
+(define-record-type <circle-2d>
+  (int:make-circle-2d center radius filled)
+  circle-2d?
+  (center circle-2d-center int:set-circle-2d-center!)
+  (radius circle-2d-radius int:set-circle-2d-radius!)
+  (filled circle-2d-filled? int:set-circle-2d-filled!))
+
+(define (make-circle-2d center radius filled)
+  (assert (vec2? center))
+  (assert ((conjoin integer? positive?) radius))
+  (assert (boolean? filled))
+  (int:make-circle-2d center radius filled))
+
+(define set-circle-2d-center!
+  (guarded-mutator circle-2d? 'center vec2?))
+(define set-circle-2d-radius!
+  (guarded-mutator circle-2d? 'radius (conjoin integer? positive?)))
+(define set-circle-2d-filled!
+  (guarded-mutator circle-2d? 'filled boolean?))
+
+;; Rectangle2D
+;; 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?
+	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)
+  rectangle-2d?
+  (origin rectangle-2d-origin int:set-rectangle-2d-origin!)
+  (width rectangle-2d-width int:set-rectangle-2d-width!)
+  (height rectangle-2d-height int:set-rectangle-2d-height!)
+  (filled rectangle-2d-filled? int:set-rectangle-2d-filled!)
+  (thickness rectangle-2d-thickness int:set-rectangle-2d-thickness))
+
+(define (make-rectangle-2d origin width height filled thickness)
+  (assert (vec2? origin))
+  (assert ((conjoin integer? positive?) width))
+  (assert ((conjoin integer? positive?) height))
+  (assert (boolean? filled))
+  (assert ((conjoin integer? positive?) thickness))
+  (int:make-rectangle-2d origin width height filled thickness))
+
+(define set-rectangle-2d-origin!
+  (guarded-mutator rectangle-2d? 'origin vec2?))
+(define set-rectangle-2d-width!
+  (guarded-mutator rectangle-2d? 'width (conjoin integer? positive?)))
+(define set-rectangle-2d-height!
+  (guarded-mutator rectangle-2d? 'height (conjoin integer? positive?)))
+(define set-rectangle-2d-filled!
+  (guarded-mutator rectangle-2d? 'filled boolean?))
+(define set-rectangle-2d-thickness!
+  (guarded-mutator rectangle-2d? 'thickness (conjoin integer? positive?)))
+
+;; Triangle2D
+(export triangle-2d? make-triangle-2d triangle-2d-vertex-1
+	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!))
+
+(define (make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
+  (assert (vec2? vertex-1))
+  (assert (vec2? vertex-2))
+  (assert (vec2? vertex-3))
+  (assert (boolean? filled))
+  (int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled))
+
+(define set-triangle-2d-vertex-1!
+  (guarded-mutator triangle-2d? 'vertex-1 vec2?))
+(define set-triangle-2d-vertex-2!
+  (guarded-mutator triangle-2d? 'vertex-2 vec2?))
+(define set-triangle-2d-vertex-3!
+  (guarded-mutator triangle-2d? 'vertex-3 vec2?))
+(define set-triangle-2d-filled!
+  (guarded-mutator triangle-2d? 'filled boolean?))
+
+;; Visual component
+(export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw!
+	visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!)
+(define-record-type <visual-2d>
+  (int:make-visual-2d draw color layer)
+  visual-2d?
+  (draw visual-2d-draw int:set-visual-2d-draw!) ;; NOTE: Typing here: pixel-2d, line-2d, circle-2d, rectangle-2d, triangle-2d etc
+  (color visual-2d-color int:set-visual-2d-color!)
+  (layer visual-2d-layer int:set-visual-2d-layer!))
+
+(define (make-visual-2d draw color layer)
+  (assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
+  (assert (color? color))
+  (assert (integer? layer))
+  (int:make-visual-2d draw color layer))
+
+(define set-visual-2d-draw!
+  (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!
+  (guarded-mutator visual-2d? 'layer integer?))
+
+;; Drawing functions
+;; Helper wrappers for raylib functions
+(export draw-circle-2d)
+(define (draw-circle-2d pos-vec radius color filled)
+  (assert (vec2? pos-vec))
+  (assert (number? radius))
+  (assert (color? color))
+  (assert (boolean? filled))
+  ((if filled
+       draw-circle
+       draw-circle-2d)
+   (number->integer (v-x pos-vec))
+   (number->integer (v-y pos-vec))
+   (number->integer radius)
+   (use-color color)))
+)

engine/math.scm

@@ -27,6 +27,12 @@
 (define (approx-= x y)
   (< (abs (- x y)) (*float-precision*)))
 
+;; Somewhat reliable fixnum conversion
+(export number->integer)
+(define (number->integer number)
+  (assert (number? number))
+  (inexact->exact (round number)))
+
 ;; Vector exports
 (export vec vec? vec2? v-x
 	set-v-x! v-y set-v-y!)

samples/bounce.scm

@@ -5,6 +5,7 @@
 	(engine core)
 	(engine components core)
 	(engine math)
+	(engine drawing)
 	(srfi 1)
 	(srfi 99))
 
@@ -26,13 +27,11 @@
 					(lambda ()
 					  (let ((draw-pos (v+ (position transform)
 							      (circle-2d-center circle))))
-					    ((if (circle-2d-filled? circle)
+					    (draw-circle-2d
-						 draw-circle
+					     draw-pos
-						 draw-circle-lines)
-					     (v-x draw-pos)
-					     (v-y draw-pos)
 					     (circle-2d-radius circle)
-					     (visual-2d-color vis-2d))))))))))
+					     (visual-2d-color vis-2d)
+					     (circle-2d-filled? circle))))))))))
 
 
 (define-record-type <rigidbody-2d>