;;; 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 menu)
  #:use-module (apple-town-fair assets)
  #:use-module (apple-town-fair common)
  #:use-module (catbird asset)
  #:use-module (catbird node)
  #:use-module (catbird node-2d)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics path)
  #:use-module (chickadee graphics text)
  #:use-module (chickadee math)
  #:use-module (chickadee math vector)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)
  #:export (<menu>
            down-selection
            selection
            up-selection))


(define-class <menu> (<node-2d>)
  (items #:accessor items #:init-keyword #:items)
  (item-nodes #:accessor item-nodes)
  (selected-item #:accessor selected-item))

(define-method (on-boot (menu <menu>))
  (let ((nodes (map (lambda (item)
                      (make <label>
                        #:rank 1
                        #:font monogram-font
                        #:text item))
                    (items menu)))
        (padding 2.0))
    (attach-to menu
               (make <canvas>
                 #:name 'highlight
                 #:painter
                 (with-style ((fill-color red))
                   (fill
                    (rectangle (vec2 0.0 0.0)
                               (fold (lambda (node w)
                                       (max w (width node)))
                                     0.0
                                     nodes)
                               (fold (lambda (node h)
                                       (max h (height node)))
                                     0.0
                                     nodes))))))
    (apply attach-to menu nodes)
    (let loop ((nodes (reverse nodes))
               (prev #f))
      (match nodes
        (() #t)
        ((node . rest)
         (when prev
           (place-above prev node #:padding padding))
         (loop rest node))))
    (set! (item-nodes menu) nodes)
    (select-item menu 0)))

(define-method (select-item (menu <menu>) i)
  (let* ((i (clamp 0 (- (length (items menu)) 1) i))
         (nodes (item-nodes menu)))
    (set! (selected-item menu) i)
    (unless (null? nodes)
      (set! (position-y (& menu highlight))
            (position-y (list-ref nodes i))))))

(define-method (selection (menu <menu>))
  (let ((node (list-ref (item-nodes menu) (selected-item menu))))
    (and node (text node))))

(define-method (up-selection (menu <menu>) n)
  (select-item menu (- (selected-item menu) n)))

(define-method (down-selection (menu <menu>) n)
  (select-item menu (+ (selected-item menu) n)))