  -*- Mode : Lisp ; Syntax : ANSI - Common - Lisp ; Package : CLIM - USER ; Base : 10 ; Lowercase : Yes -*-
;;
;;
;; See the file LICENSE for the full license governing this code.
;;

#-acl86win32
(defpackage :clim-user (:use :clim-silica))

(in-package :clim-user)


(defclass simple-test-sheet (silica::permanent-medium-sheet-output-mixin
			     silica::sheet-multiple-child-mixin
			     silica::sheet-transformation-mixin
			     silica::standard-repainting-mixin
			     silica::immediate-sheet-input-mixin
			     silica::basic-sheet)
  ())

(defmethod sheet-event-queue ((sheet simple-test-sheet)) nil)

(defclass even-simpler (simple-test-sheet) ())

(defun simple-test ()
  (let* ((port (find-port))
	 (graft (find-graft))
	 (sheet (make-instance 'silica::standard-mirrored-sheet
		  :parent graft
		  :region (make-bounding-rectangle 0 0 300 300))))
    (dotimes (i 5)
      (dotimes (j 5)
	(let ((s (make-instance 'simple-test-sheet
		   :parent sheet
		   :region (make-bounding-rectangle 0 0 60 60)
		   :transformation (make-translation-transformation (* i 60) (* j 60)))))
	  (setf (sheet-enabled-p s) t)
	  (let ((s2 (make-instance 'even-simpler
		      :parent s
		      :region (make-bounding-rectangle 0 0 40 40)
		      :transformation (make-translation-transformation 10 10))))
	    (setf (sheet-enabled-p s2) t)))))
    (setf (sheet-enabled-p sheet) t)
    sheet))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-enter-event))
  (outline-sheet sheet)
  (setf (port-keyboard-input-focus (port sheet)) sheet))

(defun outline-sheet (sheet)
  (with-bounding-rectangle* (a b c d) sheet
    (draw-rectangle* sheet
		     a b (1- c) (1- d)
		     :filled nil
		     :ink +flipping-ink+)))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-exit-event))
  (outline-sheet sheet))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-button-event))
  (multiple-value-call #'draw-rectangle*
		       sheet
		       (bounding-rectangle* sheet)
		       :ink +flipping-ink+))

(defmethod handle-event ((sheet simple-test-sheet) (event keyboard-event))
  (draw-line* sheet -200 -200 200 200 :ink +flipping-ink+
	      :line-thickness 10))

(defmethod handle-repaint ((sheet silica::standard-sheet) region)
  (declare (ignore region))
  )

(defmethod handle-repaint ((sheet simple-test-sheet) region)
  (declare (ignore region))
  )

(defmethod handle-repaint ((sheet even-simpler) region)
  (declare (ignore region))
  (multiple-value-call #'draw-rectangle*
		       sheet
		       (bounding-rectangle* sheet)
		       :filled t
		       :ink +red+))

 Syntax : ANSI - Common - Lisp ; Package : CLIM - USER ; Base : 10 ; Lowercase : Yes -*-


 See the file LICENSE for the full license governing this code.


#-acl86win32
(defpackage :clim-user (:use :clim-silica))

(in-package :clim-user)


(defclass simple-test-sheet (silica::permanent-medium-sheet-output-mixin
			     silica::sheet-multiple-child-mixin
			     silica::sheet-transformation-mixin
			     silica::standard-repainting-mixin
			     silica::immediate-sheet-input-mixin
			     silica::basic-sheet)
  ())

(defmethod sheet-event-queue ((sheet simple-test-sheet)) nil)

(defclass even-simpler (simple-test-sheet) ())

(defun simple-test ()
  (let* ((port (find-port))
	 (graft (find-graft))
	 (sheet (make-instance 'silica::standard-mirrored-sheet
		  :parent graft
		  :region (make-bounding-rectangle 0 0 300 300))))
    (dotimes (i 5)
      (dotimes (j 5)
	(let ((s (make-instance 'simple-test-sheet
		   :parent sheet
		   :region (make-bounding-rectangle 0 0 60 60)
		   :transformation (make-translation-transformation (* i 60) (* j 60)))))
	  (setf (sheet-enabled-p s) t)
	  (let ((s2 (make-instance 'even-simpler
		      :parent s
		      :region (make-bounding-rectangle 0 0 40 40)
		      :transformation (make-translation-transformation 10 10))))
	    (setf (sheet-enabled-p s2) t)))))
    (setf (sheet-enabled-p sheet) t)
    sheet))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-enter-event))
  (outline-sheet sheet)
  (setf (port-keyboard-input-focus (port sheet)) sheet))

(defun outline-sheet (sheet)
  (with-bounding-rectangle* (a b c d) sheet
    (draw-rectangle* sheet
		     a b (1- c) (1- d)
		     :filled nil
		     :ink +flipping-ink+)))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-exit-event))
  (outline-sheet sheet))

(defmethod handle-event ((sheet simple-test-sheet) (event pointer-button-event))
  (multiple-value-call #'draw-rectangle*
		       sheet
		       (bounding-rectangle* sheet)
		       :ink +flipping-ink+))

(defmethod handle-event ((sheet simple-test-sheet) (event keyboard-event))
  (draw-line* sheet -200 -200 200 200 :ink +flipping-ink+
	      :line-thickness 10))

(defmethod handle-repaint ((sheet silica::standard-sheet) region)
  (declare (ignore region))
  )

(defmethod handle-repaint ((sheet simple-test-sheet) region)
  (declare (ignore region))
  )

(defmethod handle-repaint ((sheet even-simpler) region)
  (declare (ignore region))
  (multiple-value-call #'draw-rectangle*
		       sheet
		       (bounding-rectangle* sheet)
		       :filled t
		       :ink +red+))
