(define spite-inited? #f)
(define started? #f)
(define exit? #f)
(define scale-x 1.0)
(define scale-y 1.0)
(define events '())
(define current-bitmap-font #f)
(define current-line-size 1)
(define draw-color-r 0)
(define draw-color-g 0)
(define draw-color-b 0)
(define draw-color-a 255)
(define window* #f)
(define renderer* #f)
(define event* (make-c-bytevector 4000))
(define draw-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
(define draw-slice-rect* (make-c-bytevector (* (c-type-size 'int) 4)))
(define fill-triangle-vertex-size 1024
  ;; FIXME
  ;(+ (* (c-type-size 'int) 6) (* (c-type-size 'float) 2))
  )
(define fill-triangle-vertex1* (make-c-bytevector fill-triangle-vertex-size 0))
(define fill-triangle-vertex2* (make-c-bytevector fill-triangle-vertex-size 0))
(define fill-triangle-vertex3* (make-c-bytevector fill-triangle-vertex-size 0))
(define fill-triangle-vertexes* (make-c-bytevector (* fill-triangle-vertex-size 3 0)))

(define main-loop-start-time 0)
(define delta-time 0)
(define (main-loop update-procedure draw-procedure)
  (set! main-loop-start-time (SDL_GetTicks))
  (sdl2-events-get)
  (update-procedure main-loop-start-time delta-time (poll-events!))
  (render-clear)
  (draw-procedure)
  (render-present)
  (set! delta-time (- (SDL_GetTicks) main-loop-start-time))
  (unless exit? (main-loop update-procedure draw-procedure)))

(define sdl2-event->spite-event
  (lambda (event)
    (let ((type (c-bytevector-ref event 'int 0)))
      (cond
        ((= type 256)
         (let ((type 'quit))
           (list (cons 'type type))))
        ((or (= type 768) (= type 769))
         (let*
           ((type (if (= type 768) 'key-down 'key-up))
            (scancode (c-bytevector-ref event
                                        'int
                                        (+ (* (c-type-size 'int) 3)
                                           (* (c-type-size 'u8) 4))))
            (keycode (SDL_GetKeyFromScancode scancode))
            (key (c-bytevector->string (SDL_GetKeyName keycode)))
            (repeat? (= (c-bytevector-ref
                          event
                          'u8
                          (+ (* (c-type-size 'int) 3)
                             (c-type-size 'u8)))
                        1)))
           (list (cons 'type type)
                 (cons 'key key)
                 (cons 'scancode scancode)
                 (cons 'repeat? repeat?))))
        ((= type 1024)
         (let ((type 'mouse-motion)
               (x (c-bytevector-ref event
                                    'int
                                    (+ (* (c-type-size 'int) 5))
                                    ))
               (y (c-bytevector-ref event
                                    'int
                                    (+ (* (c-type-size 'int) 6)))))
           (list (cons 'type type)
                 (cons 'x x)
                 (cons 'y y))))
        ((or (= type 1025) (= type 1026))
         (let ((type (if (= type 1025) 'mouse-button-down 'mouse-button-up))
               (x (c-bytevector-ref event
                                    'int
                                    (+ (* (c-type-size 'int) 4)
                                       (* (c-type-size 'u8) 4))))
               (y (c-bytevector-ref event
                                    'int
                                    (+ (* (c-type-size 'int) 4)
                                       (* (c-type-size 'u8) 4)
                                       (c-type-size 'int))))
               (button (c-bytevector-ref event
                                         'int
                                         (+ (* (c-type-size 'u32) 4))))
               (clicks (c-bytevector-ref event
                                         'int
                                         (+ (* (c-type-size 'u32) 4)
                                            (* (c-type-size 'u8) 2)))))
           (list (cons 'type type)
                 (cons 'x x)
                 (cons 'y y)
                 (cons 'button button)
                 (cons 'clicks clicks))))
        (else
          (list (cons 'type 'sdl2-event)
                (cons 'sdl2-type-number type)))))))

(define sdl2-events-get
  (lambda ()
    (let ((poll-result (SDL_PollEvent event*)))
      (cond
        ((= poll-result 1)
         (let ((event (sdl2-event->spite-event event*)))

           (cond ((equal? (cdr (assoc 'type event)) 'quit) (set! exit? #t)))
           (push-event event)
           (sdl2-events-get)))))))

(define render-clear
  (lambda ()
    (SDL_SetRenderDrawColor renderer* 255 255 255 255)
    (SDL_RenderClear renderer*)))

(define render-present
  (lambda ()
    (SDL_RenderPresent renderer*)))

(define-record-type image
  (make-image pointer path)
  image?
  (pointer image-pointer)
  (path image-path))

(define load-image
  (lambda (path)
    (when (not spite-inited?) (error "Can not load images until spite is inited." path))
    (when (not (string? path)) (error "load-image: path must be string" path))
    (when (not (file-exists? path)) (error (string-append "load-image: no such file: " path)))
    (make-image (IMG_LoadTexture renderer* (string->c-bytevector path)) path)))

(define draw-image
  (lambda (image x y width height)
    (when (not (exact-integer? x)) (error "draw-image: x must be exact integer"))
    (when (not (exact-integer? y)) (error "draw-image: y must be exact integer"))
    (when (not (exact-integer? width)) (error "draw-image: width must be exact integer"))
    (when (not (exact-integer? height)) (error "draw-image: width must be exact integer"))
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
    (SDL_RenderCopy renderer* (image-pointer image) (c-bytevector-null) draw-rect*)))

(define draw-image-slice
  (lambda (image x y width height slice-x slice-y slice-width slice-height)
    (when (not (exact-integer? x)) (error "draw-image: x must be exact integer"))
    (when (not (exact-integer? y)) (error "draw-image: y must be exact integer"))
    (when (not (exact-integer? width)) (error "draw-image: width must be exact integer"))
    (when (not (exact-integer? height)) (error "draw-image: width must be exact integer"))
    (when (not (exact-integer? slice-x)) (error "draw-image: slice-x must be exact integer"))
    (when (not (exact-integer? slice-y)) (error "draw-image: slice-y must be exact integer"))
    (when (not (exact-integer? slice-width)) (error "draw-image: slice-width must be exact integer"))
    (when (not (exact-integer? slice-height)) (error "draw-image: slice-width must be exact integer"))
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
    (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
    (c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 0) slice-x)
    (c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 1) slice-y)
    (c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 2) slice-width)
    (c-bytevector-set! draw-slice-rect* 'int (* (c-type-size 'int) 3) slice-height)
    (SDL_RenderCopy renderer* (image-pointer image) draw-slice-rect* draw-rect*)))

(define (set-draw-color r g b . a)
  (when (not (exact-integer? r)) (error "set-draw-color: r must be exact integer"))
  (when (not (exact-integer? g)) (error "set-draw-color: g must be exact integer"))
  (when (not (exact-integer? b)) (error "set-draw-color: b must be exact integer"))
  (when (and (not (null? a)) (not (exact-integer? (car a)))) (error "set-draw-color: a must be exact integer"))
  (set! draw-color-r r)
  (set! draw-color-g g)
  (set! draw-color-b b)
  (set! draw-color-a (if (null? a) 255 a))

  (c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 2) draw-color-r)
  (c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 3) draw-color-g)
  (c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 4) draw-color-b)
  (c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 5) draw-color-b)

  (c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 2) draw-color-r)
  (c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 3) draw-color-g)
  (c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 4) draw-color-b)
  (c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 5) draw-color-b)

  (c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 2) draw-color-r)
  (c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 3) draw-color-g)
  (c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 4) draw-color-b)
  (c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 5) draw-color-b)

  (SDL_SetRenderDrawColor renderer* r g b draw-color-a))

(define (set-line-size size)
  (when (not (exact-integer? size)) (error "set-line-size: size must be exact integer"))
  (set! current-line-size size)
  (SDL_RenderSetScale renderer* (inexact (/ size 1)) (inexact (/ size 1))))

(define (draw-point x y)
  (when (not (exact-integer? x)) (error "draw-point: x must be exact integer"))
  (when (not (exact-integer? y)) (error "draw-point: y must be exact integer"))
  (SDL_RenderDrawLine renderer*
                        (exact (round (/ x current-line-size)))
                        (exact (round (/ y current-line-size)))
                        (exact (round (/ x current-line-size)))
                        (exact (round (/ y current-line-size)))))

(define (draw-line x1 y1 x2 y2)
  (when (not (exact-integer? x1)) (error "draw-line: x1 must be exact integer"))
  (when (not (exact-integer? y1)) (error "draw-line: y1 must be exact integer"))
  (when (not (exact-integer? x2)) (error "draw-line: x2 must be exact integer"))
  (when (not (exact-integer? y2)) (error "draw-line: y2 must be exact integer"))
  (SDL_RenderDrawLine renderer*
                        (exact (round (/ x1 current-line-size)))
                        (exact (round (/ y1 current-line-size)))
                        (exact (round (/ x2 current-line-size)))
                        (exact (round (/ y2 current-line-size)))))

(define (draw-rectangle x y width height)
  (when (not (exact-integer? x)) (error "draw-rectangle: x must be exact integer"))
  (when (not (exact-integer? y)) (error "draw-rectangle: y must be exact integer"))
  (when (not (exact-integer? width)) (error "draw-rectangle: width must be exact integer"))
  (when (not (exact-integer? height)) (error "draw-rectangle: width must be exact integer"))
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
  (SDL_RenderDrawRect renderer* draw-rect*))

(define (fill-rectangle x y width height)
  (when (not (exact-integer? x)) (error "fill-rectangle: x must be exact integer"))
  (when (not (exact-integer? y)) (error "fill-rectangle: y must be exact integer"))
  (when (not (exact-integer? width)) (error "fill-rectangle: width must be exact integer"))
  (when (not (exact-integer? height)) (error "fill-rectangle: width must be exact integer"))
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 0) x)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 1) y)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 2) width)
  (c-bytevector-set! draw-rect* 'int (* (c-type-size 'int) 3) height)
  (SDL_RenderFillRect renderer* draw-rect*))

(define (draw-triangle x1 y1 x2 y2 x3 y3)
  (when (not (exact-integer? x1)) (error "draw-triangle: x1 must be exact integer"))
  (when (not (exact-integer? y1)) (error "draw-triangle: y1 must be exact integer"))
  (when (not (exact-integer? x2)) (error "draw-triangle: x2 must be exact integer"))
  (when (not (exact-integer? y2)) (error "draw-triangle: y2 must be exact integer"))
  (when (not (exact-integer? x3)) (error "draw-triangle: x3 must be exact integer"))
  (when (not (exact-integer? y3)) (error "draw-triangle: y3 must be exact integer"))
  (draw-line x1 y1 x2 y2)
  (draw-line x2 y2 x3 y3)
  (draw-line x3 y3 x1 y1))

;; FIXME
#;(define (fill-triangle x1 y1 x2 y2 x3 y3)
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 0) x1)
(c-bytevector-set! fill-triangle-vertex1* 'int (* (c-type-size 'int) 1) y1)

(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 0) x2)
(c-bytevector-set! fill-triangle-vertex2* 'int (* (c-type-size 'int) 1) y2)

(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 0) x3)
(c-bytevector-set! fill-triangle-vertex3* 'int (* (c-type-size 'int) 1) y3)

(SDL_RenderGeometry renderer* (c-bytevector-null) fill-triangle-vertexes* 3 (c-bytevector-null) 0))

(define (spite-option-set! name . value)
  (cond
    ((equal? name 'allow-window-resizing)
     (cond
       ((equal? value '(#t))
        (SDL_SetWindowResizable window* 1))
       ((equal? value '(#f))
        (SDL_SetWindowResizable window* 0))
       (else (error "Wrong option value for 'allow-window-resizing, must be #t or #f"
                    value))))
    ((equal? name 'renderer-size)
     (if (and (= (length value) 2)
              (number? (car value))
              (number? (cadr value)))
       (SDL_RenderSetLogicalSize renderer* (car value) (cadr value))
       (error "Wrong option value for renderer-size, must be two numbers")))
    (else (error "No such option!" name))))

;; TODO Move to options, add spite-option-get
(define spite-renderer-scale-get
  (lambda ()
    (let ((x (make-c-bytevector (c-type-size 'float)))
          (y (make-c-bytevector (c-type-size 'float))))
      (SDL_RenderGetScale renderer* x y)
      (list (cons 'x (c-bytevector-ref x 'float 0))
            (cons 'y (c-bytevector-ref y 'float 0))))))

(define spite-start
  (lambda (update-procedure draw-procedure)
    (when (not (procedure? update-procedure)) (error "spite-start: update-procedure must be procedure"))
    (when (not (procedure? draw-procedure)) (error "spite-start: draw-procedure must be procedure"))
    (c-bytevector-set! fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 0) fill-triangle-vertex1*)
    (c-bytevector-set! fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 1) fill-triangle-vertex2*)
    (c-bytevector-set! fill-triangle-vertexes* 'pointer (* fill-triangle-vertex-size 2) fill-triangle-vertex3*)
    (cond
      ((not started?)
       (set! started? #t)
       (main-loop update-procedure draw-procedure)))))

(define spite-init
  (lambda (title width height)
    (when (not (exact-integer? width)) (error "spite-init: width must be exact integer"))
    (when (not (exact-integer? height)) (error "spite-init: height must be exact integer"))
    (cond
      ((not started?)
       (SDL_Init 32)
       (set! window* (SDL_CreateWindow (string->c-bytevector title) 0 0 width height 4))
       (set! renderer* (SDL_CreateRenderer window* -1 2))
       (SDL_RenderSetLogicalSize renderer* width height)
       (SDL_RenderSetIntegerScale renderer* 1)
       (render-clear)
       (render-present)
       (set! spite-inited? #t)))))

(define poll-events!
  (lambda ()
    (let ((events-copy (list-copy events)))
      (set! events (list))
      events-copy)))

(define wait-for-event!
  (lambda ()
    (if (not (= (length events) 0))
      (poll-events!)
      (wait-for-event!))))

(define push-event
  (lambda (event)
    (set! events (append events (list event)))))

(define clear-events!
  (lambda ()
    (set! events (list))))

(define-record-type <bitmap-font>
  (internal-make-bitmap-font image draw-width draw-height character-width character-height lookup-table)
  bitmap-font?
  (image bitmap-font-image)
  (draw-width bitmap-font-draw-width)
  (draw-height bitmap-font-draw-height)
  (character-width bitmap-font-character-width)
  (character-height bitmap-font-character-height)
  (lookup-table bitmap-font-lookup-table))

(define (make-bitmap-font image character-width character-height draw-width draw-height character-lists)
  (let* ((line-index -1)
         (character-index -1)
         (lookup-table (make-vector 0)))
    (for-each
      (lambda (line)
        (set! line-index (+ line-index 1))
        (set! character-index -1)
        (for-each
          (lambda (character)
            (set! character-index (+ character-index 1))
            (let ((c-int (char->integer character)))
              (when (<= (vector-length lookup-table) c-int)
                (set! lookup-table
                  (vector-append
                    lookup-table
                    (make-vector (+ (- c-int (vector-length lookup-table)) 1) #f))))
              (vector-set! lookup-table
                           c-int
                           (vector character
                                   (* character-index character-width)
                                   (* line-index character-height)))))
          line))
      character-lists)
    (internal-make-bitmap-font image draw-width draw-height character-width character-height lookup-table)))

(define (set-bitmap-font font) (set! current-bitmap-font font))

(define draw-bitmap-text
  (lambda (text x y)
    (when (not current-bitmap-font)
      (error "Current bitmap font not set, use make-bitmap-font and set-bitmap-font"))
    (let ((offset-x x)
          (lookup-table (bitmap-font-lookup-table current-bitmap-font)))
      (for-each
        (lambda (character)
          (let ((char-data (vector-ref lookup-table (char->integer character))))
            (draw-image-slice (bitmap-font-image current-bitmap-font)
                              offset-x
                              y
                              (bitmap-font-draw-width current-bitmap-font)
                              (bitmap-font-draw-height current-bitmap-font)
                              (vector-ref char-data 1)
                              (vector-ref char-data 2)
                              (bitmap-font-character-width current-bitmap-font)
                              (bitmap-font-character-height current-bitmap-font))
            (set! offset-x (+ offset-x 14))))
        (string->list text)))))