(module (engine components core) ()
(import scheme
	(chicken base)
	(chicken module)
	(engine core)
	(engine guards)
	(engine math)
	(srfi 1)
	(srfi 99))

;; 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 pivot rotation scale anchor parent)
  (assert (vec2? position))
  (assert (real? rotation))
  (assert (vec2? 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 (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
;; 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))
  (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))
  (cond
   ((screen-transform? component) (assert (vec2? position))))
  ((rtd-mutator (record-rtd component) 'position) 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 (vec2? 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 (vec2? 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))
)