#!r6rs
; main thing i'd like to do is be compatible with these:
; https://www.mzrg.com/mines/msx/index.html
; let's do about the minimum to do what i want

(load-shared-object "libraylib.so")

; color
(define-ftype Color
  (struct
    [r unsigned-8]
    [g unsigned-8]
    [b unsigned-8]
    [a unsigned-8]))

(define (set-color-r! color r) (ftype-set! Color (r) color r))
(define (set-color-g! color g) (ftype-set! Color (g) color g))
(define (set-color-b! color b) (ftype-set! Color (b) color b))
(define (set-color-a! color a) (ftype-set! Color (a) color a))

(define (color-r color) (ftype-ref Color (r) color))
(define (color-g color) (ftype-ref Color (g) color))
(define (color-b color) (ftype-ref Color (b) color))
(define (color-a color) (ftype-ref Color (a) color))

(define (color-components c) (list (color-r c) (color-g c) (color-b c) (color-a c)))

(define color
  (case-lambda
    [(r g b) (color r g b 255)]
    [(r g b a)
     (define c (make-ftype-pointer Color (foreign-alloc (ftype-sizeof Color))))
     (set-color-r! c r)
     (set-color-g! c g)
     (set-color-b! c b)
     (set-color-a! c a)
     c]))

;; (define c (color 1 2 3 4))
;; (display (list (color-r c) (color-g c) (color-b c) (color-a c)))

; window
(define init-window
  (foreign-procedure #f "InitWindow" (int int string) void))

(define close-window
  (foreign-procedure #f "CloseWindow" () void))

(define window-should-close?
  (foreign-procedure #f "WindowShouldClose" () boolean))

; drawing
(define clear-background
  (foreign-procedure #f "ClearBackground" ((& Color)) void))

(define begin-drawing
  (foreign-procedure #f "BeginDrawing" () void))

(define end-drawing
  (foreign-procedure #f "EndDrawing" () void))

; timing
(define set-target-fps
  (foreign-procedure #f "SetTargetFPS" (int) void))

(define get-frame-time
  (foreign-procedure #f "GetFrameTime" () float))

(define get-time
  (foreign-procedure #f "GetTime" () double))

(define get-fps
  (foreign-procedure #f "GetFPS" () int))

; text

(define draw-fps
  (foreign-procedure #f "DrawFPS" (int int) void))

(define draw-text
  (foreign-procedure #f "DrawText" (string int int int (& Color)) void))

; texture

(define-ftype Image
  (struct
    [data    void*]
    [width   int]
    [height  int]
    [mipmaps int]
    [format  int]))

(define load-image
  (foreign-procedure #f "LoadImage" (string) (& Image)))

; scheme magicks

(define-syntax with-draw
  (syntax-rules ()
    [(_ body ...)
     (begin (begin-drawing)
	    body ...
	    (end-drawing))]))

(define-syntax while
  (syntax-rules ()
    [(_ test body ...)
     (do []
	 [(not test) #f]
       body ...)]))

(define-syntax until
  (syntax-rules ()
    [(_ test body ...)
     (do []
	 [test #f]
       body ...)]))

; my stuff :]

(define (main)
  (init-window 100 100 "hello")
  (set-target-fps 120)

  (until (window-should-close?)
	 (with-draw
	  (clear-background (color 245 245 245 255))
	  (draw-fps 0 0)
	  (draw-text "wow awesome" 0 20 20 (color 0 0 0))))

  (close-window))

(main)