(defun make-point (x y)
  (set-x (set-y (make-instance 'point) y) x))

(defclass combobox (picture)
  ())

(defmethod initialize-instance ((cb combobox) &key)
  (call-next-method)
  (let ((frame (set-items (make-instance 'polygon)
                          (list (make-point 0 0)
                                (make-point 0 10)
                                (make-point 50 10)
                                (make-point 50 0))))
        (button (set-items (make-instance 'polygon)
                           (list (make-point 50 0)
                                 (make-point 50 10)
                                 (make-point 60 10)
                                 (make-point 60 0))))
        (button-symb (set-items (make-instance 'polygon)
                                (list (make-point 52 3)
                                      (make-point 55 7)
                                      (make-point 58 3)))))

    (set-color (set-filledp button-symb T) :black)
    (set-color (set-filledp button T) :gray)
    (set-color (set-filledp frame T) :white)
    

    (set-items cb (list (move (make-instance 'text-shape) 5 5)
                        frame                         
                        (set-items (make-instance 'picture) (list button-symb button))
                        (set-visible (set-anchor (make-instance 'item-list) (make-point 0 10)) nil)
                        ))

    (scale cb 2 (make-point 0 0))
    ))

(defmethod button ((cb combobox))
  (third (items cb)))

(defmethod cbtext ((cb combobox))
  (first (items cb)))

(defmethod itemlist ((cb combobox))
  (fourth (items cb)))


(defmethod left ((li list-item))
  (x (first (items (second (items li))))))

(defmethod top ((li list-item))
  (y (first (items (second (items li))))))

(defmethod bottom ((li list-item))
  (y (third (items (second (items li))))))

(defmethod right ((li list-item))
  (x (third (items (second (items li))))))

(defmethod index ((li list-item))
  (slot-value li 'index))

(defmethod set-index ((li list-item) val)
  (setf (slot-value li 'index) val))


(defclass list-item (picture)
  ((index :initform 0)))

(defmethod ev-mouse-down ((li list-item) sender origin button position)
  (send-event li 'ev-mouse-down li button position))

(defmethod initialize-instance ((li list-item)&key)
  (call-next-method)
  (let ((frame (set-items (make-instance 'polygon)
                          (list (make-point 0 0)
                                (make-point 0 20)
                                (make-point 100 20)
                                (make-point 100 0))))
        (text (move (make-instance 'text-shape) 10 10)))

    (set-color (set-filledp frame T) :white)
    (set-text text "pokus")
    (set-items li (list text frame))))

(defmethod text-shape ((li list-item))
  (first (items li)))

(defclass item-list (picture)
  ((visible :initform T)
   (anchor :initform (make-point 0 0))
   ))

(defmethod set-anchor ((il item-list) point)
  (setf (slot-value il 'anchor) point)
  il)

(defmethod anchor ((il item-list))
  (slot-value il 'anchor))


(defmethod set-visible ((il item-list) val)
  (with-change (il 'set-visible val)
    (setf (slot-value il 'visible) val))
  il)

(defmethod visible ((il item-list))
  (slot-value il 'visible))

(defmethod do-draw ((il item-list))
  (if (visible il)
      (call-next-method)))


(defmethod do-move ((il item-list) x y)
  (move (anchor il) x y)
  )

(defmethod do-scale ((il item-list) x y)
  (scale (anchor il) x y)
  )


(defmethod check-item ((il item-list) item)
  (unless (typep item 'list-item)
    (error "Invalid item-list element type.")))

(defmethod do-set-items ((il item-list) items)
  (call-next-method)
  (arrange-items il)
)

(defmethod arrange-items ((il item-list))
  
  (let ((last-bottom (y (anchor il))))
    (loop for li in (items il) 
          for i from 0
          do
          (move li
                (- (left li))
                (- (top li)))
          (move li (x (anchor il)) last-bottom)
          (set-index li i)
          (setf last-bottom (bottom li)))))


(defmethod contains-point-p ((shape item-list) point)
  (if (visible shape) (call-next-method)))


(defun make-list-item (text)
  (let ((res (make-instance 'list-item)))
    (set-text (text-shape res) text)
    res))


;;;; (defmethod mouse-down ((p picture) button position)
;;;;   (let ((item (find-if (lambda (it) 
;;;; 			 (contains-point-p it position)) 
;;;; 		       (items p))))
;;;;     (when item
;;;;       (mouse-down item button position))))

;(defmethod initialize-event ((cb combobox))
;  (add-event cb 'ev-mouse-down))

(defmethod ev-mouse-down ((cb combobox) sender origin button position)
  (cond ((equal sender (button cb))
         (set-visible (itemlist cb)
                      (not (visible (itemlist cb)))))
        ((equal sender (itemlist cb))
         (set-text (cbtext cb) (text (text-shape origin)))
         (set-visible (itemlist cb) nil)
         (send-event cb 'ev-item-selected origin))))



(defclass color-changing-window (window)
  ((cb :initform (move (make-instance 'combobox)  30 30))))


(defmethod cb ((ccw color-changing-window))
  (slot-value ccw 'cb))

(defmethod ev-item-selected-cb1 ((ccw color-changing-window) sender item)
  (cond 
   ((= (index item) 0) (set-background ccw :yellow))
   ((= (index item) 1) (set-background ccw :green))
   ((= (index item) 2) (set-background ccw :red))
   ((= (index item) 3) (set-background ccw :blue))
   ((= (index item) 4) (set-background ccw :purple))
   ((= (index item) 5) (set-background ccw :brown))))
;; slo by sice napsat 
;; (set-background ccw (nth (index item) (list ...)))
;; ale nechame to pro prehlednost takto

(defmethod initialize-instance ((ccw color-changing-window)&key)
  (call-next-method)

  (set-background ccw :black)

  (set-items (itemlist (cb ccw)) (mapcar #'make-list-item 
                                         (list "yellow"
                                               "green"
                                               "red"
                                               "blue"
                                               "purple"
                                               "brown")))

  (set-shape ccw (cb ccw))
  (add-event (cb ccw) '(ev-item-selected ev-item-selected-cb1)))

(make-instance 'color-changing-window)