(import (scheme)
        (chicken base)
        (chicken format)
        (chicken irregex)
        (chicken keyword)
        (chicken process)
        (chicken process-context)
        (srfi 18)
        (srfi 69)
        (toml)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-image "img:")
        (prefix sdl2-ttf "ttf:"))

(change-directory
 (irregex-match-substring (irregex-search '(: bos (* any) #\/) (executable-pathname))))

;;; Configuration Handling

(define tomldata (table-from-file "menu.toml"))

(define launcher-entries
  (let* ((launcher (toml-table tomldata "launcher"))
         (entries (toml-array launcher "entry"))
         (max-index (- (toml-count-entries entries) 1)))
    (let accumulate ((index 0))
      (if (< index max-index)
          (cons (toml-table entries index)
                (accumulate (+ index 1)))
          (list (toml-table entries index))))))

;;; Data Loading

(define (load-image-texture renderer imgpath)
  (sdl2:create-texture-from-surface renderer (img:load imgpath)))

(define (load-resources! renderer)
  (map (lambda (entry)
         (let ((id (string->keyword (toml-string entry "id")))
               (image (toml-string entry "image")))
           (hash-table-set! texstore id
                            (load-image-texture renderer image))))
       launcher-entries)
  (hash-table-set! texstore #:background
                   (load-image-texture renderer "media/images/background.png"))
  (hash-table-set! texstore #:square
                   (load-image-texture renderer "media/images/square.png"))

  (hash-table-set! fontstore #:fira-propo
                   (ttf:open-font "media/fonts/FiraCodeNerdFontPropo-Bold.ttf" 24)))

(define texstore (make-hash-table))
(define fontstore (make-hash-table))
(define debugtext "Initialized and ready.")

(define (render-debugtext renderer)
  (let ((font (hash-table-ref fontstore #:fira-propo)))
    (let-values (((tw th) (ttf:size-text font debugtext)))
      (let ((rect (sdl2:make-rect 0 0 tw th)))
        (sdl2:render-copy! renderer
                           (sdl2:create-texture-from-surface
                            renderer
                            (ttf:render-text-solid font debugtext (sdl2:make-colour)))
                           rect rect)))))

(define active-controllers '())

(define active-button-id 0)
(define button-bg-x 100)
(define button-bg-y 100)
(define button-mv-tickbuffer 0)
(define pixels-per-tick 1)

(define (button-coordinates index)
  (values (+ 300 (* (modulo index 4) 350))
          (+ 300 (* (floor (/ index 4)) 350))))

(define (move-button-bg!)
  (let-values (((target-x target-y) (button-coordinates active-button-id)))
    (let ((ticks (- (sdl2:get-ticks) button-mv-tickbuffer)))
      (set! button-mv-tickbuffer (sdl2:get-ticks))
      (cond ((< button-bg-x target-x)
             (set! button-bg-x (min (+ button-bg-x (* pixels-per-tick ticks))
                                    target-x)))
            ((> button-bg-x target-x)
             (set! button-bg-x (max (- button-bg-x (* pixels-per-tick ticks))
                                    target-x)))
            (else #t))
      (cond ((< button-bg-y target-y)
             (set! button-bg-y (min (+ button-bg-y (* pixels-per-tick ticks))
                                    target-y)))
            ((> button-bg-y target-y)
             (set! button-bg-y (max (- button-bg-y (* pixels-per-tick ticks))
                                    target-y)))
            (else #t)))))

(define (render-square renderer x y rgb)
  (let* ((square (hash-table-ref texstore #:square))
         (srcrect (sdl2:make-rect 0 0 300 300))
         (destrect (sdl2:make-rect x y 300 300)))
    (sdl2:texture-colour-mod-set! square rgb)
    (sdl2:render-copy! renderer square srcrect destrect)))

(define (render-launcher-button renderer index)
  (let-values (((button-x button-y) (button-coordinates index)))
    (let* ((entry (list-ref launcher-entries index))
           (id (string->keyword (toml-string entry "id")))
           (icon (hash-table-ref texstore id))
           (srcrect (sdl2:make-rect 0 0 300 300))
           (destrect (sdl2:make-rect (+ 20 button-x) (+ 20 button-y) 260 260)))
      (sdl2:render-copy! renderer icon srcrect destrect))))

(define (render-launcher-buttons renderer)
  (let loop ((index 0))
    (render-launcher-button renderer index)
    (when (< index (- (length launcher-entries) 1))
      (loop (+ index 1)))))

(define (render-button-bgs renderer active-x active-y)
  (let loop ((index 0))
    (let-values (((button-x button-y) (button-coordinates index)))
      (render-square renderer button-x button-y '(200 200 200)))
    (when (< index (- (length launcher-entries) 1))
      (loop (+ index 1))))
  (render-square renderer active-x active-y '(100 100 100)))

(define (render-main-menu renderer ww wh)
  (let ((texture (hash-table-ref texstore #:background))
        (srcrec (sdl2:make-rect 0 0 1920 1080))
        (dstrec (sdl2:make-rect 0 0 ww wh)))
    (sdl2:render-clear! renderer)
    (sdl2:render-copy! renderer texture srcrec dstrec)
    (render-debugtext renderer)
    (render-button-bgs renderer button-bg-x button-bg-y)
    (render-launcher-buttons renderer)
    (sdl2:render-present! renderer)))

(define (change-active-button delta)
  (cond ((and (> delta 0) (< active-button-id 3))
         (set! active-button-id (+ active-button-id delta)))
        ((and (< delta 0) (> active-button-id 0))
         (set! active-button-id (+ active-button-id delta)))))

(define (trigger-action! window)
  (set! active-controllers '())
  (sdl2:quit-subsystem! '(events))
  (process-wait (process-run (toml-string (list-ref launcher-entries active-button-id) "command")))
  (sdl2:init-subsystem! '(events))
  (sdl2:pump-events!)
  (sdl2:flush-events!)
  (sdl2:window-fullscreen-set! window 'fullscreen-desktop))

(define (handle-event ev window renderer ww wh exit-main-loop!)
  (case (sdl2:event-type ev)
    ((window) (render-main-menu renderer ww wh))
    ((quit) (exit-main-loop! #t))
    ((controller-device-added) (begin (set! debugtext
                                        (format "Event: Controller ~A added"
                                                (sdl2:controller-device-event-which ev)))
                                      (set! active-controllers
                                        (cons (sdl2:game-controller-open!
                                               (sdl2:controller-device-event-which ev))
                                              active-controllers))))
    ((controller-device-removed) (set! debugtext "Event: Controller removed"))
    ((controller-axis-motion) (begin
                                (case (sdl2:controller-axis-event-axis ev)
                                  ((left-x) (cond ((< 0 (sdl2:controller-axis-event-value ev))
                                                   (change-active-button 1))
                                                  ((> 0 (sdl2:controller-axis-event-value ev))
                                                   (change-active-button -1))
                                                  (else #t))))
                                (set! debugtext (format "Event: Axis ~A moved by ~A, active button is ~A"
                                                        (sdl2:controller-axis-event-axis ev)
                                                        (sdl2:controller-axis-event-value ev)
                                                        active-button-id))))
    ((controller-button-down) (begin
                                (case (sdl2:controller-button-event-button ev)
                                  ((a) (trigger-action! window)))
                                (set! debugtext (format "Controller button: ~A"
                                                        (sdl2:controller-button-event-button ev)))))
    ((key-down) (set! debugtext "Event: Key down"))
    ((key-up) (set! debugtext "Event: Key up"))
    (else #f)))

(define (thread-delay! ms)
  (thread-sleep! (* ms 0.001)))

(define (mainloop window renderer)
  (let-values (((ww wh) (sdl2:window-size window)))
    (let ((sdl2-event (sdl2:make-event)))
      (call-with-current-continuation
       (lambda (exit-main-loop!)
         (let inner-loop ()
           (render-main-menu renderer ww wh)
           (move-button-bg!)
           (let ((event (sdl2:wait-event-timeout! 50 sdl2-event thread-delay!)))
             (when event (handle-event event window renderer ww wh exit-main-loop!)))
           (inner-loop)))))))

(define (main #!optional args)
  (sdl2:set-main-ready!)
  (sdl2:init! '(everything))
  (ttf:init!)
  (sdl2:set-hint! 'render-scale-quality "best")
  (let* ((window (sdl2:create-window! "Media Center" 'undefined 'undefined 1920 1080
                                      '(shown allow-high-dpi fullscreen-desktop)))
         (renderer (sdl2:create-renderer! window -1 '(accelerated target-texture))))
    (load-resources! renderer)
    (on-exit sdl2:quit!)
    (thread-join!
     (thread-start!
      (lambda ()
        (mainloop window renderer))))))