#!/usr/local/bin/sbcl --script
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(load #p"~/quicklisp/setup.lisp")
(ql:quickload :qtools)
(ql:quickload :cells)
(ql:quickload :qtcore)
(ql:quickload :qtgui)
(ql:quickload :parse-number)
(ql:quickload :alexandria)
(ql:quickload :anaphora)

(cl:defpackage :tipcalc.models
  (:use :cl :cells)
  (:export
    service-rating fed-tip-calc tip-calc tax-calc item bill meal-expense-calculator
    rating rate cost tip tax kind item subtotal subtotal total))

(in-package :tipcalc.models)

(defmodel service-rating ()
          ((rating :cell t :accessor rating :initarg :rating :initform (c-in :normal))
           (rate   :cell t :accessor rate   :initform (c? (case (rating self)
                                                            (:normal 0.18)
                                                            (:excellent 0.25)
                                                            (:poor 0.15))))))

(defmodel tip-calc ()
          ((cost :cell t :accessor cost :initarg :cost :initform (c-in 0))
           (rate :cell t :accessor rate :initarg :rate :initform (c-in 0.18))
           (tip  :cell t :accessor tip  :initform (c? (* (cost self)
                                                         (rate self))))))
(defmodel fed-tip-calc (tip-calc)
          ((rate-feeder :cell t :accessor rate-feeder :initarg :rate-feeder)
           (rate :cell t :accessor rate :initarg :rate :initform (c? (rate (rate-feeder self))))))


(defmodel tax-calc ()
          ((cost :cell t :accessor cost :initarg :cost :initform (c-in 0))
           (rate :cell t :accessor rate :initarg :rate :initform (c-in 0.18))
           (tax  :cell t :accessor tax  :initform (c? (* (cost self)
                                                         (rate self))))))

(defmodel item ()
          ((kind :cell t :accessor kind :initarg :kind :initform (c-in :food))
           (cost :cell t :accessor cost :initarg :cost :initform (c-in 0))))

(defmodel bill ()
          ((items :accessor items :initarg :items :initform (c-in nil))
           (cost  :accessor cost  :initform (c? (apply #'+
                                                       (loop for item in (items self)
                                                             collect (cost item)))))))

(defmodel meal-expense-calculator ()
          ((subtotal :accessor subtotal :initarg :subtotal :initform (c-in 0))
           (tax      :accessor tax      :initarg :tax      :initform (c-in 0.08))
           (tip      :accessor tip      :initarg :tip      :initform (c-in 0))
           (total    :accessor total    :initform (c? (+   (subtotal self)     
                                                           (* (tax-rate self)
                                                              (subtotal self))
                                                           (tip self))))))

(defpackage tipcalc
  (:use :cl+qt :parse-number :anaphora :tipcalc.models))
(in-package :tipcalc)
(in-readtable :qtools)
;(defparameter *service-rating* (make-instance 'service-rating))
;(defparameter *tip-calc* (make-instance 'tip-calc :rate (rate *service-rating*)))

(define-widget edits (QWidget) ())
(define-widget service-quality (QWidget) ())
(define-widget main-window (QWidget) ())

(define-widget my-slider (QWidget) ())
(define-signal (my-slider val-changed) (float))
(define-subwidget (my-slider slider) (q+:make-qslider my-slider))
(define-subwidget (my-slider label) (q+:make-qlabel my-slider))
(define-subwidget (my-slider layout) (q+:make-qvboxlayout my-slider)
  (q+:add-widget slider)
  (q+:add-widget label))

(define-slot (my-slider slider) ((new-val integer))
  (declare (connected slider (value-changed integer)))
  (setf (q+:text label) (format nil "~a%" new-val))
  (signal! my-slider (val-changed float) (coerce (/ new-val 100) 'float)))

(defmethod set-value ((my-slider my-slider) (new-value float))
  (with-slots-bound (my-slider my-slider)
    (setf (q+:value slider) (round (* new-value 100)))))


(defmacro alambda (&body body)
  `(lambda (it) ,@body))

(defmacro with-no-signals (widget &body body)
  (alexandria:once-only (widget)
    `(progn
       (q+:block-signals ,widget t)
       (unwind-protect
         (progn
           ,@body)
         (q+:block-signals ,widget nil)))))

(defmacro connect-cell-to-widget ((widget sub-widget) (cell class) place widg-value-cb)
  "This connects a widget to an observable cell.  TODO: figure out the macro edge-cases here"
  `(cells:defobserver ,cell ((self ,class)) 
                      ; I want this to run:
                      ; EITHER When the old value is not bound
                      ; OR     When the old value is not equal to the new value
                      (format t "--> changed: ~a is not ~a~%" ,(symbol-name cell) cells:new-value)
                      (with-slots-bound (,widget ,widget)
                        (with-signals-blocked (,sub-widget) 
                          (setf ,place (funcall ,widg-value-cb cells:new-value))))))

(defmacro connect-widget-to-cell ((widget signal arg-type) place &key value-mod)
  (alexandria:with-gensyms (arg)
    `(define-slot (,widget ,signal) ((,arg ,arg-type))
       (declare (connected ,widget (,signal ,arg-type)))
       ,(when value-mod
          `(setf ,arg (funcall ,value-mod ,arg)))
       (setf ,place ,arg))))

(defmacro connecting ((widget sub-widget) (cell-slot-name cell-class) cell-instance &body body)
  `(macrolet ((cell->widget (place cb)
                `(connect-cell-to-widget (,',widget ,',sub-widget) (,',cell-slot-name ,',cell-class) ,place ,cb))
              (signal->cell (signal &key value-mod)
                `(connect-widget-to-cell (,',widget ,@signal) (,',cell-slot-name ,',cell-instance) :value-mod ,value-mod)))
     ,@body))

(defmacro define-connections (&rest connections)
  (list*
    'progn
    (loop for (widg-spec cell-spec cell-inst . body) in connections
          collect `(connecting ,widg-spec ,cell-spec ,cell-inst
                     ,@body))))  

(let* ((s-r (make-instance 'service-rating))
       (tc (make-instance 'tip-calc :rate (cells:c? (rate s-r)))))

  (defun stringify (obj) (format nil "~a" obj))
  (defun make-keyword (str)
    (alexandria:make-keyword (string-upcase str)))

  (define-signal (edits cost-changed)  (float))
  (define-signal (edits rate-changed)  (float))
  (define-signal (edits tip-changed)  (float))

  (define-subwidget (edits cost-widg) (q+:make-qlineedit edits)
    (setf (q+:placeholder-text cost-widg) (stringify (cost tc)))) 

  (connecting (edits cost-widg) (cost tip-calc) tc
    (signal->cell
      (cost-changed float)))

  (define-slot (edits cost-widg) ((new-text string))
    (declare (connected cost-widg (text-edited string)))
    (handler-case
      (let ((num (coerce (parse-number new-text) 'float)))
        (signal! edits (cost-changed float) num))
      ((or parse-error type-error) (c) (declare (ignore c)))))

  (define-subwidget (edits rate-widg) (q+:make-qslider edits)
    (setf (q+:minimum rate-widg) 6)
    (setf (q+:maximum rate-widg) 30)
    (setf (q+:value rate-widg) (round (* 100 (rate s-r)))))


  
  (connecting (edits rate-widg) (rate tip-calc) tc
    (cell->widget
      (q+:value rate-widg)
      (alambda
        (round (* 100 it))))
    (signal->cell
      (rate-changed float))) 


  (define-slot (edits rate-widg) ((new-value integer))
    (declare (connected rate-widg (value-changed integer)))
    (handler-case
      (signal! edits (rate-changed float) (coerce (/ new-value 100) 'float))
      ((or parse-error type-error) (c) (declare (ignore c)))))


  (define-subwidget (edits tip-widg) (q+:make-qlineedit edits)
    (setf (q+:placeholder-text tip-widg) (stringify (tip tc))))

  (connecting (edits tip-widg) (tip tip-calc) tc
    (cell->widget
      (q+:text tip-widg)
      (alambda
        (stringify it))))
  

  (define-subwidget (edits edit-layout) (q+:make-qhboxlayout edits)
    (q+:add-widget edit-layout cost-widg)
    (q+:add-widget edit-layout rate-widg)
    (q+:add-widget edit-layout tip-widg))

  (define-signal (service-quality quality-chosen) (string))

  (define-subwidget (service-quality choose-poor) (q+:make-qradiobutton service-quality)
    (setf (q+:text choose-poor) "Poor"))
  (define-slot (service-quality choose-poor) ()
    (declare (connected choose-poor (toggled bool)))
    (signal! service-quality (quality-chosen string) "poor"))

  (define-subwidget (service-quality choose-normal) (q+:make-qradiobutton service-quality)
    (setf (q+:text choose-normal) "Normal"))
  (define-slot (service-quality choose-normal) ()
    (declare (connected choose-normal (toggled bool)))
    (signal! service-quality (quality-chosen string) "normal"))


  (define-subwidget (service-quality choose-excellent) (q+:make-qradiobutton service-quality)
    (setf (q+:text choose-excellent) "Excellent"))
  (define-slot (service-quality choose-excellent) ()
    (declare (connected choose-excellent (toggled bool)))
    (signal! service-quality (quality-chosen string) "excellent"))

  (connecting (service-quality nil) (rating service-rating) s-r
    (signal->cell
      (quality-chosen string)
      :value-mod (alambda (make-keyword it))))

  (define-subwidget (service-quality quality-layout) (q+:make-qhboxlayout service-quality)
    (q+:add-widget quality-layout choose-poor)
    (q+:add-widget quality-layout choose-normal)
    (q+:add-widget quality-layout choose-excellent))

  (define-subwidget (main-window edits) (make-instance 'edits))
  (define-subwidget (main-window service-quality) (make-instance 'service-quality))
  (define-subwidget (main-window layout) (q+:make-qvboxlayout main-window)
    (q+:add-widget layout service-quality) 
    (q+:add-widget layout edits)))


(defun main ()
  (with-main-window (window (make-instance 'main-window))))

(ql:quickload  :swank)
(swank:create-server :port 4006)
(handler-case (main)
  (sb-sys:interactive-interrupt (c) (declare (ignore c)) (format t "~cExiting on interrupt...~%" #\return)))