(in-package :anna)

(defgeneric update (arg0)
  (:documentation "Updates the state of arg0."))

(defgeneric display (arg0 window x y)
  (:documentation "Displays arg0 on the window arg1 at (arg2, arg3)."))(defpackage :anna (:use :cl))
(load "primitives.lisp")
(load "generics.lisp")
(load "prog-bar.lisp")
(load "menu.lisp")

(in-package :anna)

#|(let* ((bar (make-instance 'prog-bar :size 30))
      (menu (make-instance 'menu :items '("one" "two" "three" "longggg"))))
      (screen:with-window
        (loop
           (update menu)
           (unless (update bar)
             (return))
           (display bar screen:*window* 5 5)
           (display menu screen:*window* 6 5)))))|#
(in-package :anna)

(defclass menu ()
  ((items
    :initarg :items
    :initform nil)
   (current
    :initarg :current
    :initform 0)))

(defmethod update ((arg0 menu))
  (with-key
    (cond ((or (equal key #\w) (equal key :UP))
           (unless (< (- (slot-value arg0 'current) 1) 0)
               (decf (slot-value arg0 'current))))
          ((or (equal key #\s) (equal key :DOWN))
           (unless (= (+ (slot-value arg0 'current) 1) (length (slot-value arg0 'items)))
               (incf (slot-value arg0 'current))))
          ((equal key #\Return)
           (if (stringp (elt (slot-value arg0 'items) (slot-value arg0 'current)))
               (elt (slot-value arg0 'items) (slot-value arg0 'current))
               (if (equal "back" (first (elt (slot-value arg0 'items) (slot-value arg0 'current))))
                   (setf (slot-value arg0 'items) (rest (first (elt (slot-value arg0 'items) (slot-value arg0 'current)))))
                   (setf (slot-value arg0 'items)

(defmethod display ((arg0 menu) window x y)
  (dotimes (n (length (slot-value arg0 'items)))
    (if (equal (slot-value arg0 'current) n)
        (with-coordinates (window (+ x (+ n 1)) y)
          (screen:highlight-on window)
          (if (stringp (elt (slot-value arg0 'items) n))
              (format window "~A" (elt (slot-value arg0 'items) n))
              (format window "~A" (first (elt (slot-value arg0 'items) n))))
          (screen:highlight-off window))
        (with-coordinates (window (+ x (+ n 1)) y)
          (if (stringp (elt (slot-value arg0 'items) n))
              (format window "~A" (elt (slot-value arg0 'items) n))
              (format window "~A" (first (elt (slot-value arg0 'items) n))))))))(in-package :anna)

(defun string-n-times (s n &optional o)
  (if (equal n 1)
         s
         (if (equal nil o)
             (string-n-times (concatenate 'string s s) (- n 1) s)
             (string-n-times (concatenate 'string s o) (- n 1) o))))

(defun get-key ()
  (ext:with-keyboard
    (let ((key (read-char ext:*keyboard-input*)))
      (or
       (ignore-errors (character key))
       (ignore-errors (ext:char-key key))))))

(defmacro with-key (&body body)
  `(let* ((key (get-key)))
     ,@body))

(defmacro with-coordinates ((window x y) &body body)
  `(let* ((old-pos (multiple-value-list (screen:window-cursor-position ,window))))
     (screen:set-window-cursor-position ,window ,x ,y)
     ,@body
     (screen:set-window-cursor-position ,window (car old-pos) (second old-pos))))
(in-package :anna)

(defclass prog-bar ()
    ((total-steps
      :initarg :total-steps
      :initform 10)
     (current-step
      :initarg :current-step
      :initform 0)
     (size
      :initarg :size
       :initform 10)))

(defmethod update ((arg0 prog-bar))
  (if (= (slot-value arg0 'current-step) (slot-value arg0 'total-steps))
      nil
      (incf (slot-value arg0 'current-step))))

(defmethod display ((arg0 prog-bar) window x y)
  (let* ((open "[")
         (done (string-n-times "#"
                               (floor (* (/ (slot-value arg0 'current-step) (slot-value arg0 'total-steps)) (slot-value arg0 'size)))))
         (left (string-n-times "."
                               (- (slot-value arg0 'size) (length done))))
         (close "]"))
    (with-coordinates (window x y)
      (format window "~A" (concatenate 'string open done left close)))))