-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy pathplotter-windows.lisp
224 lines (205 loc) · 10.3 KB
/
plotter-windows.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
(in-package :plotter)
;; ------------------------------------------
(defmethod plotter-pane-of (name &optional args)
;; allow for symbolic names in place of plotter-windows or
;; plotter-panes. Names must match under EQUALP (i.e., case
;; insensitive strings, symbols, numbers, etc.)
(apply 'wset name (append args *default-args*)))
;; -------------------------------------
(defun locate-plotter-window (name)
(find name (capi:collect-interfaces 'plotter-window)
:test #'equalp
:key #'capi:capi-object-name))
;; --------------------------------------
(defun find-named-plotter-pane (name)
;; locate the named plotter window and return its plotter-pane object
(let ((win (locate-plotter-window name)))
(and win
(plotter-pane-of win))))
;; ---------------------------------------------------------------
(defclass plotter-window (capi:interface)
((drawing-area :accessor drawing-area :initarg :drawing-area)))
(defmethod plotter-pane-of ((intf plotter-window) &optional args)
(declare (ignore args))
(drawing-area intf))
(defmethod display-cursor-readout ((intf plotter-window) name x y)
(setf (capi:interface-title intf)
(format nil "~A x = ~,6g y = ~,6g"
name x y)))
(defun make-plotter-window (&key
(name 0)
(title "Plot")
(fg :black)
(bg :white)
(foreground fg)
(background bg)
(xsize 400)
(ysize 300)
xpos
ypos
(best-width xsize)
(best-height ysize)
(best-x xpos)
(best-y ypos)
(visible-min-width (/ xsize 2))
(visible-min-height (/ ysize 2))
(visible-max-width (* xsize 2))
(visible-max-height (* ysize 2))
cursor
full-crosshair
window-styles
window-class
(left-margin +left-inset+)
(top-margin +top-inset+)
(right-margin +right-inset+)
(bottom-margin +bottom-inset+)
box
move-augmentation
click-augmentation)
(let ((pane (make-instance 'articulated-plotter-pane
:name name
:background background
:foreground foreground
:nominal-width best-width
:nominal-height best-height
:visible-min-width visible-min-width
:visible-max-width visible-max-width
:visible-min-height visible-min-height
:visible-max-height visible-max-height
:cursor cursor
:full-crosshair full-crosshair
:move-augmentation move-augmentation
:click-augmentation click-augmentation
:xsize xsize
:ysize ysize
:left-margin left-margin
:top-margin top-margin
:right-margin right-margin
:bottom-margin bottom-margin
:box box
)))
(make-instance window-class
:name name
:title title
:drawing-area pane
;; :window-styles '(:internal-borderless)
:layout (make-instance 'capi:simple-layout
:description (list pane))
:menu-bar-items
(list
(make-instance 'capi:menu
:title "Pane"
:items (list
(make-instance 'capi:menu-item
:text "Copy"
:callback 'copy-image-to-clipboard
:accelerator "accelerator-c")
(make-instance 'capi:menu-item
:text "Save as..."
:callback 'save-image-from-menu
:accelerator "accelerator-s")
(make-instance 'capi:menu-item
:text "Print..."
:callback 'print-plotter-pane
:accelerator "accelerator-p"))
:callback-type :data
:callback-data-function (constantly pane)))
:visible-min-width #-:WIN32 visible-min-width #+:WIN32 (+ visible-min-width 4)
:visible-max-width #-:WIN32 visible-max-width #+:WIN32 (+ visible-max-width 4)
:visible-min-height #-:WIN32 visible-min-height #+:WIN32 (+ visible-min-height 4)
:visible-max-height #-:WIN32 visible-max-height #+:WIN32 (+ visible-max-height 4)
:best-width #-:WIN32 best-width #+:WIN32 (+ best-width 4)
:best-height #-:WIN32 best-height #+:WIN32 (+ best-height 4)
:best-x best-x
:best-y best-y
:window-styles window-styles)
))
;; ------------------------------------------
(defvar *plotter-window-class* 'plotter-window)
(defun window (name &key
(title (format nil "~A" name))
(background #.(color:make-gray 1))
(foreground #.(color:make-gray 0))
(width 400)
(height 300)
(xsize width)
(ysize height)
x
y
(xpos x)
(ypos y)
(best-width xsize)
(best-height ysize)
(best-x xpos)
(best-y ypos)
(visible-min-width (/ xsize 2))
(visible-min-height (/ ysize 2))
(visible-max-width (* xsize 2))
(visible-max-height (* ysize 2))
(cursor (or *cross-cursor*
:crosshair))
full-crosshair
(window-styles '(:internal-borderless))
(window-class *plotter-window-class*)
(left-margin +left-inset+)
(top-margin +top-inset+)
(right-margin +right-inset+)
(bottom-margin +bottom-inset+)
box
&allow-other-keys)
(wclose name)
(let* ((intf (make-plotter-window
:name name
:title title
:best-width best-width
:best-height best-height
:visible-min-width visible-min-width
:visible-min-height visible-min-height
:visible-max-width visible-max-width
:visible-max-height visible-max-height
:best-x best-x
:best-y best-y
:background background
:foreground foreground
:cursor cursor
:full-crosshair full-crosshair
:window-styles window-styles
:window-class window-class
:left-margin left-margin
:top-margin top-margin
:right-margin right-margin
:bottom-margin bottom-margin
:box box
))
(pane (drawing-area intf)))
(capi:display intf)
pane))
;; ------------------------------------------
(defun wset (name &rest args &key clear &allow-other-keys)
;; If window exists don't raise it to the top.
;; If window does not exist then create it with default parameters.
;; Return the plotting pane object
(let ((pane (or (find-named-plotter-pane name)
(apply #'window name (append args *default-args*))))) ;; locate existing or create anew
(when clear
(clear pane))
pane))
;; ------------------------------------------
(defun wshow (name &rest args &key clear &allow-other-keys)
;; If window exists then raise it to the top.
;; If window does not exist then create it with default parameters
(let* ((pane (or (find-named-plotter-pane name)
(apply #'window name (append args *default-args*)))) ;; locate existing or create anew
(intf (capi:top-level-interface pane)))
(capi:execute-with-interface intf
#'capi:raise-interface intf)
(when clear
(clear pane))
pane))
;; ------------------------------------------
(defun wclose (name)
;; if window exists then ask it to commit suicide and disappear
(let ((intf (locate-plotter-window name)))
(when intf
(capi:execute-with-interface intf #'capi:destroy intf))
))