;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; 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 (apple-town-fair game)
  #:use-module (apple-town-fair assets)
  #:use-module (apple-town-fair common)
  #:use-module (apple-town-fair config)
  #:use-module (apple-town-fair dialog-box)
  #:use-module (apple-town-fair light-overlay)
  #:use-module (apple-town-fair menu)
  #:use-module (apple-town-fair place)
  #:use-module (apple-town-fair save-state)
  #:use-module (apple-town-fair time-display)
  #:use-module (catbird)
  #:use-module (catbird mode)
  #:use-module (catbird node)
  #:use-module (catbird node-2d)
  #:use-module (catbird scene)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics path)
  #:use-module (chickadee math)
  #:use-module (chickadee math vector)
  #:use-module (oop goops)
  #:export (make-game-scene))

(define %time-wake 6)
(define %time-sleep 21)
(define %day-start 0)
(define %day-end 2)
(define %start-money 20.0)

(define-method (make-home)
  (make <place>
    #:name 'place
    #:title "Home"
    #:background home-background-image
    #:actions (list (make <action>
                      #:name "Test"
                      #:condition (const #t)
                      #:exec (lambda (mode)
                               (pk 'testing))))))

(define-method (make-farm-stand)
  (make <place>
    #:name 'place
    #:title "Farm Stand"
    #:background farm-stand-background-image))

(define-class <game-mode> (<major-mode>)
  (story-points #:accessor story-points #:init-keyword #:story-points
                #:init-value 0)
  (day #:accessor day #:init-keyword #:day #:init-value 0)
  (time #:accessor time #:init-keyword #:time #:init-value %time-wake)
  (money #:accessor money #:init-keyword #:money #:init-value %start-money)
  (inventory #:accessor inventory #:init-keyword #:inventory #:init-value '())
  (flags #:accessor flags #:init-keyword #:flags #:init-value '()))

(define-method (on-enter (mode <game-mode>))
  (let ((scene (parent mode)))
    (attach-to scene
               (make <light-overlay>
                 #:name 'overlay
                 #:rank 8)
               (make <dialog-box>
                 #:name 'dialog
                 #:rank 9
                 #:text "Hello, world!
How many characters fit on a line? 50 characters!!
Hello, world!
Hello, world!
Hello, world!")
               (make <time-display>
                 #:name 'time
                 #:rank 9))
    (teleport (& scene time)
              (- %game-width (width (& scene time)))
              (- %game-height (height (& scene time))))
    (reset-game mode)))

(define-method (change-place (mode <game-mode>) (new-place <place>))
  (let* ((scene (parent mode))
         (old-place (& scene place)))
    (when old-place
      (detach old-place))
    (attach-to scene new-place)
    (set! (where (& scene time)) (title new-place))
    (advance-clock mode 1)
    (when (& scene menu)
      (detach (& scene menu)))
    (attach-to scene
               (make <menu>
                 #:name 'menu
                 #:rank 9
                 #:items (map name (actions new-place))))))

(define-method (change-time (mode <game-mode>) t)
  (let ((scene (parent mode)))
    (set! (time mode) (clamp %time-wake %time-sleep t))
    (set! (time (& scene overlay)) (time mode))
    (set! (time (& scene time)) (time mode))))

(define-method (change-day (mode <game-mode>) d)
  (let ((scene (parent mode)))
    (set! (day mode) (clamp %day-start %day-end d))
    (set! (day (& scene time)) (day mode))))

(define-method (reset-game (mode <game-mode>))
  (let ((scene (parent mode)))
    (change-day mode %day-start)
    (change-time mode %time-wake)
    (change-place mode (make-home))
    (set! (story-points mode) 0)
    (set! (inventory mode) '())
    (set! (flags mode) '())
    (set! (money mode) %start-money)
    (hide (& scene dialog))))

(define-method (go-to-bed (mode <game-mode>))
  (let ((scene (parent mode)))
    (if (= (day mode) %day-end)
        (reset-game mode)
        (begin
          (change-time mode %time-wake)
          (change-day mode (+ (day mode) 1))))))

(define-method (advance-clock (mode <game-mode>) n)
  (change-time mode (+ (time mode) n))
  (when (= (time mode) %time-sleep)
    (go-to-bed mode)))

(define-method (advance-clock-once (mode <game-mode>))
  (advance-clock mode 1))

(define-method (quit-game (mode <game-mode>))
  (exit-catbird))

(define-method (go-to-farm-stand (mode <game-mode>))
  (change-place mode (make-farm-stand)))

(define-method (go-home (mode <game-mode>))
  (change-place mode (make-home)))

(define-method (up-selection (mode <game-mode>))
  (up-selection (& (parent mode) menu) 1))

(define-method (down-selection (mode <game-mode>))
  (down-selection (& (parent mode) menu) 1))

(define-method (confirm-selection (mode <game-mode>))
  (pk 'chose (selection (& (parent mode) menu))))

(bind-input <game-mode> (key-press 'r) reset-game)
(bind-input <game-mode> (key-press 'escape) quit-game)
(bind-input <game-mode> (key-press 'f) go-to-farm-stand)
(bind-input <game-mode> (key-press 'h) go-home)
(bind-input <game-mode> (key-press 'up) up-selection)
(bind-input <game-mode> (key-press 'down) down-selection)
(bind-input <game-mode> (key-press 'return) confirm-selection)

(define (make-game-scene)
  (make <scene>
    #:name 'game
    #:major-mode (make <game-mode>)))