(import scheme
	(chicken base)
	(chicken format)
	(chicken process-context)
	(chicken condition)
	(chicken pretty-print)
	(srfi 1)
	(srfi 12)
	miscmacros
	simple-logger
	(prefix sdl2 "sdl2:")
	(prefix sdl2-ttf "ttf:")
	(prefix sdl2-image "img:")
	matchable
	tilemap
	defstruct
	input)

(define +color-depth+ 32)
(define +screen-width+ 600)
(define +screen-height+ 400)
(define *fullscreen?* #f)
(define +background-color+ (sdl2:make-color 0 0 0))
(define +software-mode?+ (member "--software" (command-line-arguments)))
(define +vsync?+ (member "--vsync" (command-line-arguments)))
(define +debug?+ (member "--debug" (command-line-arguments)))

;; When --debug is passed, show debug/info logs (e.g. input events).
(when +debug?+
  (log-level 0))

(sdl2:set-main-ready!)
(sdl2:init! '(video joystick))
(ttf:init!)
(img:init! '(png))

(on-exit sdl2:quit!)

;; Install a custom exception handler that will call quit! and then
;; call the original exception handler. This ensures that quit! will
;; be called even if an unhandled exception reaches the top level.
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))

(if (and +vsync?+ (not +software-mode?+)) ; vsync doesn't work with software rendering
    (sdl2:set-hint! 'render-vsync "1"))
(define *window* (sdl2:create-window! "MacroKnight"
				      'centered 'centered
				      +screen-width+ +screen-height+
				      (if *fullscreen?* '(fullscreen) '())))

(define *renderer*
  (handle-exceptions exn
      (lambda ()
	(display "Error initialising accelerated renderer. Falling back")
	(sdl2:create-renderer! *window* -1 '(software)))
    (sdl2:create-renderer! *window* -1 '(accelerated))))

(define *font* (ttf:open-font "DejaVuSans.ttf" 12))
(define *text-color* (sdl2:make-color 255 255 255))
(pp (sdl2:num-joysticks))
(define *joystick* (if (> (sdl2:num-joysticks) 0)
		       (sdl2:joystick-open! 0)
		       #f))
(define *level* (load-tilemap "assets/level-0.tmx"))
(define *level-tileset-texture* (sdl2:create-texture-from-surface *renderer* (tileset-image (tilemap-tileset *level*))))
(define *input* (create-input-state))

(define (draw-tile renderer tileset tile-id row-num col-num)
  (let ((tile (tileset-tile tileset tile-id)))
    (sdl2:render-copy! renderer *level-tileset-texture*
		       (tile-rect tile)
		       (sdl2:make-rect (* col-num (tileset-tileheight tileset))
				       (* row-num (tileset-tilewidth tileset))
				       (tileset-tilewidth tileset)
				       (tileset-tileheight tileset)))))

(define (draw-tilemap-rows draw-fn rows row-num)
  (unless (null? rows)
    (for-each
     (cut draw-fn <> row-num <>)
     (car rows)
     (iota (length (car rows))))
    (draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))

(define (draw-tilemap renderer tilemap)
  (let ((map-layers (tilemap-layers tilemap))
	(tileset (tilemap-tileset tilemap)))
    (for-each
     (lambda (layer)
       (draw-tilemap-rows
	(cut draw-tile renderer tileset <> <> <>)
	(layer-map layer)
	0))
     map-layers)))

(define (draw-objects renderer tilemap)
  (let ((objects (tilemap-objects tilemap))
	(tileset (tilemap-tileset tilemap)))
    (for-each
     (cut draw-object renderer tileset <>)
     objects)))

(define (draw-object renderer tileset object)
  (match (object-type object)
    ("Player" (draw-player renderer tileset object))
    ("Text" (draw-text renderer tileset object))
    ("Enemy" (draw-enemy renderer tileset object))
    (_ #f)))

(define (draw-player renderer tileset object)
  (let ((col-num (inexact->exact (floor (/ (object-x object) (tileset-tilewidth tileset)))))
	(row-num (inexact->exact (floor (/ (object-y object) (tileset-tileheight tileset))))))
    (draw-tile renderer tileset 29 row-num col-num)))

(define (draw-text renderer tileset object)
  (let* ((text (cdr (assoc "text" (object-properties object))))
	 (text-texture (sdl2:create-texture-from-surface renderer
			(ttf:render-text-solid *font* text *text-color*))))
    (sdl2:render-copy! renderer text-texture #f (sdl2:make-rect
						 (inexact->exact (floor (object-x object)))
						 (inexact->exact (floor (object-y object)))
						 (inexact->exact (floor (object-width object)))
						 (inexact->exact (floor (object-height object)))))))

(define (draw-enemy renderer tileset object)
  (let ((col-num (inexact->exact (floor (/ (object-x object) (tileset-tilewidth tileset)))))
	(row-num (inexact->exact (floor (/ (object-y object) (tileset-tileheight tileset))))))
    (draw-tile renderer tileset 111 row-num col-num)))

(set! (sdl2:render-draw-color *renderer*) +background-color+)
(sdl2:render-clear! *renderer*)

(let/cc exit-main-loop!
	(while #t
	  (set! (sdl2:render-draw-color *renderer*) +background-color+)
	  (sdl2:render-clear! *renderer*)
	  (sdl2:pump-events!)
	  (let ((events-this-frame
		 (let collect ((lst '()))
		   (if (not (sdl2:has-events?))
		       (reverse lst)
		       (let ((e (sdl2:make-event)))
			 (sdl2:poll-event! e)
			 (collect (cons e lst)))))))
	    (set! *input* (input-state-update *input* events-this-frame))
	    (when (input-pressed? *input* 'quit)
			(log-debug "[game] quit pressed")
	      (exit-main-loop!)))

	  (draw-tilemap *renderer* *level*)
	  (draw-objects *renderer* *level*)

	  (sdl2:render-present! *renderer*)
	  (sdl2:delay! 10)))

(when *joystick* (sdl2:joystick-close *joystick*))

(format #t "Bye!\n")