;;; The Inevitable Game
;;; Copyright © 2018, 2021 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (utils)
  #:use-module (chickadee)
  #:use-module (chickadee audio)
  #:use-module (chickadee math vector)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics text)
  #:use-module (chickadee graphics path)
  #:use-module (chickadee graphics sprite)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee graphics tile-map)
  #:use-module (chickadee scripting)
  #:use-module (config)
  #:use-module (engine assets)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:export (arrange-text

            <label>
            draw-label
            visible?
            
            <sprite>
            agenda
            position
            texture
            tint

            draw

            <animated-sprite>
            atlas

            draw-animated-sprite
            update-animated-sprite
            change-sprite-animation

            <character>
            name
            velocity
            walk-speed
            direction
            conversations
            accepted-messages
            speaking?

            walk))

(define* (arrange-text text font #:key
                       (margin 0.0)
                       (max-width %width))
  "Take the string TEXT and split it at spaces so that it fits in the
given MAX-WIDTH.  Return a list of lines."
  (match (fold (lambda (chunk acc)
                 (match acc
                   ((#:width width #:result (and (current-line . tail) lines))
                    (let* ((new-line (string-append current-line " " chunk))
                           (new-width (font-line-width font new-line)))
                      (if (< (+ new-width margin) max-width)
                          `(#:width ,new-width
                            #:result ,(cons new-line tail))
                          `(#:width ,(font-line-width font chunk)
                            #:result ,(cons chunk lines)))))))
               '(#:width 0 #:result (""))
               (string-tokenize text))
    ((#:width _ #:result lines)
     (reverse lines))))

(define-class <label> ()
  (position #:accessor position #:init-keyword #:position)
  (visible? #:accessor visible? #:init-keyword #:visible?)
  (font #:accessor font #:init-keyword #:font)
  (text #:accessor text #:init-form "" #:init-keyword #:text))

(define-method (draw-label label alpha)
  (when (visible? label)
    (draw-text (text label) (position label)
               #:font (asset-ref (font label)))))

(define-class <sprite> ()
  (agenda #:getter agenda #:init-form (make-agenda))
  (position #:accessor position #:init-keyword #:position)
  (texture #:accessor texture #:init-keyword #:texture)
  (tint #:accessor tint #:init-keyword #:tint #:init-form white))

(define-method (draw (sprite <sprite>) alpha)
  (draw-sprite (asset-ref (texture sprite))
               (position sprite)
               #:tint (tint sprite)))

(define-class <animated-sprite> (<sprite>)
  (atlas #:accessor atlas #:init-keyword #:atlas)
  (animations #:accessor animations #:init-keyword #:animations)
  (frame-duration #:accessor frame-duration #:init-keyword #:frame-duration)
  (current-animation #:accessor current-animation
                     #:init-keyword #:current-animation)
  (start-time #:accessor start-time #:init-form 0))

(define (draw-animated-sprite sprite offset)
  (draw-sprite (asset-ref (texture sprite))
               (vec2+ offset (position sprite))
               #:tint (tint sprite)))

(define (update-animated-sprite sprite)
  (let* ((anim (assq-ref (animations sprite) (current-animation sprite)))
         (frame-duration (frame-duration sprite))
         (anim-duration (* frame-duration (vector-length anim)))
         (time (floor-remainder (- (agenda-time) (start-time sprite))
                                anim-duration))
         (frame (vector-ref anim (inexact->exact
                                  (floor (/ time frame-duration)))))
         (texture-region (texture-atlas-ref (asset-ref (atlas sprite)) frame)))
    (set! (texture sprite) texture-region)))

(define (change-sprite-animation sprite name)
  (set! (current-animation sprite) name)
  (set! (start-time sprite) (with-agenda (agenda sprite) (agenda-time))))

(define-class <character> (<animated-sprite>)
  (name #:getter name #:init-keyword #:name)
  (velocity #:getter velocity #:init-form (vec2 0.0 0.0))
  (walk-speed #:accessor walk-speed #:init-form 0.8)
  (direction #:accessor direction #:init-form '(idle))
  (conversations #:accessor conversations #:init-keyword #:conversations)
  (accepted-messages #:accessor accepted-messages #:init-form '((hello "Hello there!")))
  (speaking? #:accessor speaking? #:init-form #false))

(define-method (walk (character <character>) directions . rest)
  (let ((stop? (member 'stop rest)))
    (unless (and (equal? (direction character) directions)
                 (not stop?))
      (let ((speed  (if stop? 0.0 (walk-speed character))))
        (change-sprite-animation character (last directions))
        (for-each (lambda (dir)
                    (case dir
                      ((right)
                       (set-vec2-x! (velocity character) speed))
                      ((left)
                       (set-vec2-x! (velocity character) (* -1.0 speed)))
                      ((up)
                       (set-vec2-y! (velocity character) speed))
                      ((down)
                       (set-vec2-y! (velocity character) (* -1.0 speed)))
                      ((idle)
                       (set-vec2-x! (velocity character) 0.0)
                       (set-vec2-y! (velocity character) 0.0)
                       (change-sprite-animation
                        character
                        (case (last (direction character))
                          ((right) 'idle-right)
                          ((left)  'idle-left)
                          ((up)    'idle-back)
                          ((down)  'idle-front))))))
                  directions)
        (set! (direction character) directions)))))