;; Load base deps
(import scheme
        (chicken base)
        (chicken keyword)
        (only srfi-1 fold iota for-each)
        srfi-69
        defstruct
        test)

;; Mock tilemap module
(module (downstroke tilemap) *
  (import scheme (chicken base) defstruct)
  (defstruct tileset tilewidth tileheight spacing tilecount columns image-source image)
  (defstruct layer name width height map)
  (defstruct tilemap width height tilewidth tileheight tileset-source tileset layers objects)
  (defstruct tile id rect)
  (define (tileset-tile ts id) (make-tile id: id rect: #f))
  (define (tile-rect t) #f))
(import (downstroke tilemap))

;; Mock sdl2
(module sdl2 *
  (import scheme (chicken base))
  (define (make-rect x y w h) (list x y w h))
  (define (make-color r g b #!optional (a 255)) (list r g b a))
  (define (render-copy! . args) #f)
  (define (render-copy-ex! . args) #f)
  (define (create-texture-from-surface . args) #f)
  (define (render-fill-rect! . args) #f)
  ;; Mock SRFI-17 setter for render-draw-color
  (define render-draw-color (getter-with-setter (lambda (r) #f) (lambda (r c) #f))))
(import (prefix sdl2 "sdl2:"))

;; Mock sdl2-ttf
(module sdl2-ttf *
  (import scheme (chicken base))
  (define (render-text-solid . args) #f)
  (define (size-utf8 . args) (values 0 0)))
(import (prefix sdl2-ttf "ttf:"))

;; Load entity module
(include "entity.scm")
(import (downstroke entity))

(import (only (list-utils alist) plist->alist))

;; Test helper: build an alist entity from plist-style keyword args.
(define (entity . kws) (plist->alist kws))

;; Load world module
(include "world.scm")
(import (downstroke world))

;; Load renderer module
(include "renderer.scm")
(import (downstroke renderer))

(test-begin "renderer")

(test-group "entity-screen-coords"
  (let* ((cam (make-camera x: 10 y: 20))
         (e   (entity #:x 50 #:y 80 #:width 16 #:height 16)))
    (test "subtracts camera offset from x"
          40
          (car (entity-screen-coords e cam)))
    (test "subtracts camera offset from y"
          60
          (cadr (entity-screen-coords e cam)))
    (test "preserves width"
          16
          (caddr (entity-screen-coords e cam)))
    (test "preserves height"
          16
          (cadddr (entity-screen-coords e cam))))

  (let* ((cam (make-camera x: 0 y: 0))
         (e   (entity #:x 100.7 #:y 200.3 #:width 16 #:height 16)))
    (test "floors fractional x"
          100
          (car (entity-screen-coords e cam)))
    (test "floors fractional y"
          200
          (cadr (entity-screen-coords e cam))))

  (let* ((cam (make-camera x: 0 y: 0))
         (e   (entity #:x 0 #:y 0 #:width 32 #:height 32)))
    (test "zero camera, zero position"
          '(0 0 32 32)
          (entity-screen-coords e cam))))

(test-group "entity-flip"
  (test "facing 1: no flip"
        '()
        (entity-flip (entity #:facing 1)))
  (test "facing -1: horizontal flip"
        '(horizontal)
        (entity-flip (entity #:facing -1)))
  (test "no facing key: defaults to no flip"
        '()
        (entity-flip (entity #:x 0))))

(test-group "render-scene!"
  (let* ((cam      (make-camera x: 0 y: 0))
         (tileset  (make-tileset tilewidth: 16 tileheight: 16
                                 spacing: 0 tilecount: 100 columns: 10
                                 image-source: "" image: #f))
         (layer    (make-layer name: "ground" width: 2 height: 2
                               map: '((1 2) (3 4))))
         (tilemap  (make-tilemap width: 2 height: 2
                                 tilewidth: 16 tileheight: 16
                                 tileset-source: ""
                                 tileset: tileset
                                 layers: (list layer)
                                 objects: '()))
         (scene    (make-scene entities: '()
                               tilemap: tilemap
                               camera: cam
                               tileset-texture: #f
                               camera-target: #f)))
    (test-assert "does not crash on valid scene"
      (begin (render-scene! #f scene) #t)))

  (let* ((cam   (make-camera x: 0 y: 0))
         (box   (entity #:x 4 #:y 8 #:width 10 #:height 12 #:color '(200 40 90)))
         (scene (make-scene entities: (list box)
                            tilemap: #f
                            camera: cam
                            tileset-texture: #f
                            camera-target: #f))
         (renderer #f))
    (test-assert "no tilemap: draws #:color entities without crashing"
      (begin (render-scene! renderer scene) #t))))

(test-group "sprite-font"
  (test-group "make-sprite-font*"
    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
                                   ranges: (list (list #\A #\C 100)))))
      (test "A maps to 100"
            100
            (sprite-font-char->tile-id font #\A))
      (test "B maps to 101"
            101
            (sprite-font-char->tile-id font #\B))
      (test "C maps to 102"
            102
            (sprite-font-char->tile-id font #\C))))

  (test-group "sprite-font-char->tile-id"
    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
                                   ranges: (list (list #\A #\Z 100)))))
      (test "returns #f for unmapped char"
            #f
            (sprite-font-char->tile-id font #\1))
      (test "auto-upcase: lowercase a maps to uppercase"
            100
            (sprite-font-char->tile-id font #\a))))

  (test-group "overlapping ranges"
    (import (chicken condition))
    (let ((caught-error #f))
      (condition-case
          (make-sprite-font* tile-size: 8 spacing: 1
                             ranges: (list (list #\A #\C 100)
                                           (list #\B #\D 200)))
        (e (exn)
           (set! caught-error #t)))
      (test-assert "signals error on overlapping range"
        caught-error)))

  (test-group "sprite-text-width"
    (let ((font (make-sprite-font* tile-size: 8 spacing: 1
                                   ranges: (list (list #\A #\Z 100)))))
      (test "empty string width is 0"
            0
            (sprite-text-width font ""))
      (test "single char width is tile-size"
            8
            (sprite-text-width font "A"))
      (test "two chars: 2*tile-size + 1*spacing"
            17
            (sprite-text-width font "AB"))
      (test "three chars: 3*tile-size + 2*spacing"
            26
            (sprite-text-width font "ABC"))))

  (test-group "draw-sprite-text"
    (let* ((font    (make-sprite-font* tile-size: 8 spacing: 1
                                       ranges: (list (list #\A #\Z 100))))
           (tileset (make-tileset tilewidth: 8 tileheight: 8
                                  spacing: 0 tilecount: 100 columns: 10
                                  image-source: "" image: #f))
           (renderer #f)
           (texture  #f))
      (test-assert "does not crash with valid text"
        (begin (draw-sprite-text renderer texture tileset font "HELLO" 10 20) #t))
      (test-assert "does not crash with unmapped chars"
        (begin (draw-sprite-text renderer texture tileset font "A1B" 0 0) #t)))))

(test-group "draw-menu-items"
  (test-assert "does not crash with 3 items, cursor=1"
    (let ((font #f))  ; mock font
      (begin
        (draw-menu-items #f font '("Item 1" "Item 2" "Item 3") 1 10 20 30)
        #t)))

  (test-assert "does not crash with keyword args label-fn:"
    (let ((font #f))
      (begin
        (draw-menu-items #f font '("A" "B" "C") 0 10 20 30
                         label-fn: (lambda (x) (string-append "[" x "]")))
        #t)))

  (test-assert "does not crash with keyword args prefix:"
    (let ((font #f))
      (begin
        (draw-menu-items #f font '("Item 1" "Item 2") 1 10 20 30
                         prefix: ">>> " no-prefix: "    ")
        #t))))

(test-group "debug-drawing"
  (test-group "draw-debug-tiles"
    (let* ((cam      (make-camera x: 0 y: 0))
           (tileset  (make-tileset tilewidth: 16 tileheight: 16
                                   spacing: 0 tilecount: 100 columns: 10
                                   image-source: "" image: #f))
           (layer    (make-layer name: "ground" width: 2 height: 2
                                 map: '((0 1) (2 3))))
           (tilemap  (make-tilemap width: 2 height: 2
                                   tilewidth: 16 tileheight: 16
                                   tileset-source: ""
                                   tileset: tileset
                                   layers: (list layer)
                                   objects: '()))
           (renderer #f))
      (test-assert "does not crash with 2x2 tilemap"
        (begin (draw-debug-tiles renderer cam tilemap) #t))))

  (test-group "draw-debug-entities"
    (let* ((cam      (make-camera x: 0 y: 0))
           (tileset  (make-tileset tilewidth: 16 tileheight: 16
                                   spacing: 0 tilecount: 100 columns: 10
                                   image-source: "" image: #f))
           (layer    (make-layer name: "ground" width: 1 height: 1
                                 map: '((0))))
           (tilemap  (make-tilemap width: 1 height: 1
                                   tilewidth: 16 tileheight: 16
                                   tileset-source: ""
                                   tileset: tileset
                                   layers: (list layer)
                                   objects: '()))
           (player   (entity #:type 'player #:x 10 #:y 20 #:width 16 #:height 16 #:facing 1))
           (enemy    (entity #:type 'enemy #:x 50 #:y 60 #:width 16 #:height 16 #:facing -1))
           (scene    (make-scene entities: (list player enemy)
                                 tilemap: tilemap
                                 camera: cam
                                 tileset-texture: #f
                                 camera-target: #f))
           (renderer #f))
      (test-assert "does not crash with player and enemy entities"
        (begin (draw-debug-entities renderer cam scene) #t))))

  (test-group "render-debug-scene!"
    (let* ((cam      (make-camera x: 0 y: 0))
           (tileset  (make-tileset tilewidth: 16 tileheight: 16
                                   spacing: 0 tilecount: 100 columns: 10
                                   image-source: "" image: #f))
           (layer    (make-layer name: "ground" width: 1 height: 1
                                 map: '((0))))
           (tilemap  (make-tilemap width: 1 height: 1
                                   tilewidth: 16 tileheight: 16
                                   tileset-source: ""
                                   tileset: tileset
                                   layers: (list layer)
                                   objects: '()))
           (player   (entity #:type 'player #:x 10 #:y 20 #:width 16 #:height 16 #:facing 1))
           (scene    (make-scene entities: (list player)
                                 tilemap: tilemap
                                 camera: cam
                                 tileset-texture: #f
                                 camera-target: #f))
           (renderer #f))
      (test-assert "does not crash with full scene"
        (begin (render-debug-scene! renderer scene) #t)))))

(test-group "scene-entities must be plists"
  (let* ((cam     (make-camera x: 0 y: 0))
         (tileset (make-tileset tilewidth: 16 tileheight: 16
                                spacing: 0 tilecount: 100 columns: 10
                                image-source: "" image: #f))
         (layer   (make-layer name: "ground" width: 1 height: 1 map: '((0))))
         (tilemap (make-tilemap width: 1 height: 1 tilewidth: 16 tileheight: 16
                                tileset-source: "" tileset: tileset
                                layers: (list layer) objects: '()))
         (tex     'mock-texture)
         (ent     (entity #:type 'box #:x 10 #:y 20 #:width 16 #:height 16 #:tile-id 1))
         (cell    (vector ent 'extra-data 0 100 'linear #t))
         (scene-ok  (make-scene entities: (list ent)
                                tilemap: tilemap camera: cam
                                tileset-texture: tex camera-target: #f))
         (scene-bad (make-scene entities: (list cell)
                                tilemap: tilemap camera: cam
                                tileset-texture: tex camera-target: #f)))
    (test-assert "render-scene! works with plist entities"
      (begin (render-scene! #f scene-ok) #t))
    (test-error "render-scene! errors when entity list contains a vector"
                (render-scene! #f scene-bad))
    (test-assert "extracting entity from cell vector fixes the issue"
      (let ((scene-fixed (make-scene entities: (list (vector-ref cell 0))
                                     tilemap: tilemap camera: cam
                                     tileset-texture: tex camera-target: #f)))
        (begin (render-scene! #f scene-fixed) #t)))))

(test-end "renderer")
(test-exit)