(in-package :cg-user)

(require :acache "acache-2.1.12.fasl")

(use-package :db.ac)

(open-file-database "theater" ;; names local directory
    :if-does-not-exist :create
                    :if-exists :supersede)

(defclass performance () 
  ((date :initarg :date :index :any :accessor perf-date) 
   (time :initarg :time :accessor perf-time) 
   (available :initarg :unsold :initform 100 :accessor perf-unsold) 
   (sold :initarg :sold :initform 0 :accessor perf-sold) 
   (event-title :initarg :event-title :index :any :accessor perf-event-title))
  (:metaclass persistent-class))

(make-instance 'performance :date "20101010" :time "2000" :event-title "Rolling Stones")
(make-instance 'performance :date "20101010" :time "1400" :event-title "Rolling Stones")
(make-instance 'performance :date "20101101" :time "1900" :event-title "Joan Rivers")

(defun sell (perf-title perf-date perf-time number)
  (let* ((perf-title-set (retrieve-from-index 'performance 'event-title perf-title :all t))
                        perf avail sold)
         (setq perf (dolist (i perf-title-set)
                      (if (and (string-equal (perf-date i) perf-date)
                               (string-equal (perf-time i) perf-time))
                          (return i))))
    (if (null perf) (error "no such performance with that title, date, and time"))
    (setq avail (perf-unsold perf))
    (setq sold (perf-sold perf))
    (if (<= number avail)
        (progn (setf (perf-unsold perf) (- avail number))
          (setf (perf-sold perf) (+ sold number)))
      (error "only ~d tickets available, cannot sell ~d" avail number))))

(defclass performance () 
  ((date :initarg :date :index :any :accessor perf-date) 
   (time :initarg :time :accessor perf-time) 
   (unsold :initarg :unsold :initform 100 :accessor perf-unsold) 
   (sold :initarg :sold :initform 0 :accessor perf-sold) 
   (event-title :initarg :event-title :index :any :accessor perf-event-title)
   (perf-id :initarg :perf-id :index :any-unique :accessor perf-id))
  (:metaclass persistent-class))

(doclass (i 'performance)
         (format t "title ~s, date ~s, time ~s ~%" (perf-event-title i) (perf-date i) (perf-time i))
         (setf (perf-id i) (read)))

(defun get-perf (id)
  (retrieve-from-index 'performance 'perf-id id))

(defun sell (perf-id number)
  (let* ((perf (retrieve-from-index 'performance 'perf-id perf-id))
         (avail (perf-unsold perf))
         (sold (perf-sold perf)))
    (if (<= number avail)
        (progn (setf (perf-unsold perf) (- avail number))
          (setf (perf-sold perf) (+ sold number)))
      (error "only ~d tickets available, cannot sell ~d" avail number))))

(defun sell (perf-id number)
  (let* ((perf (retrieve-from-index 'performance 'perf-id perf-id))
         (avail (perf-unsold perf))
         (sold (perf-sold perf)))
    (if (<= number avail)
        (progn 
          (loop
            (if (with-transaction-restart ()
                  (rollback)
                  (setf (perf-unsold perf) (- avail number))
                  (setf (perf-sold perf) (+ sold number))
                  (commit)) (return t))))
      (error "only ~d tickets available, cannot sell ~d" avail number))))


(setq serv (start-server "theater" nil))
(setq port (netdb-port serv))

(open-network-database "localhost" port)

(setq ic (create-index-cursor 'performance 'event-title))

(setq *perfs* (let (res)
                (doclass (i 'performance) (push i res))
                res))

(make-window :test
  :class 'object-editor
  :scrollbars :vertical
  :exterior (make-box-relative
             60 60 700
             
             ;; This dialog height will be overridden
             ;; by a computed height that makes
             ;; all of the widgets fit vertically.
             600)
  
  ;; A layout-spacing object can be used to override some of
  ;; the default spacing parameters.
  :layout-spacing (make-instance 'layout-spacing
                    :layout-widget-spacing 4   ;; this is the default
                    :layout-outer-margin 12)
  
  ;; Change this value to t to include a special grid at the bottom
  ;; of the object-editor dialog that lists all of the edited class'
  ;; instances.
  :include-table-of-all-instances t
  
  ;; You can pass any subset of these standard buttons here.
  ;; Or you could add your own widgets that call the exported
  ;; functions that these built-in buttons call.
  :command-buttons
  '(:first-button :previous-button :next-button :last-button
                  :select-button :search-button
                  :save-button :revert-button 
                  :commit-button :rollback-button)
  
  ;; This dialog will edit instances.
  :edited-class 'performance
  :edited-instances *perfs*
  
  ;; This tells the dialog to edit a specific set of patient instances.
  ;; Alternative:  Comment out this line to edit all instances
  ;; (which would require an AllegroCache database so that
  ;; all instances can be found).
    
  ;; Each entry in the large edited-slots property will create
  ;; a widget to edit the value in the named slot.
  :edited-slots
  `(
    (event-title :edited-type (:variable-char))
    (perf-id :edited-type (:variable-char))
    (date :edited-type (:variable-char)
               :width 200
               :label "Date")
    (time :edited-type (:variable-char)
               :width 200
               :label "Time")

    (unsold :edited-type (:fixed-numeric 4 0)
                   :label "Unsold")
    (sold :edited-type (:fixed-numeric 4 0)
                    :label "Sold")
        
    ))