source: trunk/ccl/examples/cocoa/easygui/new-cocoa-bindings.lisp @ 7499

Last change on this file since 7499 was 7499, checked in by af, 13 years ago

Implement mouse event methods for drawing views.

  • Print method for points
  • redisplay method
  • Update tiny.lisp to provide mouse handler example: drag up to increase Number of points, down to decrease it.
File size: 3.3 KB
Line 
1(in-package :easygui)
2
3;;; Helper types:
4
5;;; point:
6(defclass eg-point ()
7     ((x :initarg :x :reader point-x)
8      (y :initarg :y :reader point-y)))
9
10(defun point (x y)
11  (assert (>= x 0))
12  (assert (>= y 0))
13  (make-instance 'eg-point :x x :y y))
14
15(defmethod print-object ((o eg-point) s)
16  (print-unreadable-object (o s :identity nil :type t)
17    (format s "(~,2,F/~,2,F)" (point-x o) (point-y o))))
18
19;;; range:
20(defclass eg-range ()
21     ((start :initarg :start :reader range-start)
22      (end :initarg :end :reader range-end)))
23
24(defun range (start end)
25  (assert (>= end start))
26  (make-instance 'eg-range :start start :end end))
27
28(defun range-nsrange (range)
29  (ns:make-ns-range (range-start range) (range-end range)))
30
31(defclass eg-rectangle ()
32     ((x :initarg :x :reader rectangle-x)
33      (y :initarg :y :reader rectangle-y)
34      (width :initarg :width :reader rectangle-width)
35      (height :initarg :height :reader rectangle-height)))
36
37(defun rectangle (x y width height)
38  (assert (>= x 0))
39  (assert (>= y 0))
40  (assert (>= width 0))
41  (assert (>= height 0))
42  (make-instance 'eg-rectangle :x x :y y :width width :height height))
43
44(defun rectangle-nsrect (r)
45  (ns:make-ns-rect (rectangle-x r) (rectangle-y r)
46                   (rectangle-width r) (rectangle-height r)))
47
48(defun nsrect-rectangle (r)
49  (rectangle (ns:ns-rect-x r) (ns:ns-rect-y r)
50             (ns:ns-rect-width r) (ns:ns-rect-height r)))
51
52;;;
53(defclass easy-cocoa-object ()
54     ((ref :initarg :cocoa-ref :accessor cocoa-ref)))
55
56(defvar *window-position-default-x* 200)
57(defvar *window-position-default-y* 200)
58(defvar *window-size-default-x* 200)
59(defvar *window-size-default-y* 200)
60
61(defun ns-rect-from-points (posn size)
62  (ns:make-ns-rect (point-x posn) (point-y posn)
63                   (point-x size) (point-y size)))
64
65(defparameter *flag-to-mask-alist*
66              `( ;; (:zoomable-p . #$NSZoomableWindowMask) ; doesn't work
67                (:minimizable-p . ,#$NSMiniaturizableWindowMask)
68                (:resizable-p . ,#$NSResizableWindowMask)
69                (:closable-p . ,#$NSClosableWindowMask)))
70
71(defun flag-mask (keyword enabled-p)
72  (if enabled-p
73      (or (cdr (assoc keyword *flag-to-mask-alist*)) 0)
74      0))
75
76(defparameter *key-to-mask-alist*
77              `((:control . ,#$NSControlKeyMask)
78                (:alt     . ,#$NSAlternateKeyMask)
79                (:command . ,#$NSCommandKeyMask)))
80
81(defun key-mask (keyword)
82  (or (cdr (assoc keyword *key-to-mask-alist*)) 0))
83
84;;; debug macro for #/ funcalls:
85
86(defvar *debug-cocoa-calls* t)
87
88(defmacro dcc (form)
89  `(progn
90     (when *debug-cocoa-calls*
91       (format *trace-output* "Calling ~A on ~S~%"
92               ',(first form) (list ,@(rest form))))
93     ,form))
94
95;;; Running things on the main thread:
96
97(defclass cocoa-thunk (ns:ns-object)
98     ((thunk :accessor thunk-of))
99  (:metaclass ns:+ns-object))
100
101(objc:defmethod (#/run :void) ((self cocoa-thunk))
102  (funcall (thunk-of self)))
103
104(defun run-on-main-thread (waitp thunk)
105  (let ((thunk* (make-instance 'cocoa-thunk)))
106    (setf (thunk-of thunk*) thunk)
107    (#/performSelectorOnMainThread:withObject:waitUntilDone:
108     thunk*
109     (@selector #/run)
110     +null-ptr+
111     (not (not waitp)))))
112
113(defmacro running-on-main-thread ((&key (waitp t)) &body body)
114  `(run-on-main-thread ,waitp (lambda () ,@body)))
115
116;;; Getting views from objc objects:
117
118(defgeneric easygui-view-of (cocoa-view))
Note: See TracBrowser for help on using the repository browser.