| 1 | ;;; Another example:
|
|---|
| 2 | ;;; This one creates a full-window view and draws in it.
|
|---|
| 3 | ;;; This is the easygui equivalent of examples/cocoa/tiny.lisp.
|
|---|
| 4 |
|
|---|
| 5 | (in-package :easygui-demo) ; In user code, this might be easygui-user
|
|---|
| 6 |
|
|---|
| 7 | (defclass tiny-demo-drawing-view (drawing-view) ()
|
|---|
| 8 | (:default-initargs :accept-key-events-p t))
|
|---|
| 9 |
|
|---|
| 10 | (defconstant short-pi (coerce pi 'short-float))
|
|---|
| 11 | (defparameter numsides 12)
|
|---|
| 12 |
|
|---|
| 13 | (defmethod draw-view-rectangle ((view tiny-demo-drawing-view) rectangle)
|
|---|
| 14 | (declare (ignore rectangle))
|
|---|
| 15 | (let* ((view (cocoa-ref view))
|
|---|
| 16 | (bounds (#/bounds view))
|
|---|
| 17 | (width (ns:ns-rect-width bounds))
|
|---|
| 18 | (height (ns:ns-rect-height bounds)))
|
|---|
| 19 | (macrolet ((X (tt) `(* (1+ (sin ,tt)) width 0.5))
|
|---|
| 20 | (Y (tt) `(* (1+ (cos ,tt)) height 0.5)))
|
|---|
| 21 | ;; Fill the view with white
|
|---|
| 22 | (#/set (#/whiteColor ns:ns-color))
|
|---|
| 23 | ;; Trace two polygons with N sides and connect all of the vertices
|
|---|
| 24 | ;; with lines
|
|---|
| 25 | (#/set (#/blackColor ns:ns-color))
|
|---|
| 26 | (loop
|
|---|
| 27 | for f from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
|
|---|
| 28 | do (loop
|
|---|
| 29 | for g from 0.0 below (* 2 short-pi) by (* 2 (/ short-pi numsides))
|
|---|
| 30 | do (#/strokeLineFromPoint:toPoint:
|
|---|
| 31 | ns:ns-bezier-path
|
|---|
| 32 | (ns:make-ns-point (X f) (Y f))
|
|---|
| 33 | (ns:make-ns-point (X g) (Y g))))))))
|
|---|
| 34 |
|
|---|
| 35 | (defclass tiny-demo-window (window) ()
|
|---|
| 36 | (:default-initargs :size (point 400 400)
|
|---|
| 37 | :position (point 100 350)
|
|---|
| 38 | :title "Tiny rectangle drawing demo"
|
|---|
| 39 | :resizable-p nil
|
|---|
| 40 | :minimizable-p t))
|
|---|
| 41 |
|
|---|
| 42 | (defmethod initialize-view :after ((window tiny-demo-window))
|
|---|
| 43 | (let ((draw-view (make-instance 'tiny-demo-drawing-view)))
|
|---|
| 44 | (setf (content-view window) draw-view)
|
|---|
| 45 | (window-show window)))
|
|---|
| 46 |
|
|---|
| 47 | ;;; Mouse handling:
|
|---|
| 48 | ;;; (Drag up to increase number of points, down to decrease)
|
|---|
| 49 | (defvar *original-point* nil)
|
|---|
| 50 |
|
|---|
| 51 | (defmethod mouse-down ((view tiny-demo-drawing-view) &key location
|
|---|
| 52 | &allow-other-keys)
|
|---|
| 53 | (setf *original-point* location))
|
|---|
| 54 |
|
|---|
| 55 | (defmethod mouse-up ((view tiny-demo-drawing-view) &key location
|
|---|
| 56 | &allow-other-keys)
|
|---|
| 57 | (when *original-point*
|
|---|
| 58 | (cond ((> (point-y location) (point-y *original-point*))
|
|---|
| 59 | (incf numsides))
|
|---|
| 60 | ((< (point-y location) (point-y *original-point*))
|
|---|
| 61 | (decf numsides)))
|
|---|
| 62 | (redisplay view)))
|
|---|
