source: branches/easygui/ccl/examples/cocoa/easygui/new-cocoa-bindings.lisp @ 7347

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

Initial work on an interface to selections in text fields.

NB: Not entirely working yet.

File size: 2.4 KB
Line 
1(in-package :easygui)
2
3(defclass eg-point ()
4     ((x :initarg :x :reader point-x)
5      (y :initarg :y :reader point-y)))
6
7(defun point (x y)
8  (assert (>= x 0))
9  (assert (>= y 0))
10  (make-instance 'eg-point :x x :y y))
11
12(defclass eg-range ()
13     ((start :initarg :start :reader range-start)
14      (end :initarg :end :reader range-end)))
15
16(defun range (start end)
17  (assert (>= end start))
18  (make-instance 'eg-range :start start :end end))
19
20(defun range-nsrange (range)
21  (ns:make-ns-range (range-start range) (range-end range)))
22
23(defclass easy-cocoa-object ()
24     ((ref :accessor cocoa-ref)))
25
26(defvar *window-position-default-x* 200)
27(defvar *window-position-default-y* 200)
28(defvar *window-size-default-x* 200)
29(defvar *window-size-default-y* 200)
30
31(defun ns-rect-from-points (posn size)
32  (ns:make-ns-rect (point-x posn) (point-y posn)
33                   (point-x size) (point-y size)))
34
35(defparameter *flag-to-mask-alist*
36              `( ;; (:zoomable-p . #$NSZoomableWindowMask) ; doesn't work
37                (:minimizable-p . ,#$NSMiniaturizableWindowMask)
38                (:resizable-p . ,#$NSResizableWindowMask)
39                (:closable-p . ,#$NSClosableWindowMask)))
40
41(defun flag-mask (keyword enabled-p)
42  (if enabled-p
43      (or (cdr (assoc keyword *flag-to-mask-alist*)) 0)
44      0))
45
46(defparameter *key-to-mask-alist*
47              `((:control . ,#$NSControlKeyMask)
48                (:alt     . ,#$NSAlternateKeyMask)
49                (:command . ,#$NSCommandKeyMask)))
50
51(defun key-mask (keyword)
52  (or (cdr (assoc keyword *key-to-mask-alist*)) 0))
53
54;;; debug macro for #/ funcalls:
55
56(defvar *debug-cocoa-calls* t)
57
58(defmacro dcc (form)
59  `(progn
60     (when *debug-cocoa-calls*
61       (format *trace-output* "Calling ~A on ~S~%"
62               ',(first form) (list ,@(rest form))))
63     ,form))
64
65;;; Running things on the main thread:
66
67(defclass cocoa-thunk (ns:ns-object)
68     ((thunk :accessor thunk-of))
69  (:metaclass ns:+ns-object))
70
71(objc:defmethod (#/run :void) ((self cocoa-thunk))
72  (funcall (thunk-of self)))
73
74(defun run-on-main-thread (waitp thunk)
75  (let ((thunk* (make-instance 'cocoa-thunk)))
76    (setf (thunk-of thunk*) thunk)
77    (#/performSelectorOnMainThread:withObject:waitUntilDone:
78     thunk*
79     (@selector #/run)
80     +null-ptr+
81     (not (not waitp)))))
82
83(defmacro running-on-main-thread ((&key (waitp t)) &body body)
84  `(run-on-main-thread ,waitp (lambda () ,@body)))
Note: See TracBrowser for help on using the repository browser.