(module (imugi drawing) ()
(import scheme
	(chicken base)
	(chicken module)
	raylib
	(imugi core)
	(imugi guards)
	(imugi 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?))

;; 2D text drawing
(export text-2d? make-text-2d text-2d-position set-text-2d-position!
	text-2d-text set-text-2d-text! text-2d-size set-text-2d-size!)
(define-record-type <text-2d>
  (int:make-text-2d position text size)
  text-2d?
  (position text-2d-position int:set-text-2d-position!)
  (text text-2d-text int:set-text-2d-text!)
  (size text-2d-size int:set-text-2d-size!))

(define (make-text-2d position text size)
  (assert (vec2? position))
  (assert (string? text))
  (assert ((conjoin integer? positive?) size))
  (int:make-text-2d position text size))

(define set-text-2d-position!
  (guarded-mutator text-2d? 'position vec2?))
(define set-text-2d-text!
  (guarded-mutator text-2d? 'text string?))
(define set-text-2d-size!
  (guarded-mutator text-2d? 'size (conjoin integer? positive?)))

;; 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 text-2d? 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 text-2d? 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 draw-rectangle-2d draw-text-2d draw-texture-2d draw-font-text-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-lines)
   (number->integer (v-x pos-vec))
   (number->integer (v-y pos-vec))
   (number->integer radius)
   (use-color color)))

(define (draw-rectangle-2d pos-vec width height color filled thickness)
  (assert (vec2? pos-vec))
  (assert ((conjoin integer? positive?) width))
  (assert ((conjoin integer? positive?) height))
  (assert ((conjoin integer? positive?) thickness))
  (assert (boolean? filled))
  (assert (color? color))
  (if filled
      (draw-rectangle
       (number->integer (v-x pos-vec))
       (number->integer (v-y pos-vec))
       width
       height
       (use-color color))
      (draw-rectangle-lines
       (number->integer (v-x pos-vec))
       (number->integer (v-y pos-vec))
       width
       height
       (use-color color))))

(define (draw-text-2d pos-vec text size tint)
  (assert (vec2? pos-vec))
  (assert (string? text))
  (assert ((conjoin integer? positive?) size))
  (assert (color? tint))
  (draw-text text
	     (number->integer (v-x pos-vec))
	     (number->integer (v-y pos-vec))
	     size
	     (use-color tint)))

(define (draw-font-text-2d pos-vec text size tint font)
  (assert (vec2? pos-vec))
  (assert (string? text))
  (assert (resource? font))
  (assert (eqv? 'font (resource-type font)))
  (assert ((conjoin integer? positive?) size))
  (assert (color? tint))
  (when (resource-initialized? font)
    (draw-text-ex
     (resource-contents font)
     text
     (make-vec2 (number->integer (v-x pos-vec))
		(number->integer (v-y pos-vec)))
     size
     1
     (use-color tint))))

(define (draw-texture-2d pos-vec texture color)
  (assert (vec2? pos-vec))
  (assert (resource? texture))
  (assert (eqv? 'texture (resource-type texture)))
  (assert (color? color))
  (when (resource-initialized? texture)
    (draw-texture (resource-contents texture)
		  (number->integer (v-x pos-vec))
		  (number->integer (v-y pos-vec))
		  (use-color color))))
)