Basic visual rendering components (unfinished)

engine/components.scm

@@ -0,0 +1,225 @@
+(module (engine components core) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	(srfi 99))
+
+;; Vector exports
+(export make-vector2 vector2? vector2-x
+	set-vector2-x! vector2-y set-vector2-y!)
+
+;; 2D Vector type
+;; TODO: this could be done with a macro to save some definitions
+(define-record-type <vector2>
+  (int:make-vector2 x y)
+  vector2?
+  (x vector2-x int:set-vector2-x!)
+  (y vector2-y int:set-vector2-y!))
+
+;; Type safe 2D vector constructor
+(define (make-vector2 x y)
+  (assert (number? x))
+  (assert (number? y))
+  (int:make-vector2 x y))
+
+;; Type safe 2D vector setter
+(define (set-vector2-x! vector2 x)
+  (assert (vector2? vector2))
+  (assert (number? x))
+  (int:set-vector2-x! vector2 x))
+
+;; Type safe 2D vector setter
+(define (set-vector2-y! vector2 y)
+  (assert (vector2? vector2))
+  (assert (number? y))
+  (int:set-vector2-y! vector2 y))
+
+;; 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!))
+
+;; 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?)
+
+;; The screen transform is for representing transformations in screen-space, that is
+;; in UI and not in 2D/3D
+(define-record-type <screen-transform>
+  (int:make-screen-transform position pivot rotation scale anchor parent)
+  screen-transform?
+  (position screen-transform-position int:set-screen-transform-position!)
+  (pivot screen-transform-pivot int:set-screen-transform-pivot!)
+  (rotation screen-transform-rotation int:set-screen-transform-rotation!)
+  (scale screen-transform-scale int:set-screen-transform-scale!)
+  (anchor screen-transform-anchor int:set-screen-transform-anchor!)
+  (parent screen-transform-parent int:set-screen-transform-parent!))
+
+;; Type safe constructor
+(define (make-screen-transform position rotation scale anchor parent)
+  (assert (vector2? position))
+  (assert (real? rotation))
+  (assert (Vector2? scale))
+  (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)))
+  (int:make-screen-transform position 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
+;; screen-transform and 2D-transform, with type checking
+(export position set-position! rotation set-rotation! scale set-scale!
+	anchor set-anchor! parent set-parent!)
+
+(define (position component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'position) component))
+
+(define (set-position! component position)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component) (assert (vector2? positon))))
+  ((rtd-mutator (record-rtd component) 'positon) component position))
+
+(define (pivot component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'pivot) component))
+
+(define (set-pivot! component pivot)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component) (assert (vector2? pivot))))
+  ((rtd-mutator (record-rtd component) 'pivot) component pivot))
+
+(define (rotation component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'rotation) component))
+
+(define (set-rotation! component rotation)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component) (assert (real? rotation))))
+  ((rtd-mutator (record-rtd component) 'rotation) component rotation))
+
+(define (scale component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'scale) component))
+
+(define (set-scale! component scale)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component) (assert (vector2? scale))))
+  ((rtd-mutator (record-rtd component) 'scale) component scale))
+
+(define (anchor component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'anchor) component))
+
+(define (set-anchor! component anchor)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component)
+    (assert (and (symbol? anchor)
+		 (member anchor '(top-left top-middle top-right
+					   center-left center center-right
+					   bottom-left bottom-middle bottom-right))))))
+  ((rtd-mutator (record-rtd component) 'anchor) component anchor))
+
+(define (parent component)
+  (assert (record? component))
+  ((rtd-accessor (record-rtd component) 'parent) component))
+
+(define (set-parent! component parent)
+  (assert (record? component))
+  (cond
+   ((screen-transform? component)
+    (assert (symbol? anchor))))
+  ((rtd-mutator (record-rtd component) 'parent) component parent))
+
+;; Visuals
+;; Primitive shape visual types
+(define-record-type <pixel-2d>
+  (int:make-pixel-2d position)
+  pixel-2d?
+  (position pixel-2d-position int:set-pixel-2d-position!))
+
+(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-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!))
+
+;; TODO: might be nicer to have the origin and width/height inside a rect-2d type or similar
+(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-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!))
+
+;; Visual component
+(define-record-type <visual-2d>
+  (int:make-visual-2d draw color layer)
+  visual-2d?
+  (draw visual-2d-draw int:set-visual-2d-draw!) ;; 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!))
+)