1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <h/kernel.h>
36 #include <h/graphics.h>
37 #include <math.h>
38
39 static status orientationGraphical(Graphical gr, Name orientation);
40 static Point getCenterGraphical(Graphical gr);
41 static status updateHideExposeConnectionsGraphical(Graphical gr);
42 static Any getContainerGraphical(Any gr);
43
44
45 /********************************
46 * CREATE/DESTROY *
47 ********************************/
48
49
50 status
initialiseGraphical(Any obj,Int x,Int y,Int w,Int h)51 initialiseGraphical(Any obj, Int x, Int y, Int w, Int h)
52 { Graphical gr = obj;
53 Class class = classOfObject(gr);
54
55 assign(gr, displayed, OFF);
56 assign(gr, area, newObject(ClassArea, EAV));
57 assign(gr, selected, OFF);
58 assign(gr, name, class->name);
59 assign(gr, inverted, OFF);
60 assign(gr, active, ON);
61 obtainClassVariablesObject(obj);
62
63 if ( class->solid == ON )
64 setFlag(gr, F_SOLID);
65
66 setArea(gr->area, x, y, w, h);
67 succeed;
68 }
69
70
71 status
unlinkGraphical(Graphical gr)72 unlinkGraphical(Graphical gr)
73 { if ( notNil(gr->layout_interface) )
74 freeObject(gr->layout_interface); /* another message? */
75
76 /* very dubious, but it can't */
77 /* be in class dialog_item */
78 if ( onFlag(gr, F_ATTRIBUTE) || instanceOfObject(gr, ClassDialogItem) )
79 { aboveGraphical(gr, NIL);
80 belowGraphical(gr, NIL);
81 rightGraphical(gr, NIL);
82 leftGraphical(gr, NIL);
83 }
84
85 disconnectGraphical(gr, DEFAULT, DEFAULT, DEFAULT, DEFAULT);
86 DeviceGraphical(gr, NIL);
87
88 succeed;
89 }
90
91
92 status
copyGraphical(Any obj1,Any obj2)93 copyGraphical(Any obj1, Any obj2)
94 { Graphical gr1 = obj1;
95 Graphical gr2 = obj2;
96
97 copyArea(gr1->area, gr2->area);
98 /*assign(gr1, device, gr2->device); very dubious */
99 assign(gr1, pen, gr2->pen);
100 assign(gr1, texture, gr2->texture);
101 assign(gr1, handles, gr2->handles);
102 assign(gr1, selected, gr2->selected);
103 assign(gr1, inverted, gr2->inverted);
104 assign(gr1, displayed, gr2->displayed);
105 assign(gr1, colour, gr2->colour);
106 assign(gr1, cursor, gr2->cursor);
107 assign(gr1, name, gr2->name);
108
109 succeed;
110 }
111
112 /********************************
113 * CONVERT *
114 ********************************/
115
116 static Graphical
getConvertGraphical(Class class,Any obj)117 getConvertGraphical(Class class, Any obj)
118 { Graphical gr;
119
120 if ( isObject(obj) &&
121 hasGetMethodObject(obj, NAME_image) &&
122 (gr = get(obj, NAME_image, EAV)) &&
123 instanceOfObject(gr, ClassGraphical) )
124 answer(gr);
125
126 fail;
127 }
128
129
130 /********************************
131 * DISPLAY/ERASE *
132 ********************************/
133
134
135 static status
displayOnGraphical(Graphical gr,Device dev)136 displayOnGraphical(Graphical gr, Device dev)
137 { TRY( DeviceGraphical(gr, dev) );
138
139 return DisplayedGraphical(gr, ON);
140 }
141
142
143 status
DeviceGraphical(Any obj,Device dev)144 DeviceGraphical(Any obj, Device dev)
145 { Graphical gr = obj;
146
147 if ( gr->device == dev )
148 succeed;
149
150 return qadSendv(obj, NAME_device, 1, (Any *) &dev);
151 }
152
153 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
154 We do a bit of checking here as this code is often called bypassing the
155 message-passing checking and we want more graceful crashes of something
156 bad happens.
157 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
158
159 status
deviceGraphical(Any obj,Device dev)160 deviceGraphical(Any obj, Device dev)
161 { Graphical gr = obj;
162
163 if ( isNil(dev->graphicals) )
164 return errorPce(dev, NAME_notInitialised);
165 if ( !isObject(obj) || isFreedObj(obj) )
166 return errorPce(PCE, NAME_freedObject, obj);
167
168 if ( notNil(gr->device) )
169 qadSendv(gr->device, NAME_erase, 1, (Any *) &gr);
170
171 if ( notNil(dev) )
172 appendDevice(dev, gr);
173
174 succeed;
175 }
176
177
178 status
reparentGraphical(Graphical gr)179 reparentGraphical(Graphical gr)
180 { if ( notNil(gr->connections) )
181 { Cell cell;
182
183 for_cell(cell, gr->connections)
184 updateDeviceConnection(cell->value);
185 }
186
187 succeed;
188 }
189
190
191 status
DisplayedGraphical(Any obj,BoolObj val)192 DisplayedGraphical(Any obj, BoolObj val)
193 { Graphical gr = obj;
194
195 if ( gr->displayed != val )
196 qadSendv(obj, NAME_displayed, 1, (Any *)&val);
197
198 succeed;
199 }
200
201
202 status
displayedGraphical(Any obj,BoolObj val)203 displayedGraphical(Any obj, BoolObj val)
204 { Graphical gr = obj;
205
206 if ( gr->displayed != val )
207 { if ( val == ON )
208 assign(gr, displayed, val);
209
210 if ( notNil(gr->device) )
211 { if ( notNil(gr->request_compute) )
212 { PceWindow sw = getWindowGraphical(gr);
213
214 if ( sw && sw->displayed == ON )
215 ComputeGraphical(gr);
216 }
217 displayedGraphicalDevice(gr->device, gr, val);
218 }
219
220 if ( val == OFF )
221 assign(gr, displayed, val);
222 }
223
224 succeed;
225 }
226
227
228 BoolObj
getIsDisplayedGraphical(Graphical gr,Device dev)229 getIsDisplayedGraphical(Graphical gr, Device dev)
230 { do
231 { if ( gr->displayed == ON && gr->device == dev )
232 return ON;
233
234 if ( gr->displayed == OFF )
235 return OFF;
236
237 gr = (Graphical) gr->device;
238 } while( notNil(gr) );
239
240 return isDefault(dev) ? ON : OFF;
241 }
242
243 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
244 Initialise the device on which the graphical is displayed. This
245 function is called before ->drawSelf and sets the device for the
246 primitive drawing functions and returns the absolute area to be able
247 to draw the graphical.
248 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
249
250 status
initialiseDeviceGraphical(Any obj,int * x,int * y,int * w,int * h)251 initialiseDeviceGraphical(Any obj, int *x, int *y, int *w, int *h)
252 { Graphical gr = obj;
253
254 *x = valInt(gr->area->x);
255 *y = valInt(gr->area->y);
256 *w = valInt(gr->area->w);
257 *h = valInt(gr->area->h);
258
259 succeed;
260 }
261
262
263 status
initialiseRedrawAreaGraphical(Any obj,Area a,int * x,int * y,int * w,int * h,IArea redraw)264 initialiseRedrawAreaGraphical(Any obj, Area a,
265 int *x, int *y, int *w, int *h,
266 IArea redraw)
267 { iarea a2;
268 Graphical gr = obj;
269
270 initialiseDeviceGraphical(obj, x, y, w, h);
271
272 redraw->x = *x + valInt(a->x) - valInt(gr->area->x); /* normalised! */
273 redraw->y = *y + valInt(a->y) - valInt(gr->area->y);
274 redraw->w = valInt(a->w);
275 redraw->h = valInt(a->h);
276
277 a2.x = *x, a2.y = *y, a2.w = *w, a2.h = *h;
278 NormaliseArea(a2.x, a2.y, a2.w, a2.h);
279
280 intersection_iarea(redraw, &a2);
281
282 succeed;
283 }
284
285
286
287
288
289 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
290 Computes the offset caused by intermediate devices to the windows
291 coordinate system.
292 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
293
294 status
offsetDeviceGraphical(Any obj,int * x,int * y)295 offsetDeviceGraphical(Any obj, int *x, int *y)
296 { Graphical gr = obj;
297 register Device dev = gr->device;
298
299 *x = 0;
300 *y = 0;
301
302 while( notNil(dev) && !instanceOfObject(dev, ClassWindow) )
303 { Point p = dev->offset;
304 *x += valInt(p->x);
305 *y += valInt(p->y);
306
307 dev = dev->device;
308 }
309
310 succeed;
311 }
312
313
314 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
315 Compute the area of a graphical in the coordinate system of the real
316 drawing device (the picture).
317 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
318
319 Area
getAbsoluteAreaGraphical(Graphical gr,Device device)320 getAbsoluteAreaGraphical(Graphical gr, Device device)
321 { if ( gr->device == device || isNil(gr->device) )
322 answer(gr->area);
323 else
324 { Device dev = gr->device;
325 int x, y;
326
327 x = valInt(gr->area->x);
328 y = valInt(gr->area->y);
329
330 while( notNil(dev) &&
331 !instanceOfObject(dev, ClassWindow) &&
332 dev != device )
333 { x += valInt(dev->offset->x);
334 y += valInt(dev->offset->y);
335
336 dev = dev->device;
337 }
338
339 answer(answerObject(ClassArea, toInt(x), toInt(y),
340 gr->area->w, gr->area->h, EAV));
341 }
342 }
343
344
345 Graphical
getRootGraphical(Graphical gr)346 getRootGraphical(Graphical gr)
347 { for(;; gr = (Graphical) gr->device)
348 { if ( isNil(gr->device) )
349 answer(gr);
350 }
351 }
352
353
354 PceWindow
getWindowGraphical(Graphical gr)355 getWindowGraphical(Graphical gr)
356 { while( notNil(gr) && !instanceOfObject(gr, ClassWindow) )
357 gr = (Graphical) gr->device;
358
359 if ( notNil(gr) )
360 answer((PceWindow) gr);
361
362 fail;
363 }
364
365
366 FrameObj
getFrameGraphical(Graphical gr)367 getFrameGraphical(Graphical gr)
368 { Graphical root = getRootGraphical(gr);
369
370 if ( instanceOfObject(root, ClassWindow) )
371 { PceWindow sw = (PceWindow) root;
372
373 if ( notNil(sw->frame) )
374 return sw->frame;
375 }
376
377 fail;
378 }
379
380
381 DisplayObj
getDisplayGraphical(Graphical gr)382 getDisplayGraphical(Graphical gr)
383 { FrameObj fr = getFrameGraphical(gr);
384
385 if ( fr )
386 answer(fr->display);
387
388 fail;
389 }
390
391
392 Monitor
getMonitorGraphical(Graphical gr)393 getMonitorGraphical(Graphical gr)
394 { DisplayObj d = getDisplayGraphical(gr);
395 Point pt = NIL;
396 Monitor mon = NULL;
397
398 ComputeGraphical(gr);
399
400 if ( (d = getDisplayGraphical(gr)) &&
401 (pt = getDisplayPositionGraphical(gr)) )
402 { Area a = tempObject(ClassArea,
403 pt->x, pt->y, gr->area->w, gr->area->h,
404 EAV);
405
406 mon = getMonitorDisplay(d, a);
407 considerPreserveObject(a);
408 }
409 doneObject(pt);
410
411 answer(mon);
412 }
413
414
415 Application
getApplicationGraphical(Graphical gr)416 getApplicationGraphical(Graphical gr)
417 { FrameObj fr = getFrameGraphical(gr);
418
419 if ( fr && notNil(fr->application) )
420 answer(fr->application);
421
422 fail;
423 }
424
425
426 Device
getCommonDeviceGraphical(Graphical gr1,Graphical gr2)427 getCommonDeviceGraphical(Graphical gr1, Graphical gr2)
428 { register Device dev1 = gr1->device;
429 register Device dev2 = gr2->device;
430
431 if ( dev1 == dev2 ) /* very common case */
432 { if ( notNil(dev1) )
433 answer(dev1);
434 fail;
435 }
436 /* Get the same level */
437 if ( isNil(dev2) )
438 fail;
439 while( notNil(dev1) && valInt(dev1->level) > valInt(dev2->level) )
440 dev1 = dev1->device;
441
442 if ( isNil(dev1) )
443 fail;
444 while( notNil(dev2) && valInt(dev2->level) > valInt(dev1->level) )
445 dev2 = dev2->device;
446
447 /* Walk along both branches */
448 while( notNil(dev1) && notNil(dev2) )
449 { if ( dev1 == dev2 )
450 answer(dev1);
451
452 dev1 = dev1->device;
453 dev2 = dev2->device;
454 }
455
456 fail;
457 }
458
459
460 /********************************
461 * CHANGES *
462 ********************************/
463
464 int
get_extension_margin_graphical(Graphical gr)465 get_extension_margin_graphical(Graphical gr)
466 { if ( instanceOfObject(gr, ClassText) ||
467 instanceOfObject(gr, ClassDialogItem) )
468 { int m = 5;
469
470 if ( instanceOfObject(gr, ClassButton) )
471 { Button b = (Button)gr;
472
473 if ( b->look == NAME_motif || b->look == NAME_gtk )
474 m = GTK_BUTTON_MARGIN + 1;
475 }
476
477 return m;
478 }
479
480 return 0;
481 }
482
483
484 status
changedAreaGraphical(Any obj,Int x,Int y,Int w,Int h)485 changedAreaGraphical(Any obj, Int x, Int y, Int w, Int h)
486 { Graphical gr = obj;
487
488 if ( notNil(gr->device) && gr->displayed == ON )
489 { Device d;
490 int offx=0, offy=0; /* Offset to the window */
491
492 requestComputeDevice(gr->device, DEFAULT);
493 updateConnectionsGraphical(gr, gr->device->level);
494 if ( notNil(gr->layout_interface) )
495 changedAreaLayoutInterface(gr->layout_interface);
496
497 for(d = gr->device; notNil(d); d = d->device)
498 { if ( d->displayed == OFF )
499 break;
500
501 offx += valInt(d->offset->x);
502 offy += valInt(d->offset->y);
503
504 if ( instanceOfObject(d, ClassWindow) )
505 { PceWindow sw = (PceWindow) d;
506 Area a = gr->area;
507 int ox = valInt(x), oy = valInt(y),
508 ow = valInt(w), oh = valInt(h);
509 int cx = valInt(a->x), cy = valInt(a->y),
510 cw = valInt(a->w), ch = valInt(a->h);
511 int m;
512
513 if ( !createdWindow(sw) )
514 break;
515
516 NormaliseArea(ox, oy, ow, oh);
517 NormaliseArea(cx, cy, cw, ch);
518 ox += offx; oy += offy;
519 cx += offx; cy += offy;
520
521 /* HACKS ... */
522 if ( (m = get_extension_margin_graphical(gr)) )
523 { int m2 = m*2;
524
525 ox -= m; oy -= m; ow += m2; oh += m2;
526 cx -= m; cy -= m; cw += m2; ch += m2;
527 }
528 /* end hacks! */
529
530 changed_window(sw, ox, oy, ow, oh, TRUE);
531 changed_window(sw, cx, cy, cw, ch, offFlag(gr, F_SOLID));
532
533 addChain(ChangedWindows, sw);
534 break; /* A window stops propagation */
535 }
536 }
537 }
538
539 if ( onFlag(gr, F_CONSTRAINT) )
540 return updateConstraintsObject(gr);
541
542 succeed;
543 }
544
545
546 status
changedImageGraphical(Any obj,Int x,Int y,Int w,Int h)547 changedImageGraphical(Any obj, Int x, Int y, Int w, Int h)
548 { Graphical gr = obj;
549 Device d;
550 int ox=0, oy=0; /* Offset to the window */
551
552 if ( instanceOfObject(obj, ClassWindow) )
553 d = obj;
554 else if ( gr->displayed != ON )
555 succeed;
556 else
557 d = gr->device;
558
559 for(; notNil(d); d = d->device)
560 { if ( d->displayed == OFF )
561 succeed;
562 ox += valInt(d->offset->x);
563 oy += valInt(d->offset->y);
564
565 if ( instanceOfObject(d, ClassWindow) )
566 { PceWindow sw = (PceWindow) d;
567 int cx, cy, cw, ch;
568
569 if ( !createdWindow(sw) )
570 succeed;
571
572 if ( isDefault(x) ) x = ZERO;
573 if ( isDefault(y) ) y = ZERO;
574 if ( isDefault(w) ) w = gr->area->w;
575 if ( isDefault(h) ) h = gr->area->h;
576
577 cx = valInt(x) + valInt(gr->area->x),
578 cy = valInt(y) + valInt(gr->area->y),
579 cw = valInt(w),
580 ch = valInt(h);
581
582 NormaliseArea(cx, cy, cw, ch);
583 cx += ox;
584 cy += oy;
585
586 if ( instanceOfObject(gr, ClassText) ||
587 instanceOfObject(gr, ClassDialogItem) )
588 { cx -= 5; cy -= 5; cw += 10; ch += 10;
589 } /* Motif hack */
590
591 DEBUG(NAME_changesData,
592 Cprintf("Change of %s --> %d %d %d %d%s\n",
593 pp(obj),
594 cx, cy, cw, ch,
595 offFlag(gr, F_SOLID) ? " clear" : " no clear"));
596
597 changed_window(sw, cx, cy, cw, ch, offFlag(gr, F_SOLID));
598
599 addChain(ChangedWindows, sw);
600 break;
601 }
602 }
603
604 succeed;
605 }
606
607
608 status
changedEntireImageGraphical(Any obj)609 changedEntireImageGraphical(Any obj)
610 { Graphical gr = obj;
611
612 return changedImageGraphical(gr, ZERO, ZERO, gr->area->w, gr->area->h);
613 }
614
615
616 status
redrawGraphical(Graphical gr,Area a)617 redrawGraphical(Graphical gr, Area a)
618 { if ( isDefault(a) )
619 return changedEntireImageGraphical(gr);
620
621 return changedImageGraphical(gr, a->x, a->y, a->w, a->h);
622 }
623
624
625 /********************************
626 * COMPUTING *
627 ********************************/
628
629 status
requestComputeGraphical(Any obj,Any val)630 requestComputeGraphical(Any obj, Any val)
631 { Graphical gr = obj;
632
633 if ( isFreeingObj(gr) || /* not needed */
634 (notNil(gr->request_compute) && isDefault(val)) ||
635 gr->request_compute == val )
636 succeed;
637
638 if ( isDefault(val) )
639 { val = ON;
640 } else if ( isNil(val) )
641 { assign(gr, request_compute, val);
642 succeed;
643 }
644
645 if ( notNil(gr->request_compute) && gr->request_compute != val )
646 ComputeGraphical(gr);
647 assign(gr, request_compute, val);
648
649 if ( instanceOfObject(gr, ClassWindow) && gr->displayed == ON )
650 { if ( !memberChain(ChangedWindows, gr) )
651 { DEBUG(NAME_window, Cprintf("Adding %s to ChangedWindows\n", pp(gr)));
652 prependChain(ChangedWindows, gr);
653 }
654 } else if ( notNil(gr->device) )
655 { appendChain(gr->device->recompute, gr);
656 requestComputeGraphical((Graphical) gr->device, DEFAULT);
657 }
658
659 succeed;
660 }
661
662
663 status
ComputeGraphical(Any obj)664 ComputeGraphical(Any obj)
665 { Graphical gr = obj;
666
667 if ( notNil(gr->request_compute) && !isFreeingObj(gr) )
668 { qadSendv(gr, NAME_compute, 0, NULL);
669
670 assign(gr, request_compute, NIL);
671 }
672
673 succeed;
674 }
675
676
677 static status
computeGraphical(Graphical gr)678 computeGraphical(Graphical gr)
679 { assign(gr, request_compute, NIL);
680
681 succeed;
682 }
683
684
685 /********************************
686 * REPAINT *
687 ********************************/
688
689 static void
selection_bubble(int x,int y,int w,int h,int wx,int wy)690 selection_bubble(int x, int y, int w, int h, int wx, int wy)
691 { int bw = min(5, w);
692 int bh = min(5, h);
693 int bx = x + (w - bw) * wx / 2;
694 int by = y + (h - bh) * wy / 2;
695
696 r_fill(bx, by, bw, bh, BLACK_COLOUR);
697 /*r_complement(bx, by, bw, bh);*/
698 }
699
700
701 static status
drawGraphical(Graphical gr,Point offset,Area area)702 drawGraphical(Graphical gr, Point offset, Area area)
703 { int ox = 0;
704 int oy = 0;
705
706 if ( notDefault(offset) )
707 { ox = valInt(offset->x);
708 oy = valInt(offset->y);
709 }
710
711 if ( isDefault(area) )
712 { static Area large_area = NULL;
713
714 if ( !large_area )
715 large_area = globalObject(NIL, ClassArea,
716 toInt(PCE_MIN_INT/2), toInt(PCE_MIN_INT/2),
717 toInt(PCE_MAX_INT), toInt(PCE_MAX_INT), EAV);
718
719 area = large_area;
720 }
721
722 r_offset(ox, oy);
723 RedrawArea(gr, area);
724 r_offset(-ox, -oy);
725
726 succeed;
727 }
728
729
730 #define InitAreaA int ax = valInt(a->x), ay = valInt(a->y), \
731 aw = valInt(a->w), ah = valInt(a->h)
732
733 #define InitAreaB int bx = valInt(b->x), by = valInt(b->y), \
734 bw = valInt(b->w), bh = valInt(b->h)
735
736
737 static status
overlapExtendedAreaGraphical(Graphical gr,Area b)738 overlapExtendedAreaGraphical(Graphical gr, Area b)
739 { int m;
740 Area a = gr->area;
741 InitAreaA;
742 InitAreaB;
743
744 NormaliseArea(ax, ay, aw, ah); /* b is normalised */
745 if ( (m = get_extension_margin_graphical(gr)) )
746 { int m2 = 2*m;
747
748 ax -= m; ay -= m;
749 aw += m2; ah += m2;
750
751 }
752 if (by > ay+ah || by+bh < ay || bx > ax+aw || bx+bw < ax)
753 fail;
754
755 succeed;
756 }
757
758
759 status
RedrawArea(Any obj,Area area)760 RedrawArea(Any obj, Area area)
761 { Graphical gr = obj;
762 Any ofg;
763 int fix = 0;
764 int clearbg = 0;
765 struct colour_context ctx;
766 status rval;
767 Any inactive_colour;
768
769 ComputeGraphical(obj); /* should not be necessary: */
770
771 if ( !( gr->area == area || /* image->draw_in and friends */
772 ( gr->displayed == ON &&
773 overlapExtendedAreaGraphical(gr, area)
774 )
775 )
776 )
777 succeed;
778
779 if ( gr->active == OFF &&
780 (inactive_colour = getClassVariableValueObject(gr,
781 NAME_inactiveColour)) &&
782 notNil(inactive_colour) )
783 { fix++;
784 r_fix_colours(inactive_colour, DEFAULT, &ctx);
785 } else if ( gr->selected == ON )
786 { PceWindow sw = getWindowGraphical(gr);
787
788 if ( sw )
789 { Any feedback = sw->selection_feedback;
790
791 if ( instanceOfObject(feedback, ClassColour) )
792 { fix++;
793 r_fix_colours(feedback, DEFAULT, &ctx);
794 } else if ( feedback == NAME_colour )
795 { Any c1, c2;
796
797 c1 = getClassVariableValueObject(obj, NAME_selectedForeground);
798 c2 = getClassVariableValueObject(obj, NAME_selectedBackground);
799
800 fix++;
801 clearbg++;
802 r_fix_colours(c1, c2, &ctx);
803 }
804 }
805 }
806
807 if ( !fix && notDefault(gr->colour) )
808 ofg = r_default_colour(gr->colour);
809 else
810 ofg = NULL;
811
812 if ( instanceOfObject(gr, ClassWindow) ) /* Must be quicker */
813 { PceWindow sw = (PceWindow) gr;
814
815 if ( !createdWindow(sw) )
816 updatePositionWindow(sw);
817
818 rval = RedrawAreaGraphical(sw, area);
819 } else
820 { if ( clearbg )
821 { int x, y, w, h;
822
823 initialiseDeviceGraphical(obj, &x, &y, &w, &h);
824 r_clear(x, y, w, h);
825 }
826
827 rval = qadSendv(gr, NAME_RedrawArea, 1, (Any *)&area);
828 }
829
830 if ( fix )
831 r_unfix_colours(&ctx);
832 else if ( ofg )
833 r_default_colour(ofg);
834
835 return rval;
836 }
837
838
839 status
paintSelectedGraphical(Graphical gr)840 paintSelectedGraphical(Graphical gr)
841 { PceWindow sw = getWindowGraphical(gr);
842 Any feedback;
843
844 if ( sw )
845 feedback = sw->selection_feedback;
846 else
847 fail;
848
849 if ( notNil(feedback) )
850 { int x, y, w, h;
851
852 initialiseDeviceGraphical(gr, &x, &y, &w, &h);
853
854 if ( feedback == (Any) NAME_invert )
855 { r_complement(x, y, w, h);
856 } else if ( feedback == (Any) NAME_handles )
857 { Name which = getClassVariableValueObject(gr, NAME_selectionHandles);
858
859 if ( which == NAME_corners )
860 { selection_bubble(x, y, w, h, 0, 0);
861 selection_bubble(x, y, w, h, 0, 2);
862 selection_bubble(x, y, w, h, 2, 0);
863 selection_bubble(x, y, w, h, 2, 2);
864 } else if ( which == NAME_sides )
865 { selection_bubble(x, y, w, h, 0, 1);
866 selection_bubble(x, y, w, h, 1, 0);
867 selection_bubble(x, y, w, h, 1, 2);
868 selection_bubble(x, y, w, h, 2, 1);
869 } else if ( which == NAME_line )
870 { paintSelectedLine((Line)gr);
871 } else if ( which == NAME_cornersAndSides )
872 { selection_bubble(x, y, w, h, 0, 0);
873 selection_bubble(x, y, w, h, 0, 2);
874 selection_bubble(x, y, w, h, 2, 0);
875 selection_bubble(x, y, w, h, 2, 2);
876 selection_bubble(x, y, w, h, 0, 1);
877 selection_bubble(x, y, w, h, 1, 0);
878 selection_bubble(x, y, w, h, 1, 2);
879 selection_bubble(x, y, w, h, 2, 1);
880 }
881 } else if ( instanceOfObject(feedback, ClassElevation) )
882 { r_3d_box(x, y, w, h, 0, feedback, TRUE);
883 }
884 }
885
886 succeed;
887 }
888
889
890 status
RedrawAreaGraphical(Any obj,Area area)891 RedrawAreaGraphical(Any obj, Area area)
892 { Graphical gr = obj;
893
894 if ( gr->inverted == ON )
895 { int x, y, w, h;
896
897 initialiseDeviceGraphical(gr, &x, &y, &w, &h);
898 r_complement(x, y, w, h);
899 }
900
901 if ( gr->selected == ON )
902 qadSendv(gr, NAME_paintSelected, 0, NULL);
903
904 succeed;
905 }
906
907
908 status
flushGraphical(Any gr)909 flushGraphical(Any gr)
910 { PceWindow sw;
911
912 if ( (sw = getWindowGraphical(gr)) )
913 flushWindow(sw);
914
915 succeed;
916 }
917
918
919 status
synchroniseGraphical(Graphical gr,BoolObj always)920 synchroniseGraphical(Graphical gr, BoolObj always)
921 { DisplayObj d;
922 static long last;
923
924 if ( always != ON )
925 { long now = mclock();
926
927 if ( now - last < 50 )
928 succeed;
929
930 last = now;
931 }
932
933 if ( (d = getDisplayGraphical(gr)) )
934 synchroniseDisplay(d);
935
936 succeed;
937 }
938
939 /********************************
940 * HIDE/EXPOSE *
941 ********************************/
942
943 static status
hideGraphical(Any obj1,Any obj2)944 hideGraphical(Any obj1, Any obj2)
945 { Graphical gr1 = obj1;
946 Graphical gr2 = obj2;
947
948 if ( notNil(gr1->device) &&
949 (isDefault(gr2) || gr2->device == gr1->device) )
950 { hideDevice(gr1->device, gr1, gr2);
951 updateHideExposeConnectionsGraphical(gr1);
952 }
953
954 succeed;
955 }
956
957
958 status
exposeGraphical(Any obj1,Any obj2)959 exposeGraphical(Any obj1, Any obj2)
960 { Graphical gr1 = obj1;
961 Graphical gr2 = obj2;
962
963 if ( notNil(gr1->device) &&
964 (isDefault(gr2) || gr2->device == gr1->device) )
965 { exposeDevice(gr1->device, gr1, gr2);
966 updateHideExposeConnectionsGraphical(gr1);
967 }
968
969 succeed;
970 }
971
972
973 static status
swapGraphical(Any obj1,Any obj2)974 swapGraphical(Any obj1, Any obj2)
975 { Graphical gr1 = obj1;
976 Graphical gr2 = obj2;
977
978 if ( gr1->device == gr2->device && notNil(gr1->device) )
979 swapGraphicalsDevice(gr1->device, gr1, gr2);
980
981 succeed;
982 }
983
984 /********************************
985 * GEOMETRY MANAGEMENT *
986 ********************************/
987
988 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
989 The user accessible geometry management method (->x, ->size, etc.)
990 are defined on the super-class graphical. All subclasses use these
991 methods. All these methods are translated into Graphical ->set:
992 [x], [y], [w], [h]. Most of these translations are done using
993 hard-coded functions calls.
994
995 To allow for sub-classes of graphical to specialise geometry
996 management, Graphical ->set invokes ->geometry: [x], [y], [w], [h].
997 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
998
999 status
setGraphical(Any obj,Int x,Int y,Int w,Int h)1000 setGraphical(Any obj, Int x, Int y, Int w, Int h)
1001 { Graphical gr = obj;
1002
1003 #define Changed(a) (gr->area->a != a && notDefault(a))
1004 if ( Changed(x) || Changed(y) || Changed(w) || Changed(h) )
1005 { Int av[4];
1006
1007 av[0] = x; av[1] = y; av[2] = w; av[3] = h;
1008 return qadSendv(gr, NAME_requestGeometry, 4, av);
1009 }
1010 #undef Changed
1011 succeed;
1012 }
1013
1014
1015 status
doSetGraphical(Any obj,Int x,Int y,Int w,Int h)1016 doSetGraphical(Any obj, Int x, Int y, Int w, Int h)
1017 { Graphical gr = obj;
1018
1019 #define Changed(a) (gr->area->a != a && notDefault(a))
1020 if ( Changed(x) || Changed(y) || Changed(w) || Changed(h) )
1021 { Int av[4];
1022
1023 av[0] = x; av[1] = y; av[2] = w; av[3] = h;
1024 return qadSendv(gr, NAME_geometry, 4, av);
1025 }
1026 #undef Changed
1027 succeed;
1028 }
1029
1030
1031 status
requestGeometryGraphical(Any gr,Int x,Int y,Int w,Int h)1032 requestGeometryGraphical(Any gr, Int x, Int y, Int w, Int h)
1033 { Int av[4];
1034
1035 av[0] = x; av[1] = y; av[2] = w; av[3] = h;
1036
1037 return qadSendv(gr, NAME_geometry, 4, av);
1038 }
1039
1040
1041 status
geometryGraphical(Any obj,Int x,Int y,Int w,Int h)1042 geometryGraphical(Any obj, Int x, Int y, Int w, Int h)
1043 { Graphical gr = obj;
1044
1045 CHANGING_GRAPHICAL(gr, setArea(gr->area, x, y, w, h));
1046
1047 succeed;
1048 }
1049
1050
1051 static status
areaGraphical(Graphical gr,Area area)1052 areaGraphical(Graphical gr, Area area)
1053 { return setGraphical(gr, area->x, area->y, area->w, area->h);
1054 }
1055
1056
1057 status
xGraphical(Graphical gr,Int x)1058 xGraphical(Graphical gr, Int x)
1059 { return setGraphical(gr, x, DEFAULT, DEFAULT, DEFAULT);
1060 }
1061
1062
1063 status
yGraphical(Graphical gr,Int y)1064 yGraphical(Graphical gr, Int y)
1065 { return setGraphical(gr, DEFAULT, y, DEFAULT, DEFAULT);
1066 }
1067
1068
1069 static status
widthGraphical(Graphical gr,Int w)1070 widthGraphical(Graphical gr, Int w)
1071 { return setGraphical(gr, DEFAULT, DEFAULT, w, DEFAULT);
1072 }
1073
1074
1075 status
heightGraphical(Graphical gr,Int h)1076 heightGraphical(Graphical gr, Int h)
1077 { return setGraphical(gr, DEFAULT, DEFAULT, DEFAULT, h);
1078 }
1079
1080
1081 status
positionGraphical(Graphical gr,Point pos)1082 positionGraphical(Graphical gr, Point pos)
1083 { return setGraphical(gr, pos->x, pos->y, DEFAULT, DEFAULT);
1084 }
1085
1086
1087 static status
sizeGraphical(Graphical gr,Size size)1088 sizeGraphical(Graphical gr, Size size)
1089 { return setGraphical(gr, DEFAULT, DEFAULT, size->w, size->h);
1090 }
1091
1092
1093 static status
setCornerGraphical(Graphical gr,Int x,Int y)1094 setCornerGraphical(Graphical gr, Int x, Int y)
1095 { if ( isDefault(x) ) x = add(gr->area->x, gr->area->w);
1096 if ( isDefault(y) ) y = add(gr->area->y, gr->area->h);
1097
1098 return setGraphical(gr, DEFAULT, DEFAULT, sub(x, gr->area->x),
1099 sub(y, gr->area->y));
1100 }
1101
1102
1103 static status
cornerGraphical(Graphical gr,Point pos)1104 cornerGraphical(Graphical gr, Point pos)
1105 { return setCornerGraphical(gr, pos->x, pos->y);
1106 }
1107
1108
1109 static status
cornerXGraphical(Graphical gr,Int x)1110 cornerXGraphical(Graphical gr, Int x)
1111 { return setCornerGraphical(gr, x, DEFAULT);
1112 }
1113
1114
1115 static status
cornerYGraphical(Graphical gr,Int y)1116 cornerYGraphical(Graphical gr, Int y)
1117 { return setCornerGraphical(gr, DEFAULT, y);
1118 }
1119
1120
1121 status
centerGraphical(Graphical gr,Point pos)1122 centerGraphical(Graphical gr, Point pos)
1123 { ComputeGraphical(gr);
1124 return setGraphical(gr, dif(pos->x, gr->area->w),
1125 dif(pos->y, gr->area->h),
1126 DEFAULT, DEFAULT);
1127 }
1128
1129
1130 static status
centerXGraphical(Graphical gr,Int c)1131 centerXGraphical(Graphical gr, Int c)
1132 { ComputeGraphical(gr);
1133 return setGraphical(gr, dif(c, gr->area->w),
1134 DEFAULT, DEFAULT, DEFAULT);
1135 }
1136
1137
1138 static status
centerYGraphical(Graphical gr,Int c)1139 centerYGraphical(Graphical gr, Int c)
1140 { ComputeGraphical(gr);
1141 return setGraphical(gr, DEFAULT,
1142 dif(c, gr->area->h),
1143 DEFAULT, DEFAULT);
1144 }
1145
1146
1147 status
relativeMoveGraphical(Graphical gr,Point pos)1148 relativeMoveGraphical(Graphical gr, Point pos)
1149 { ComputeGraphical(gr);
1150 return setGraphical(gr, add(gr->area->x, pos->x),
1151 add(gr->area->y, pos->y),
1152 DEFAULT, DEFAULT);
1153 }
1154
1155
1156 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1157 Highly dubious. What about lines and bitmaps? Should the result
1158 always be normalised?
1159 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1160
1161 static status
rotateGraphical(Graphical gr,Int degrees)1162 rotateGraphical(Graphical gr, Int degrees)
1163 { int d;
1164 Point pos;
1165 Size size;
1166
1167 d = valInt(degrees);
1168 if ((d%90) != 0)
1169 return errorPce(gr, NAME_rotate90);
1170 d %= 360;
1171
1172 if (d == 90 || d == 270)
1173 { pos = getCenterGraphical(gr);
1174 size = getSizeGraphical(gr);
1175 CHANGING_GRAPHICAL(gr,
1176 widthGraphical(gr, size->h);
1177 heightGraphical(gr, size->w);
1178 centerGraphical(gr, pos));
1179 }
1180
1181 succeed;
1182 }
1183
1184 /********************************
1185 * RESIZING *
1186 ********************************/
1187
1188 status
init_resize_graphical(Any obj,Real xfactor,Real yfactor,Point origin,float * xf,float * yf,int * ox,int * oy)1189 init_resize_graphical(Any obj, Real xfactor, Real yfactor, Point origin,
1190 float *xf, float *yf, int *ox, int *oy)
1191 { *xf = valReal(xfactor);
1192 *yf = (isDefault(yfactor) ? *xf : valReal(yfactor));
1193
1194 if ( notDefault(origin) )
1195 { *ox = valInt(origin->x);
1196 *oy = valInt(origin->y);
1197 }
1198
1199 succeed;
1200 }
1201
1202
1203 static status
resizeGraphical(Graphical gr,Real xfactor,Real yfactor,Point origin)1204 resizeGraphical(Graphical gr, Real xfactor, Real yfactor, Point origin)
1205 { float xf, yf;
1206 int ox = valInt(gr->area->x);
1207 int oy = valInt(gr->area->y);
1208 int nx, ny, nw, nh;
1209 Any av[4];
1210
1211 init_resize_graphical(gr, xfactor, yfactor, origin, &xf, &yf, &ox, &oy);
1212 if ( xf == 1.0 && yf == 1.0 )
1213 succeed;
1214
1215 nx = ox + rfloat((float) (valInt(gr->area->x)-ox) * xf);
1216 ny = oy + rfloat((float) (valInt(gr->area->y)-oy) * yf);
1217 nw = rfloat((float) valInt(gr->area->w) * xf);
1218 nh = rfloat((float) valInt(gr->area->h) * yf);
1219
1220 av[0] = toInt(nx);
1221 av[1] = toInt(ny);
1222 av[2] = toInt(nw);
1223 av[3] = toInt(nh);
1224
1225 return qadSendv(gr, NAME_doSet, 4, av);
1226 }
1227
1228
1229 /********************************
1230 * NORMALISATION *
1231 ********************************/
1232
1233 static status
normaliseGraphical(Graphical gr)1234 normaliseGraphical(Graphical gr)
1235 { return orientationGraphical(gr, NAME_northWest);
1236 }
1237
1238
1239 static status
orientationGraphical(Graphical gr,Name orientation)1240 orientationGraphical(Graphical gr, Name orientation)
1241 { if ( instanceOfObject(gr, ClassBox) ||
1242 instanceOfObject(gr, ClassCircle) ||
1243 instanceOfObject(gr, ClassEllipse) )
1244 orientationArea(gr->area, orientation);
1245
1246 succeed;
1247 }
1248
1249
1250 static Name
getOrientationGraphical(Graphical gr)1251 getOrientationGraphical(Graphical gr)
1252 { answer( getOrientationArea(gr->area) );
1253 }
1254
1255
1256 /********************************
1257 * GET AREA ATTRIBUTES *
1258 ********************************/
1259
1260 Area
getAreaGraphical(Graphical gr)1261 getAreaGraphical(Graphical gr)
1262 { ComputeGraphical(gr);
1263 answer(gr->area);
1264 }
1265
1266
1267 Int
getXGraphical(Graphical gr)1268 getXGraphical(Graphical gr)
1269 { answer(getAreaGraphical(gr)->x);
1270 }
1271
1272
1273 Int
getYGraphical(Graphical gr)1274 getYGraphical(Graphical gr)
1275 { answer(getAreaGraphical(gr)->y);
1276 }
1277
1278
1279 static Int
getCornerXGraphical(Graphical gr)1280 getCornerXGraphical(Graphical gr)
1281 { answer(add(getAreaGraphical(gr)->x,
1282 getAreaGraphical(gr)->w));
1283 }
1284
1285
1286 static Int
getCornerYGraphical(Graphical gr)1287 getCornerYGraphical(Graphical gr)
1288 { answer(add(getAreaGraphical(gr)->y,
1289 getAreaGraphical(gr)->h));
1290 }
1291
1292
1293 Int
getWidthGraphical(Graphical gr)1294 getWidthGraphical(Graphical gr)
1295 { answer(getAreaGraphical(gr)->w);
1296 }
1297
1298
1299 Int
getHeightGraphical(Graphical gr)1300 getHeightGraphical(Graphical gr)
1301 { answer(getAreaGraphical(gr)->h);
1302 }
1303
1304
1305 Int
getLeftSideGraphical(Graphical gr)1306 getLeftSideGraphical(Graphical gr)
1307 { Area a = getAreaGraphical(gr);
1308
1309 if ( valInt(a->w) >= 0 )
1310 answer(a->x);
1311 else
1312 answer(add(a->x, a->w));
1313 }
1314
1315
1316 Int
getRightSideGraphical(Graphical gr)1317 getRightSideGraphical(Graphical gr)
1318 { Area a = getAreaGraphical(gr);
1319
1320 if ( valInt(a->w) >= 0 )
1321 answer(add(a->x, a->w));
1322 else
1323 answer(a->x);
1324 }
1325
1326
1327 static Int
getTopSideGraphical(Graphical gr)1328 getTopSideGraphical(Graphical gr)
1329 { Area a = getAreaGraphical(gr);
1330
1331 if ( valInt(a->h) >= 0 )
1332 answer(a->y);
1333 else
1334 answer(add(a->y, a->h));
1335 }
1336
1337
1338 Int
getBottomSideGraphical(Graphical gr)1339 getBottomSideGraphical(Graphical gr)
1340 { Area a = getAreaGraphical(gr);
1341
1342 if ( valInt(a->h) >= 0 )
1343 answer(add(a->y, a->h));
1344 else
1345 answer(a->y);
1346 }
1347
1348
1349 static status
rightSideGraphical(Graphical gr,Int right)1350 rightSideGraphical(Graphical gr, Int right)
1351 { Int cl = getLeftSideGraphical(gr);
1352 Int av[4];
1353
1354 av[0] = av[1] = av[3] = (Int) DEFAULT;
1355 av[2] = sub(right, cl);
1356
1357 return qadSendv(gr, NAME_doSet, 4, av);
1358 }
1359
1360
1361 static status
leftSideGraphical(Graphical gr,Int left)1362 leftSideGraphical(Graphical gr, Int left)
1363 { Int cr = getRightSideGraphical(gr);
1364 Int av[4];
1365
1366 av[0] = av[1] = av[3] = (Int) DEFAULT;
1367 av[2] = sub(cr, left);
1368
1369 return qadSendv(gr, NAME_doSet, 4, av);
1370 }
1371
1372
1373 static status
bottomSideGraphical(Graphical gr,Int bottom)1374 bottomSideGraphical(Graphical gr, Int bottom)
1375 { Int ct = getTopSideGraphical(gr);
1376 Int av[4];
1377
1378 av[0] = av[1] = av[2] = (Int) DEFAULT;
1379 av[3] = sub(bottom, ct);
1380
1381 return qadSendv(gr, NAME_doSet, 4, av);
1382 }
1383
1384
1385 static status
topSideGraphical(Graphical gr,Int top)1386 topSideGraphical(Graphical gr, Int top)
1387 { Int cb = getBottomSideGraphical(gr);
1388 Int av[4];
1389
1390 av[0] = av[1] = av[2] = (Int) DEFAULT;
1391 av[3] = sub(cb, top);
1392
1393 return qadSendv(gr, NAME_doSet, 4, av);
1394 }
1395
1396
1397 Point
getPositionGraphical(Graphical gr)1398 getPositionGraphical(Graphical gr)
1399 { answer(answerObject(ClassPoint,getAreaGraphical(gr)->x,
1400 getAreaGraphical(gr)->y,EAV));
1401 }
1402
1403
1404 status
get_absolute_xy_graphical(Graphical gr,Device * dev,Int * X,Int * Y)1405 get_absolute_xy_graphical(Graphical gr, Device *dev, Int *X, Int *Y)
1406 { int x, y;
1407
1408 DEBUG(NAME_absolutePosition,
1409 Cprintf("get_absolutePosition(%s, %s) ... ", pp(gr), pp(*dev)));
1410
1411 ComputeGraphical(gr);
1412 x = valInt(gr->area->x);
1413 y = valInt(gr->area->y);
1414
1415 while( !instanceOfObject(gr->device, ClassWindow) &&
1416 !isNil(gr->device) &&
1417 gr->device != *dev )
1418 { Point offset = gr->device->offset;
1419
1420 x += valInt(offset->x);
1421 y += valInt(offset->y);
1422 gr = (Graphical)gr->device;
1423 }
1424
1425 if ( notDefault(*dev) && gr->device != *dev )
1426 { DEBUG(NAME_absolutePosition, Cprintf("failed\n"));
1427 fail;
1428 }
1429
1430 *dev = gr->device;
1431 *X = toInt(x);
1432 *Y = toInt(y);
1433
1434 DEBUG(NAME_absolutePosition, Cprintf("X=%s; Y=%s\n", pp(*X), pp(*Y)));
1435
1436 succeed;
1437 }
1438
1439
1440 Int
getAbsoluteXGraphical(Any gr,Device dev)1441 getAbsoluteXGraphical(Any gr, Device dev)
1442 { Int x, y;
1443
1444 TRY( get_absolute_xy_graphical(gr, &dev, &x, &y) );
1445
1446 answer(x);
1447 }
1448
1449
1450 Int
getAbsoluteYGraphical(Any gr,Device dev)1451 getAbsoluteYGraphical(Any gr, Device dev)
1452 { Int x, y;
1453
1454 TRY( get_absolute_xy_graphical(gr, &dev, &x, &y) );
1455
1456 answer(y);
1457 }
1458
1459
1460 static Point
getAbsolutePositionGraphical(Graphical gr,Device dev)1461 getAbsolutePositionGraphical(Graphical gr, Device dev)
1462 { Int x, y;
1463
1464 TRY( get_absolute_xy_graphical(gr, &dev, &x, &y) );
1465
1466 answer(answerObject(ClassPoint, x, y, EAV));
1467 }
1468
1469
1470 Point
getDisplayPositionGraphical(Graphical gr)1471 getDisplayPositionGraphical(Graphical gr)
1472 { Int x, y;
1473 int ox, oy, wx, wy;
1474 PceWindow w = DEFAULT;
1475
1476 /* relative to window system */
1477 if ( instanceOfObject(gr, ClassWindow) )
1478 { x = y = ZERO;
1479 w = (PceWindow) gr;
1480 ox = oy = 0;
1481 } else
1482 { get_absolute_xy_graphical(gr, (Device *)&w, &x, &y);
1483 if ( !instanceOfObject(w, ClassWindow) )
1484 fail; /* not displayed */
1485 offset_window(w, &ox, &oy);
1486 }
1487 /* relative to display */
1488 get_display_position_window(w, &wx, &wy);
1489
1490 x = toInt(valInt(x) + ox + wx);
1491 y = toInt(valInt(y) + oy + wy);
1492
1493 answer(answerObject(ClassPoint, x, y, EAV));
1494 }
1495
1496
1497 Size
getSizeGraphical(Graphical gr)1498 getSizeGraphical(Graphical gr)
1499 { answer(answerObject(ClassSize,
1500 getAreaGraphical(gr)->w,
1501 getAreaGraphical(gr)->h, EAV));
1502 }
1503
1504
1505 static Point
getCornerGraphical(Graphical gr)1506 getCornerGraphical(Graphical gr)
1507 { Area a = getAreaGraphical(gr);
1508
1509 answer(answerObject(ClassPoint, add(a->x,a->w), add(a->y,a->h), EAV));
1510 }
1511
1512
1513 static Point
getCenterGraphical(Graphical gr)1514 getCenterGraphical(Graphical gr)
1515 { Area a = getAreaGraphical(gr);
1516
1517 answer(answerObject(ClassPoint, mid(a->x,a->w), mid(a->y,a->h), EAV));
1518 }
1519
1520
1521 static Int
getCenterXGraphical(Graphical gr)1522 getCenterXGraphical(Graphical gr)
1523 { Area a = getAreaGraphical(gr);
1524
1525 answer(mid(a->x, a->w));
1526 }
1527
1528
1529 static Int
getCenterYGraphical(Graphical gr)1530 getCenterYGraphical(Graphical gr)
1531 { Area a = getAreaGraphical(gr);
1532
1533 answer(mid(a->y, a->h));
1534 }
1535
1536
1537 static Area
getBoundingBoxGraphical(Graphical gr)1538 getBoundingBoxGraphical(Graphical gr)
1539 { answer(getAreaGraphical(gr));
1540 }
1541
1542
1543 static Int
getDistanceGraphical(Graphical gr,Graphical gr2)1544 getDistanceGraphical(Graphical gr, Graphical gr2)
1545 { answer(getDistanceArea(gr->area, gr2->area));
1546 }
1547
1548
1549 static Int
getDistanceXGraphical(Graphical gr,Graphical gr2)1550 getDistanceXGraphical(Graphical gr, Graphical gr2)
1551 { answer(getDistanceXArea(gr->area, gr2->area));
1552 }
1553
1554
1555 static Int
getDistanceYGraphical(Graphical gr,Graphical gr2)1556 getDistanceYGraphical(Graphical gr, Graphical gr2)
1557 { answer(getDistanceYArea(gr->area, gr2->area));
1558 }
1559
1560
1561 /*******************************
1562 * DIALOG POSITIONS *
1563 *******************************/
1564
1565 status
appendDialogItemNetworkDevice(Device dev,Graphical gr1)1566 appendDialogItemNetworkDevice(Device dev, Graphical gr1)
1567 { Graphical gr2;
1568
1569 if ( notNil(gr1) && ((Graphical)getContainerGraphical(gr1))->device != dev )
1570 { send(gr1, NAME_autoAlign, ON, EAV);
1571 DEBUG(NAME_dialog, Cprintf("Adding %s to %s\n", pp(gr1), pp(dev)));
1572 displayDevice(dev, gr1, DEFAULT);
1573
1574 if ( (gr2 = get(gr1, NAME_left, EAV)) )
1575 appendDialogItemNetworkDevice(dev, gr2);
1576 if ( (gr2 = get(gr1, NAME_right, EAV)) )
1577 appendDialogItemNetworkDevice(dev, gr2);
1578 if ( (gr2 = get(gr1, NAME_above, EAV)) )
1579 appendDialogItemNetworkDevice(dev, gr2);
1580 if ( (gr2 = get(gr1, NAME_below, EAV)) )
1581 appendDialogItemNetworkDevice(dev, gr2);
1582 }
1583
1584 succeed;
1585 }
1586
1587
1588 static status
same_device(Graphical gr1,Graphical gr2)1589 same_device(Graphical gr1, Graphical gr2)
1590 { gr1 = getContainerGraphical(gr1);
1591 gr2 = getContainerGraphical(gr2);
1592
1593 if ( notNil(gr1) && notNil(gr2) && gr1->device != gr2->device )
1594 { if ( isNil(gr1->device) )
1595 appendDialogItemNetworkDevice(gr2->device, gr1);
1596 else if ( isNil(gr2->device) )
1597 appendDialogItemNetworkDevice(gr1->device, gr2);
1598 else
1599 return errorPce(gr1, NAME_alreadyShown, 12, gr2->device);
1600 }
1601
1602 succeed;
1603 }
1604
1605
1606 static status
assignDialogItem(Graphical gr,Name slot,Any value)1607 assignDialogItem(Graphical gr, Name slot, Any value)
1608 { Variable var;
1609 Graphical gr2;
1610
1611 DEBUG(NAME_left, Cprintf("assignDialogItem(%s, %s, %s)\n",
1612 pp(gr), pp(slot), pp(value)));
1613
1614 if ( (var = getInstanceVariableClass(classOfObject(gr), slot)) &&
1615 var->context == ClassDialogItem )
1616 return sendVariable(var, gr, value);
1617
1618 if ( isNil(value) )
1619 deleteAttributeObject(gr, slot);
1620 else
1621 attributeObject(gr, slot, value);
1622
1623 if ( (gr2=getContainerGraphical(gr)) != gr )
1624 assignDialogItem(gr2, slot, value);
1625
1626 succeed;
1627 }
1628
1629
1630
1631 status
aboveGraphical(Graphical gr1,Graphical gr2)1632 aboveGraphical(Graphical gr1, Graphical gr2)
1633 { Graphical gr;
1634
1635 TRY(same_device(gr1, gr2));
1636
1637 if ( notNil(gr2) )
1638 { belowGraphical(gr2, NIL);
1639 assignDialogItem(gr2, NAME_below, gr1);
1640 }
1641 if ( (gr = get(gr1, NAME_above, EAV)) && notNil(gr) )
1642 assignDialogItem(gr, NAME_below, NIL);
1643
1644 assignDialogItem(gr1, NAME_above, gr2);
1645
1646 succeed;
1647 }
1648
1649
1650 status
belowGraphical(Graphical gr1,Graphical gr2)1651 belowGraphical(Graphical gr1, Graphical gr2)
1652 { Graphical gr;
1653
1654 TRY(same_device(gr1, gr2));
1655
1656 if ( notNil(gr2) )
1657 { aboveGraphical(gr2, NIL);
1658 assignDialogItem(gr2, NAME_above, gr1);
1659 }
1660 if ( (gr = get(gr1, NAME_below, EAV)) && notNil(gr) )
1661 assignDialogItem(gr, NAME_above, NIL);
1662
1663 assignDialogItem(gr1, NAME_below, gr2);
1664
1665 succeed;
1666 }
1667
1668
1669 status
rightGraphical(Graphical gr1,Graphical gr2)1670 rightGraphical(Graphical gr1, Graphical gr2)
1671 { Graphical gr;
1672
1673 DEBUG(NAME_left, Cprintf("rightGraphical(%s,%s)\n", pp(gr1), pp(gr2)));
1674 TRY(same_device(gr1, gr2));
1675
1676 if ( notNil(gr2) )
1677 { leftGraphical(gr2, NIL);
1678 assignDialogItem(gr2, NAME_left, gr1);
1679 }
1680 if ( (gr = get(gr1, NAME_right, EAV)) && notNil(gr) )
1681 assignDialogItem(gr, NAME_left, NIL);
1682
1683 assignDialogItem(gr1, NAME_right, gr2);
1684
1685 succeed;
1686 }
1687
1688
1689 status
leftGraphical(Graphical gr1,Graphical gr2)1690 leftGraphical(Graphical gr1, Graphical gr2)
1691 { Graphical gr;
1692
1693 DEBUG(NAME_left, Cprintf("leftGraphical(%s,%s)\n", pp(gr1), pp(gr2)));
1694 TRY(same_device(gr1, gr2));
1695
1696 if ( notNil(gr2) )
1697 { rightGraphical(gr2, NIL);
1698 assignDialogItem(gr2, NAME_right, gr1);
1699 }
1700 if ( (gr = get(gr1, NAME_right, EAV)) && notNil(gr) )
1701 assignDialogItem(gr, NAME_right, NIL);
1702
1703 assignDialogItem(gr1, NAME_left, gr2);
1704
1705 succeed;
1706 }
1707
1708
1709 status
referenceGraphical(Graphical gr,Point ref)1710 referenceGraphical(Graphical gr, Point ref)
1711 { return assignDialogItem(gr, NAME_reference, ref);
1712 }
1713
1714
1715 static status
alignmentGraphical(Graphical gr,Name alignment)1716 alignmentGraphical(Graphical gr, Name alignment)
1717 { return assignDialogItem(gr, NAME_alignment, alignment);
1718 }
1719
1720
1721 static Name
getAlignmentGraphical(Graphical gr)1722 getAlignmentGraphical(Graphical gr)
1723 { Name alignment;
1724
1725 if ( isName(alignment = getAttributeObject(gr, NAME_alignment)) )
1726 answer(alignment);
1727 if ( isName(alignment = getClassVariableValueObject(gr, NAME_alignment)) )
1728 answer(alignment);
1729
1730 answer(NAME_left);
1731 }
1732
1733
1734 static status
autoAlignGraphical(Graphical gr,BoolObj align)1735 autoAlignGraphical(Graphical gr, BoolObj align)
1736 { return assignDialogItem(gr, NAME_autoAlign, align);
1737 }
1738
1739
1740 static status
autoLabelAlignGraphical(Graphical gr,BoolObj val)1741 autoLabelAlignGraphical(Graphical gr, BoolObj val)
1742 { return assignDialogItem(gr, NAME_autoLabelAlign, val);
1743 }
1744
1745
1746 static status
autoValueAlignGraphical(Graphical gr,BoolObj val)1747 autoValueAlignGraphical(Graphical gr, BoolObj val)
1748 { return assignDialogItem(gr, NAME_autoValueAlign, val);
1749 }
1750
1751
1752 static BoolObj
getAutoAlignGraphical(Graphical gr)1753 getAutoAlignGraphical(Graphical gr)
1754 { BoolObj rval;
1755
1756 if ( (rval = getAttributeObject(gr, NAME_autoAlign)) &&
1757 instanceOfObject(rval, ClassBool) )
1758 answer(rval);
1759
1760 if ( onFlag(gr, F_ATTRIBUTE) )
1761 { if ( getAttributeObject(gr, NAME_above) ||
1762 getAttributeObject(gr, NAME_below) ||
1763 getAttributeObject(gr, NAME_left) ||
1764 getAttributeObject(gr, NAME_right) )
1765 answer(ON);
1766 }
1767
1768 answer(OFF);
1769 }
1770
1771
1772 static BoolObj
getAutoLabelAlignGraphical(Graphical gr)1773 getAutoLabelAlignGraphical(Graphical gr)
1774 { BoolObj rval;
1775
1776 if ( (rval = getAttributeObject(gr, NAME_autoLabelAlign)) &&
1777 instanceOfObject(rval, ClassBool) )
1778 answer(rval);
1779
1780 answer(OFF);
1781 }
1782
1783
1784 static BoolObj
getAutoValueAlignGraphical(Graphical gr)1785 getAutoValueAlignGraphical(Graphical gr)
1786 { BoolObj rval;
1787
1788 if ( (rval = getAttributeObject(gr, NAME_autoValueAlign)) &&
1789 instanceOfObject(rval, ClassBool) )
1790 answer(rval);
1791
1792 answer(OFF);
1793 }
1794
1795
1796 static status
layoutDialogGraphical(Graphical gr)1797 layoutDialogGraphical(Graphical gr)
1798 { ComputeGraphical(gr);
1799
1800 succeed;
1801 }
1802
1803
1804 /********************************
1805 * PEN *
1806 ********************************/
1807
1808 status
penGraphical(Graphical gr,Int pen)1809 penGraphical(Graphical gr, Int pen)
1810 { if (gr->pen != pen)
1811 { CHANGING_GRAPHICAL(gr, assign(gr, pen, pen);
1812 changedEntireImageGraphical(gr));
1813 }
1814
1815 succeed;
1816 }
1817
1818
1819 status
shadowGraphical(Graphical gr,Int s)1820 shadowGraphical(Graphical gr, Int s)
1821 { return assignGraphical(gr, NAME_shadow, s);
1822 }
1823
1824
1825 status
fillPatternGraphical(Graphical gr,Image pattern)1826 fillPatternGraphical(Graphical gr, Image pattern)
1827 { return assignGraphical(gr, NAME_fillPattern, pattern);
1828 }
1829
1830
1831 status
fillOffsetGraphical(Graphical gr,Point pattern)1832 fillOffsetGraphical(Graphical gr, Point pattern)
1833 { return assignGraphical(gr, NAME_fillOffset, pattern);
1834 }
1835
1836
1837 static status
textureGraphical(Graphical gr,Name texture)1838 textureGraphical(Graphical gr, Name texture)
1839 { if (gr->texture != texture)
1840 { CHANGING_GRAPHICAL(gr, assign(gr, texture, texture);
1841 changedEntireImageGraphical(gr));
1842 }
1843
1844 succeed;
1845 }
1846
1847
1848 status
colourGraphical(Graphical gr,Any c)1849 colourGraphical(Graphical gr, Any c)
1850 { if ( gr->colour != c )
1851 { CHANGING_GRAPHICAL(gr, assign(gr, colour, c);
1852 changedEntireImageGraphical(gr));
1853 }
1854
1855 succeed;
1856 }
1857
1858
1859 Any
getDisplayColourGraphical(Graphical gr)1860 getDisplayColourGraphical(Graphical gr)
1861 { while( notNil(gr) )
1862 { if ( notDefault(gr->colour) )
1863 answer(gr->colour);
1864
1865 gr = (Graphical) gr->device;
1866 }
1867
1868 fail;
1869 }
1870
1871
1872 /********************************
1873 * SELECTION *
1874 ********************************/
1875
1876
1877 static status
toggleSelectedGraphical(Graphical gr)1878 toggleSelectedGraphical(Graphical gr)
1879 { return send(gr, NAME_selected, gr->selected == ON ? OFF : ON, EAV);
1880 }
1881
1882
1883 static status
selectedGraphical(Graphical gr,BoolObj val)1884 selectedGraphical(Graphical gr, BoolObj val)
1885 { if (gr->selected != val)
1886 { CHANGING_GRAPHICAL(gr, assign(gr, selected, val);
1887 changedEntireImageGraphical(gr));
1888 }
1889
1890 succeed;
1891 }
1892
1893
1894 /********************************
1895 * HANDLES *
1896 ********************************/
1897
1898 static status
handleGraphical(Graphical gr,Handle h)1899 handleGraphical(Graphical gr, Handle h)
1900 { if (isNil(gr->handles))
1901 assign(gr, handles, newObject(ClassChain, EAV));
1902
1903 return appendChain(gr->handles, h);
1904 }
1905
1906
1907 Handle
getHandleGraphical(Graphical gr,Name name)1908 getHandleGraphical(Graphical gr, Name name)
1909 { Class class;
1910
1911 if ( notNil(gr->handles) )
1912 { Cell cell;
1913
1914 for_cell(cell, gr->handles)
1915 { Handle h = cell->value;
1916 if ( h->name == name )
1917 answer(h);
1918 }
1919 }
1920
1921 class = classOfObject(gr);
1922 if ( notNil(class->handles) )
1923 { Cell cell;
1924
1925 for_cell(cell, class->handles)
1926 { Handle h = cell->value;
1927 if ( h->name == name )
1928 answer(h);
1929 }
1930 }
1931
1932 fail;
1933 }
1934
1935
1936 Point
getHandlePositionGraphical(Graphical gr,Name name,Device dev)1937 getHandlePositionGraphical(Graphical gr, Name name, Device dev)
1938 { Int x, y;
1939 Handle h;
1940
1941 if ( isDefault(dev) )
1942 dev = gr->device;
1943
1944 TRY(h = getHandleGraphical(gr, name));
1945 TRY(x = getXHandle(h, gr, dev));
1946 TRY(y = getYHandle(h, gr, dev));
1947
1948 answer(answerObject(ClassPoint, x, y, EAV));
1949 }
1950
1951
1952 Chain
getHandlesGraphical(Graphical gr,Point pos,Name kind,Int distance)1953 getHandlesGraphical(Graphical gr, Point pos, Name kind, Int distance)
1954 { int maxdx=0, maxdy=0;
1955 int px=0, py=0;
1956 Cell cell;
1957 Class class;
1958 Chain rval = NIL;
1959 int use_range;
1960
1961 if ( notDefault(distance) && notDefault(pos) )
1962 { px = valInt(pos->x);
1963 py = valInt(pos->y);
1964
1965 maxdx = (valInt(distance) * valInt(gr->area->w) + 99) / 100;
1966 maxdy = (valInt(distance) * valInt(gr->area->h) + 99) / 100;
1967 use_range = TRUE;
1968 } else
1969 use_range = FALSE;
1970
1971 if ( notNil(gr->handles) )
1972 { for_cell(cell, gr->handles)
1973 { Handle h = cell->value;
1974 int hx, hy;
1975
1976 if ( notDefault(kind) && h->kind != kind )
1977 continue;
1978
1979 if ( use_range )
1980 { hx = valInt(getXHandle(h, gr, gr->device));
1981 hy = valInt(getYHandle(h, gr, gr->device));
1982 if ( abs(hx-px) > maxdx || abs(hy-py) > maxdy )
1983 continue;
1984 }
1985
1986 if ( isNil(rval) )
1987 rval = answerObject(ClassChain, h, EAV);
1988 else
1989 appendChain(rval, h);
1990 }
1991 }
1992
1993 class = classOfObject(gr);
1994 if ( notNil(class->handles) )
1995 { for_cell(cell, class->handles)
1996 { Handle h = cell->value;
1997 int hx, hy;
1998
1999 if ( notDefault(kind) && h->kind != kind )
2000 continue;
2001
2002 if ( use_range )
2003 { hx = valInt(getXHandle(h, gr, gr->device));
2004 hy = valInt(getYHandle(h, gr, gr->device));
2005 if ( abs(hx-px) > maxdx || abs(hy-py) > maxdy )
2006 continue;
2007 }
2008
2009 if ( isNil(rval) )
2010 rval = answerObject(ClassChain, h, EAV);
2011 else
2012 appendChain(rval, h);
2013 }
2014 }
2015
2016 if ( notNil(rval) )
2017 answer(rval);
2018
2019 fail;
2020 }
2021
2022 /********************************
2023 * MASKING PATTERNS *
2024 ********************************/
2025
2026
2027 static status
invertedGraphical(Graphical gr,BoolObj val)2028 invertedGraphical(Graphical gr, BoolObj val)
2029 { if ( gr->inverted != val )
2030 CHANGING_GRAPHICAL(gr,
2031 assign(gr, inverted, val);
2032 changedEntireImageGraphical(gr));
2033 succeed;
2034 }
2035
2036
2037 status
activeGraphical(Graphical gr,BoolObj val)2038 activeGraphical(Graphical gr, BoolObj val)
2039 { if ( gr->active != val )
2040 { CHANGING_GRAPHICAL(gr,
2041 assign(gr, active, val);
2042 changedEntireImageGraphical(gr));
2043 }
2044
2045 succeed;
2046 }
2047
2048
2049 /********************************
2050 * CURSOR *
2051 ********************************/
2052
2053 static status
cursorGraphical(Graphical gr,CursorObj cursor)2054 cursorGraphical(Graphical gr, CursorObj cursor)
2055 { PceWindow w = getWindowGraphical(gr);
2056
2057 assign(gr, cursor, cursor);
2058
2059 if ( w )
2060 updateCursorWindow(w);
2061
2062 flushGraphical(gr);
2063
2064 succeed;
2065 }
2066
2067
2068 status
focusCursorGraphical(Graphical gr,CursorObj cursor)2069 focusCursorGraphical(Graphical gr, CursorObj cursor)
2070 { PceWindow w = getWindowGraphical(gr);
2071
2072 if ( w )
2073 return focusCursorWindow(w, cursor);
2074
2075 succeed;
2076 }
2077
2078
2079 static CursorObj
getDisplayedCursorGraphical(Graphical gr)2080 getDisplayedCursorGraphical(Graphical gr)
2081 { answer(gr->cursor);
2082 }
2083
2084
2085 /********************************
2086 * FOCUS *
2087 ********************************/
2088
2089 status
focusGraphical(Graphical gr,Recogniser recogniser,CursorObj cursor,Name button)2090 focusGraphical(Graphical gr, Recogniser recogniser,
2091 CursorObj cursor, Name button)
2092 { PceWindow sw = getWindowGraphical(gr);
2093
2094 if ( sw != FAIL )
2095 focusWindow(sw, gr, recogniser, cursor, button);
2096
2097 succeed;
2098 }
2099
2100
2101 static status
WantsKeyboardFocusGraphical(Graphical gr)2102 WantsKeyboardFocusGraphical(Graphical gr)
2103 { fail;
2104 }
2105
2106
2107 /********************************
2108 * CONNECTIONS *
2109 ********************************/
2110
2111
2112 /* Update connections due to move/resize */
2113 status
updateConnectionsGraphical(Graphical gr,Int level)2114 updateConnectionsGraphical(Graphical gr, Int level)
2115 { if ( notNil(gr->connections) )
2116 { Cell cell;
2117
2118 for_cell(cell, gr->connections)
2119 { Connection c = cell->value;
2120
2121 if ( notNil(c->device) && valInt(c->device->level) <= valInt(level) )
2122 requestComputeGraphical(cell->value, DEFAULT);
2123 }
2124 }
2125
2126 if ( instanceOfObject(gr, ClassWindow) ) /* HACK */
2127 updatePositionWindow((PceWindow) gr);
2128
2129 succeed;
2130 }
2131
2132
2133 static status
updateHideExposeConnectionsGraphical(Graphical gr)2134 updateHideExposeConnectionsGraphical(Graphical gr)
2135 { if ( notNil(gr->connections) )
2136 { Cell cell;
2137
2138 for_cell(cell, gr->connections)
2139 updateHideExposeConnection(cell->value);
2140 }
2141
2142 succeed;
2143 }
2144
2145
2146 status
connectGraphical(Graphical gr,Graphical gr2,Link link,Name from,Name to)2147 connectGraphical(Graphical gr, Graphical gr2, Link link, Name from, Name to)
2148 { if ( get(link, NAME_connection, gr, gr2, from, to, EAV) )
2149 succeed;
2150
2151 fail;
2152 }
2153
2154
2155 status
attachConnectionGraphical(Graphical gr,Connection c)2156 attachConnectionGraphical(Graphical gr, Connection c)
2157 { if ( isNil(gr->connections) )
2158 assign(gr, connections, newObject(ClassChain, c, EAV));
2159 else
2160 appendChain(gr->connections, c);
2161
2162 succeed;
2163 }
2164
2165
2166 status
detachConnectionGraphical(Graphical gr,Connection c)2167 detachConnectionGraphical(Graphical gr, Connection c)
2168 { if ( notNil(gr->connections) &&
2169 deleteChain(gr->connections, c) &&
2170 emptyChain(gr->connections) )
2171 assign(gr, connections, NIL);
2172
2173 succeed;
2174 }
2175
2176
2177 static status
match_connection(Connection c,Link link,Name from,Name to)2178 match_connection(Connection c, Link link, Name from, Name to)
2179 { if ( (c->link == link || isDefault(link)) &&
2180 (c->from_handle == from || isDefault(from)) &&
2181 (c->to_handle == to || isDefault(to)) )
2182 succeed;
2183
2184 fail;
2185 }
2186
2187
2188 static Connection
getConnectedGraphical(Graphical gr,Graphical gr2,Link link,Name from,Name to)2189 getConnectedGraphical(Graphical gr, Graphical gr2,
2190 Link link, Name from, Name to)
2191 { Chain ch;
2192 Cell cell;
2193
2194 if ( notNil(ch = gr->connections) )
2195 { for_cell(cell, ch)
2196 { Connection c = cell->value;
2197
2198 if ( (isDefault(gr2) || c->to == gr2 || c->from == gr2) &&
2199 match_connection(c, link, from, to) )
2200 answer(c);
2201 }
2202 }
2203
2204 fail;
2205 }
2206
2207
2208 status
connectedGraphical(Graphical gr,Graphical gr2,Link link,Name from,Name to)2209 connectedGraphical(Graphical gr, Graphical gr2,
2210 Link link, Name from, Name to)
2211 { return getConnectedGraphical(gr, gr2, link, from, to) ? SUCCEED : FAIL;
2212 }
2213
2214
2215 status
disconnectGraphical(Graphical gr,Graphical gr2,Link link,Name from,Name to)2216 disconnectGraphical(Graphical gr, Graphical gr2,
2217 Link link, Name from, Name to)
2218 { Chain ch;
2219
2220 if ( notNil(ch = gr->connections) )
2221 { Connection c;
2222
2223 for_chain(ch, c,
2224 if ( (isDefault(gr2) || c->to == gr2 || c->from == gr2) &&
2225 match_connection(c, link, from, to) )
2226 freeObject(c));
2227 }
2228
2229 succeed;
2230 }
2231
2232
2233 static Chain
getConnectionsGraphical(Graphical gr,Graphical gr2,Link link,Name from,Name to)2234 getConnectionsGraphical(Graphical gr, Graphical gr2,
2235 Link link, Name from, Name to)
2236 { Chain ch;
2237 Cell cell;
2238 Chain rval = NIL;
2239
2240 if ( isDefault(gr2) && isDefault(link) && isDefault(from) && isDefault(to) )
2241 { if ( notNil(gr->connections) )
2242 answer(gr->connections);
2243 fail;
2244 }
2245
2246 if ( notNil(ch = gr->connections) )
2247 { for_cell(cell, ch)
2248 { Connection c = cell->value;
2249
2250 if ( (isDefault(gr2) || c->to == gr2 || c->from == gr2) &&
2251 match_connection(c, link, from, to) )
2252 { if ( isNil(rval) )
2253 rval = newObject(ClassChain, c, EAV);
2254 else
2255 appendChain(rval, c);
2256 }
2257 }
2258
2259 if ( notNil(rval) )
2260 answer(rval);
2261 }
2262
2263 fail;
2264 }
2265
2266
2267 static status
extendNetworkGraphical(Graphical gr,Link link,Name from,Name to,Chain members)2268 extendNetworkGraphical(Graphical gr, Link link,
2269 Name from, Name to, Chain members)
2270 { if ( memberChain(members, gr) == SUCCEED )
2271 succeed;
2272
2273 appendChain(members, gr);
2274
2275 if ( notNil(gr->connections) )
2276 { Cell cell;
2277
2278 for_cell(cell, gr->connections)
2279 { Connection c = cell->value;
2280
2281 if ( match_connection(c, link, from, to) )
2282 extendNetworkGraphical((c->to == gr ? c->from : c->to),
2283 link, from, to, members);
2284 }
2285 }
2286
2287 succeed;
2288 }
2289
2290
2291 static Chain
getNetworkGraphical(Graphical gr,Link link,Name from,Name to)2292 getNetworkGraphical(Graphical gr, Link link, Name from, Name to)
2293 { Chain connections;
2294
2295 connections = answerObject(ClassChain, EAV);
2296
2297 extendNetworkGraphical(gr, link, from, to, connections);
2298
2299 answer(connections);
2300 }
2301
2302
2303 /********************************
2304 * LAYOUT *
2305 ********************************/
2306
2307 /* (AA) send(Graphical, layout, C1, C2, C3, C4, C5, C6)
2308
2309 Heuristic layout of a graph (based on an algorithm given in: Eades, P.
2310 (1984), "A Heuristic for Graph Drawing", Congressus Numerantium, vol.
2311 42, pp. 149-160. All figures (indirectly) related to Figure, i.e. the
2312 graph, are moved such: (a) the distance between two figures which are
2313 connected is constant and (b) the distance between two figures which are
2314 not connected is as large as possible. The algorithm computes the
2315 forces on each figure (the links can be seen as springs), where
2316 connected figures attract and unconnected figures repel each other. The
2317 force on each figure is computed repeatedly, and incremental use of the
2318 algorithm produces better results until a stable state is reached. The
2319 algorithm is suitable for graphs in which the vertices are initially
2320 placed at random.
2321 */
2322
2323 /* Attraction of connected vertices is given by: C1 * log(d/C2)
2324 Repelling of unconnected vertices is given by: -C3 / sqrt(d)
2325 where d is the distance between the vertices.
2326
2327 ** Tue Sep 15 15:14:42 1987 anjo@swivax.uucp (Anjo Anjewierden) */
2328
2329 static int
forceAttract(int d,float C1,float C2)2330 forceAttract(int d, float C1, float C2)
2331 { if ( d < 10 )
2332 d = 10;
2333
2334 return (int) (2048.0 * C1 * log((float)d/C2)) / d;
2335 }
2336
2337
2338 static int
forceRepel(int d,float C3)2339 forceRepel(int d, float C3)
2340 { if ( d < 10 )
2341 d = 10;
2342
2343 return (int) (-2048.0 * C3 / sqrt((float)d)) / d;
2344 }
2345
2346
2347 typedef struct
2348 { int fx; /* force in X-direction */
2349 int fy; /* force in Y-direction */
2350 Connection c; /* the connection */
2351 Int ideal_len; /* ideal length */
2352 } lg_relation;
2353
2354
2355 typedef struct
2356 { Graphical gr; /* the graphical */
2357 iarea area; /* its current area */
2358 unsigned update : 1; /* update position */
2359 unsigned moved : 1; /* we moved it */
2360 unsigned fixed : 1; /* do not move this one */
2361 } lg_object;
2362
2363
2364 static inline int
cx_object(lg_object * o)2365 cx_object(lg_object *o)
2366 { return o->area.x + o->area.w/2;
2367 }
2368
2369
2370 static inline int
cy_object(lg_object * o)2371 cy_object(lg_object *o)
2372 { return o->area.y + o->area.h/2;
2373 }
2374
2375
2376 static void
place_object(lg_object * o)2377 place_object(lg_object *o)
2378 { if ( o->update )
2379 { Any av[4];
2380
2381 o->update = FALSE;
2382 av[0] = toInt(o->area.x);
2383 av[1] = toInt(o->area.y);
2384
2385 if ( o->gr->area->x != av[0] ||
2386 o->gr->area->y != av[1] )
2387 { av[2] = DEFAULT;
2388 av[3] = DEFAULT;
2389 qadSendv(o->gr, NAME_set, 4, av);
2390 }
2391 }
2392 }
2393
2394
2395 static int
distance_area(IArea a,IArea b)2396 distance_area(IArea a, IArea b)
2397 { int bx = b->x - a->x; /* normalise on (ax,ay) == (0,0) */
2398 int by = b->y - a->y;
2399
2400 if (a->h < by) /* a above b */
2401 { if (bx+b->w < 0) /* b left a */
2402 return(distance(bx+b->w, by, 0, a->h));
2403 if (bx > a->w) /* a left b */
2404 return(distance(a->w, a->h, bx, by));
2405 return(by-(a->h));
2406 }
2407
2408 if (by+b->h < 0) /* b above a */
2409 { if (a->w < bx)
2410 return(distance(a->w, 0, bx, by+b->h));
2411 if (bx+b->w < 0)
2412 return(distance(bx+b->w, by+b->h, 0, 0));
2413 return(-(by+b->h));
2414 }
2415
2416 if (a->w < bx) /* a and b equal height */
2417 return(bx-(a->w));
2418
2419 if (bx+b->w < 0)
2420 return(-(bx+b->w));
2421
2422 return(0); /* overlap */
2423 }
2424
2425
2426 static status
layoutGraphical(Graphical gr,Real argC1,Real argC2,Real argC3,Int argC4,Int argC5,Area area,Chain work,Chain move_only)2427 layoutGraphical(Graphical gr,
2428 Real argC1, /* strength of connections */
2429 Real argC2, /* natural distance */
2430 Real argC3, /* strength of not-connected */
2431 Int argC4, /* addaption-speed */
2432 Int argC5, /* max iterations */
2433 Area area, /* Bounce objects in this area */
2434 Chain work, /* network to layout */
2435 Chain move_only) /* only move these */
2436 { lg_relation **r; /* relation matrix */
2437 lg_object *objects; /* object array */
2438 lg_object *op; /* current object */
2439 int force;
2440 int dx, dy, d;
2441 int n, l, i, j;
2442 Cell cell;
2443 float C1 = (isDefault(argC1) ? 2.0 : valReal(argC1));
2444 float C2 = (isDefault(argC2) ? 30.0 : valReal(argC2));
2445 float C3 = (isDefault(argC3) ? 2.0 : valReal(argC3));
2446 int C4 = (isDefault(argC4) ? 15 : valInt(argC4));
2447 int C5 = (isDefault(argC5) ? 100 : valInt(argC5));
2448 int moved;
2449 Chain network;
2450 iarea limit;
2451
2452 if ( isNil(gr->device) )
2453 fail;
2454 if ( isDefault(area) )
2455 { limit.x = limit.y = 5;
2456 limit.w = limit.h = INT_MAX/2;
2457 } else
2458 { limit.x = valInt(area->x);
2459 limit.y = valInt(area->y);
2460 limit.w = valInt(area->w);
2461 limit.h = valInt(area->h);
2462
2463 NormaliseArea(limit.x, limit.y, limit.w, limit.h);
2464 }
2465
2466 if ( isDefault(work) )
2467 network = get(gr, NAME_network, EAV);
2468 else
2469 network = work;
2470 n = valInt(getSizeChain(network));
2471 if ( n <= 1 ) /* nothing to be done */
2472 succeed;
2473
2474 r = pceMalloc(n*sizeof(lg_relation *));
2475 for (i=0; i<n; i++)
2476 r[i] = pceMalloc(sizeof(lg_relation)*n);
2477 objects = pceMalloc(sizeof(lg_object)*n);
2478
2479 for (cell=network->head, op=objects; notNil(cell); op++, cell=cell->next)
2480 { Graphical gr = cell->value;
2481
2482 op->gr = gr;
2483 op->area.x = valInt(gr->area->x);
2484 op->area.y = valInt(gr->area->y);
2485 op->area.w = valInt(gr->area->w);
2486 op->area.h = valInt(gr->area->h);
2487 op->moved = TRUE;
2488 op->update = FALSE;
2489 if ( notDefault(move_only) )
2490 { if ( memberChain(move_only, gr) )
2491 op->fixed = FALSE;
2492 else
2493 op->fixed = TRUE;
2494 } else
2495 op->fixed = FALSE;
2496 }
2497 if ( isDefault(work) )
2498 doneObject(network);
2499
2500 for (i=0, op=objects; i<n; i++, op++)
2501 { lg_object *op2;
2502 lg_relation *rp;
2503 Any av[4];
2504 av[1] = av[2] = av[3] = DEFAULT;
2505
2506 for (j=0, op2=objects, rp = r[i]; j<i; j++, op2++, rp++)
2507 { av[0] = op2->gr;
2508 rp->c = qadGetv(op->gr, NAME_connected, 4, av);
2509 if ( rp->c )
2510 rp->ideal_len = qadGetv(rp->c, NAME_idealLength, 0, NULL);
2511 }
2512 r[i][i].fx = r[i][i].fy = 0; /* clean diagonal */
2513 }
2514
2515 moved = TRUE;
2516
2517 for (l=1; l<=C5 && moved; l++)
2518 { int recheck = (l%10 == 0); /* recheck computed length */
2519
2520 for (i=0; i<n; i++)
2521 { int mi = objects[i].moved;
2522 lg_relation *rp;
2523
2524 for (j=0, rp=r[i]; j<i; j++, rp++)
2525 { if (mi == FALSE && objects[j].moved == FALSE)
2526 continue;
2527
2528 d = distance_area(&objects[i].area, &objects[j].area);
2529 if (d == 0)
2530 { int f = ((int)C2<<10)/6;
2531
2532 r[j][i].fx = -(rp->fx = f);
2533 r[j][i].fy = -(rp->fy = f);
2534
2535 continue;
2536 }
2537 dx = (cx_object(&objects[j]) - cx_object(&objects[i])) << 10;
2538 dy = (cy_object(&objects[j]) - cy_object(&objects[i])) << 10;
2539
2540 if ( rp->c )
2541 { float c2;
2542
2543 if ( recheck && rp->ideal_len )
2544 { place_object(&objects[i]);
2545 place_object(&objects[j]);
2546 ComputeGraphical(rp->c);
2547 rp->ideal_len = qadGetv(rp->c, NAME_idealLength, 0, NULL);
2548 }
2549
2550 if ( rp->ideal_len )
2551 c2 = (float)valInt(rp->ideal_len);
2552 else
2553 c2 = C2;
2554
2555 force = forceAttract(d, C1, c2);
2556 } else
2557 force = forceRepel(d, C3);
2558
2559 r[j][i].fx = -(rp->fx = (dx * force) >> 11);
2560 r[j][i].fy = -(rp->fy = (dy * force) >> 11);
2561 }
2562 }
2563
2564 moved = FALSE;
2565 for (i=0, op=objects; i<n; i++, op++)
2566 { if ( op->fixed )
2567 { op->moved = FALSE;
2568 continue;
2569 }
2570
2571 dx = dy = 0;
2572 for (j=0; j<n; j++)
2573 { dx += r[i][j].fx;
2574 dy += r[i][j].fy;
2575 }
2576 dx = (((dx * C4) / n) + 512) >> 10;
2577 dy = (((dy * C4) / n) + 512) >> 10;
2578 if (dx == 0 && dy == 0)
2579 { op->moved = FALSE;
2580 continue;
2581 }
2582 op->update = op->moved = moved = TRUE;
2583 op->area.x += dx;
2584 op->area.y += dy;
2585 if ( op->area.x+op->area.w > limit.x + limit.w ) /* bounce on Window */
2586 op->area.x = limit.x + limit.w - op->area.w;
2587 if ( op->area.y+op->area.h > limit.y + limit.h ) /* bounce on Window */
2588 op->area.y = limit.y + limit.h - op->area.h;
2589 if ( op->area.x < limit.x ) /* bounce on Window */
2590 op->area.x = limit.x;
2591 if ( op->area.y < limit.y )
2592 op->area.y = limit.y;
2593 }
2594 }
2595
2596 for (i=0, op=objects; i<n; i++, op++) /* update display */
2597 place_object(op);
2598
2599 for(i=0; i<n; i++)
2600 pceFree(r[i]);
2601 pceFree(r);
2602 pceFree(objects);
2603
2604 succeed;
2605 }
2606
2607
2608 /********************************
2609 * EVENTS *
2610 ********************************/
2611
2612 status
eventGraphical(Any obj,EventObj ev)2613 eventGraphical(Any obj, EventObj ev)
2614 { Graphical gr = obj;
2615
2616 if ( gr->active != OFF )
2617 { Chain recognisers;
2618 Cell cell;
2619
2620 TRY( recognisers = getAllRecognisersGraphical(gr, OFF) );
2621
2622 for_cell(cell, recognisers)
2623 if ( qadSendv(cell->value, NAME_event, 1, (Any*)&ev) )
2624 succeed;
2625 }
2626
2627 fail;
2628 }
2629
2630
2631 static status
keyGraphical(Graphical gr,Name key)2632 keyGraphical(Graphical gr, Name key)
2633 { fail;
2634 }
2635
2636
2637 static status
keyboardFocusGraphical(Graphical gr,BoolObj val)2638 keyboardFocusGraphical(Graphical gr, BoolObj val)
2639 { PceWindow sw = getWindowGraphical(gr);
2640
2641 if ( sw )
2642 { if ( val == OFF )
2643 send(sw, NAME_keyboardFocus, NIL, EAV);
2644 else if ( val == ON || send(gr, NAME_WantsKeyboardFocus, EAV) )
2645 send(sw, NAME_keyboardFocus, gr, EAV);
2646 }
2647
2648 succeed;
2649 }
2650
2651
2652 BoolObj
getKeyboardFocusGraphical(Graphical gr)2653 getKeyboardFocusGraphical(Graphical gr)
2654 { PceWindow sw = getWindowGraphical(gr);
2655
2656 if ( sw && sw->keyboard_focus == gr )
2657 answer(ON);
2658
2659 answer(OFF);
2660 }
2661
2662
2663 status
generateEventGraphical(Graphical gr,Name name)2664 generateEventGraphical(Graphical gr, Name name)
2665 { int rval;
2666 EventObj ev = tempObject(ClassEvent, name, getWindowGraphical(gr), EAV);
2667
2668 rval = postEvent(ev, gr, DEFAULT);
2669 considerPreserveObject(ev);
2670
2671 return rval;
2672 }
2673
2674
2675 status
inEventAreaGraphical(Graphical gr,Int xc,Int yc)2676 inEventAreaGraphical(Graphical gr, Int xc, Int yc)
2677 { Area a = gr->area;
2678 int ax = valInt(a->x), ay = valInt(a->y),
2679 aw = valInt(a->w), ah = valInt(a->h);
2680 int x = valInt(xc), y = valInt(yc);
2681 static int evtol = -1;
2682
2683 if ( evtol < 0 )
2684 { Int v = getClassVariableValueObject(gr, NAME_eventTolerance);
2685 evtol = (v ? valInt(v) : 5);
2686 }
2687
2688 NormaliseArea(ax, ay, aw, ah);
2689 if ( aw < evtol ) ax -= (evtol-aw)/2, aw = evtol;
2690 if ( ah < evtol ) ay -= (evtol-ah)/2, ah = evtol;
2691
2692 if ( x >= ax && x <= ax + aw &&
2693 y >= ay && y <= ay + ah )
2694 { Class class = classOfObject(gr);
2695
2696 if ( class->in_event_area_function )
2697 { if ( class->in_event_area_function == INVOKE_FUNC )
2698 { Any av[2];
2699
2700 av[0] = xc;
2701 av[1] = yc;
2702
2703 return sendv(gr, NAME_inEventArea, 2, av);
2704 } else
2705 return (*class->in_event_area_function)(gr, xc, yc);
2706 }
2707
2708 succeed;
2709 }
2710
2711 fail;
2712 }
2713
2714
2715 static status
recogniserGraphical(Any gr,Any r)2716 recogniserGraphical(Any gr, Any r)
2717 { Chain ch = getAllRecognisersGraphical(gr, ON);
2718
2719 return appendChain(ch, r);
2720 }
2721
2722
2723 static status
prependRecogniserGraphical(Any gr,Any r)2724 prependRecogniserGraphical(Any gr, Any r)
2725 { Chain ch = getAllRecognisersGraphical(gr, ON);
2726
2727 return prependChain(ch, r);
2728 }
2729
2730
2731 static status
deleteRecogniserGraphical(Any gr,Any r)2732 deleteRecogniserGraphical(Any gr, Any r)
2733 { Chain ch;
2734
2735 TRY(ch = getAllRecognisersGraphical(gr, OFF));
2736
2737 return deleteChain(ch, r);
2738 }
2739
2740
2741 Chain
getAllRecognisersGraphical(Any obj,BoolObj create)2742 getAllRecognisersGraphical(Any obj, BoolObj create)
2743 { if ( onFlag(obj, F_RECOGNISER) )
2744 answer(getMemberHashTable(ObjectRecogniserTable, obj));
2745
2746 if ( create == ON )
2747 { Chain ch = newObject(ClassChain, EAV);
2748
2749 setFlag(obj, F_RECOGNISER);
2750 appendHashTable(ObjectRecogniserTable, obj, ch);
2751
2752 answer(ch);
2753 }
2754
2755 fail;
2756 }
2757
2758 /********************************
2759 * MISCELLANEOUS *
2760 ********************************/
2761
2762 status
assignGraphical(Any obj,Name slot,Any value)2763 assignGraphical(Any obj, Name slot, Any value)
2764 { Graphical gr = obj;
2765 Class class = classOfObject(gr);
2766 Variable var;
2767
2768 if ( (var = getInstanceVariableClass(class, (Any) slot)) != FAIL )
2769 { if ( getGetVariable(var, gr) != value )
2770 { setSlotInstance(gr, var, value);
2771 requestComputeGraphical(gr, DEFAULT);
2772 if ( gr->displayed == ON )
2773 { CHANGING_GRAPHICAL(gr,
2774 ComputeGraphical(gr);
2775 changedEntireImageGraphical(gr));
2776 }
2777 }
2778
2779 succeed;
2780 }
2781
2782 fail;
2783 }
2784
2785
2786 static status
bellGraphical(Graphical gr,Int volume)2787 bellGraphical(Graphical gr, Int volume)
2788 { DisplayObj d;
2789
2790 TRY( d = getDisplayGraphical(gr) );
2791
2792 return send(d, NAME_bell, volume, EAV);
2793 }
2794
2795
2796 status
flashGraphical(Graphical gr,Area a,Int time)2797 flashGraphical(Graphical gr, Area a, Int time)
2798 { PceWindow sw = getWindowGraphical(gr);
2799
2800 if ( sw )
2801 { int x, y;
2802 Int w, h;
2803 Area a2;
2804
2805 if ( isDefault(time) )
2806 time = getClassVariableValueObject(gr, NAME_visualBellDuration);
2807 if ( !isInteger(time) )
2808 time = toInt(250);
2809
2810 offsetDeviceGraphical(gr, &x, &y);
2811 x += valInt(gr->area->x);
2812 y += valInt(gr->area->y);
2813
2814 if ( isDefault(a) )
2815 { w = gr->area->w;
2816 h = gr->area->h;
2817 } else
2818 { x += valInt(a->x);
2819 y += valInt(a->y);
2820 w = a->w;
2821 h = a->h;
2822 }
2823
2824 a2 = answerObject(ClassArea, toInt(x), toInt(y), w, h, EAV);
2825 flashWindow(sw, a2, time);
2826 doneObject(a2);
2827 }
2828
2829 succeed;
2830 }
2831
2832
2833 status
alertGraphical(Graphical gr)2834 alertGraphical(Graphical gr)
2835 { if ( getClassVariableValueObject(gr, NAME_visualBell) == ON )
2836 return send(gr, NAME_flash, EAV);
2837 else
2838 return send(gr, NAME_bell, EAV);
2839 }
2840
2841
2842 Node
getNodeGraphical(Graphical gr)2843 getNodeGraphical(Graphical gr)
2844 { Tree t = (Tree) gr->device;
2845
2846 if ( instanceOfObject(t, ClassTree) )
2847 answer(getFindNodeNode(t->displayRoot, gr));
2848
2849 fail;
2850 }
2851
2852
2853 static status
popupGraphical(Graphical gr,PopupObj popup)2854 popupGraphical(Graphical gr, PopupObj popup)
2855 { if ( getInstanceVariableClass(classOfObject(gr), NAME_popup) )
2856 return send(gr, NAME_slot, NAME_popup, popup, EAV);
2857
2858 send(gr, NAME_attribute, newObject(ClassAttribute,
2859 NAME_popup, popup, EAV), EAV);
2860 send(gr, NAME_recogniser, popupGesture(), EAV);
2861
2862 succeed;
2863 }
2864
2865
2866 static PopupObj
getPopupGraphical(Graphical gr)2867 getPopupGraphical(Graphical gr)
2868 { return getAttributeObject(gr, NAME_popup);
2869 }
2870
2871
2872 status
pointerGraphical(Graphical gr,Point pos)2873 pointerGraphical(Graphical gr, Point pos)
2874 { Int x, y;
2875 PceWindow sw = DEFAULT;
2876
2877 get_absolute_xy_graphical(gr, (Device *)&sw, &x, &y);
2878 if ( instanceOfObject(sw, ClassWindow) )
2879 { Point p2;
2880
2881 p2 = tempObject(ClassPoint, add(x, pos->x), add(y, pos->y), EAV);
2882 pointerWindow(sw, p2);
2883 considerPreserveObject(p2);
2884 }
2885
2886 succeed;
2887 }
2888
2889
2890 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2891 Return the master of a graphical. This is supposed to deal with the case
2892 where another object is actually managing me. For the moment this is just
2893 a clutch. A more principal solution for this problem is studied.
2894 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2895
2896 Any
getMasterGraphical(Graphical gr)2897 getMasterGraphical(Graphical gr)
2898 { if ( instanceOfObject(gr->device, ClassTree) )
2899 { Tree t = (Tree) gr->device;
2900 Any master;
2901
2902 if ( (master=getFindNodeNode(t->displayRoot, gr)) )
2903 answer(master);
2904 }
2905
2906 answer(gr);
2907 }
2908
2909
2910 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2911 Similar problem. See `device->append_dialog_item'. Without this, the
2912 methods are done on the window, rather than on its decorator.
2913 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
2914
2915 static Any
getContainerGraphical(Any gr)2916 getContainerGraphical(Any gr)
2917 { if ( instanceOfObject(gr, ClassWindow) )
2918 { PceWindow sw = (PceWindow) gr;
2919
2920 if ( notNil(sw->decoration) )
2921 answer(sw->decoration);
2922 }
2923
2924 answer(gr);
2925 }
2926
2927
2928 status
nameGraphical(Graphical gr,Name name)2929 nameGraphical(Graphical gr, Name name)
2930 { assign(gr, name, name);
2931
2932 succeed;
2933 }
2934
2935
2936 static status
overlapGraphical(Graphical gr,Any obj)2937 overlapGraphical(Graphical gr, Any obj)
2938 { if ( instanceOfObject(obj, ClassGraphical) )
2939 return overlapArea(getAreaGraphical(gr), getAreaGraphical(obj));
2940 else
2941 return overlapArea(getAreaGraphical(gr), obj);
2942 }
2943
2944 /*******************************
2945 * GENERIC LAYOUT MANAGEMENT *
2946 *******************************/
2947
2948 static status
layoutInterfaceGraphical(Graphical gr,LayoutInterface itf)2949 layoutInterfaceGraphical(Graphical gr, LayoutInterface itf)
2950 { if ( notNil(itf) && notNil(gr->layout_interface) )
2951 return errorPce(gr, NAME_noChangeLayoutInterface);
2952
2953 assign(gr, layout_interface, itf);
2954
2955 succeed;
2956 }
2957
2958
2959 /********************************
2960 * VISUAL *
2961 ********************************/
2962
2963 Any
getContainedInGraphical(Graphical gr)2964 getContainedInGraphical(Graphical gr)
2965 { if ( notNil(gr->device) )
2966 { if ( instanceOfObject(gr->device, ClassTree) )
2967 answer(getNodeGraphical(gr));
2968
2969 answer(gr->device);
2970 }
2971
2972 fail;
2973 }
2974
2975
2976 status
initialiseNewSlotGraphical(Graphical gr,Variable new)2977 initialiseNewSlotGraphical(Graphical gr, Variable new)
2978 { if ( new->name == NAME_shadow )
2979 setSlotInstance(gr, new, ZERO);
2980 else if ( new->name == NAME_active )
2981 setSlotInstance(gr, new, ON);
2982
2983 succeed;
2984 }
2985
2986 /*******************************
2987 * POSTSCRIPT *
2988 *******************************/
2989
2990 static status
drawPostScriptGraphical(Graphical gr,Name hb)2991 drawPostScriptGraphical(Graphical gr, Name hb)
2992 { if ( gr->area->w != ZERO && gr->area->h != ZERO )
2993 { Image i;
2994
2995 if ( (i=checkType(gr, nameToType(NAME_image), gr)) )
2996 { BitmapObj bm = answerObject(ClassBitmap, i, EAV);
2997
2998 setGraphical(bm, gr->area->x, gr->area->y, DEFAULT, DEFAULT);
2999 send(bm, NAME_DrawPostScript, hb, EAV);
3000 doneObject(bm);
3001 doneObject(i);
3002
3003 succeed;
3004 }
3005
3006 fail;
3007 }
3008
3009 succeed;
3010 }
3011
3012 /*******************************
3013 * DRAW *
3014 *******************************/
3015
3016 status
clipGraphical(Graphical gr,Area a)3017 clipGraphical(Graphical gr, Area a)
3018 { if ( isDefault(a) )
3019 a = gr->area;
3020
3021 d_clip(valInt(a->x), valInt(a->y), valInt(a->w), valInt(a->h));
3022
3023 succeed;
3024 }
3025
3026
3027 status
unclipGraphical(Graphical gr)3028 unclipGraphical(Graphical gr)
3029 { d_clip_done();
3030
3031 succeed;
3032 }
3033
3034
3035 static status
saveGraphicsStateGraphical(Graphical gr)3036 saveGraphicsStateGraphical(Graphical gr)
3037 { g_save();
3038
3039 succeed;
3040 }
3041
3042
3043 static status
restoreGraphicsStateGraphical(Graphical gr)3044 restoreGraphicsStateGraphical(Graphical gr)
3045 { g_restore();
3046
3047 succeed;
3048 }
3049
3050
3051 static status
graphicsStateGraphical(Graphical gr,Int pen,Name texture,Colour colour,Colour background)3052 graphicsStateGraphical(Graphical gr,
3053 Int pen, Name texture,
3054 Colour colour, Colour background)
3055 { if ( notDefault(pen) )
3056 r_thickness(valInt(pen));
3057 if ( notDefault(texture) )
3058 r_dash(texture);
3059 if ( notDefault(colour) )
3060 r_colour(colour);
3061 if ( notDefault(background) )
3062 r_background(background);
3063
3064 succeed;
3065 }
3066
3067
3068 static status
drawLineGraphical(Graphical gr,Int x1,Int y1,Int x2,Int y2)3069 drawLineGraphical(Graphical gr, Int x1, Int y1, Int x2, Int y2)
3070 { r_line(valInt(x1), valInt(y1), valInt(x2), valInt(y2));
3071
3072 succeed;
3073 }
3074
3075
3076 static status
drawPolyGraphical(Graphical gr,Any points,BoolObj closed,Any fill)3077 drawPolyGraphical(Graphical gr, Any points, BoolObj closed, Any fill)
3078 { IPoint pts;
3079 int npts = 0;
3080
3081 if ( instanceOfObject(points, ClassChain) )
3082 { Chain ch = points;
3083 Cell cell;
3084
3085 pts = (IPoint)alloca(sizeof(ipoint) * valInt(ch->size));
3086 for_cell(cell, ch)
3087 { Point pt = cell->value;
3088
3089 if ( instanceOfObject(pt, ClassPoint) )
3090 { pts[npts].x = valInt(pt->x);
3091 pts[npts].y = valInt(pt->y);
3092 npts++;
3093 } else
3094 { return errorPce(pt, NAME_unexpectedType, nameToType(NAME_point));
3095 }
3096 }
3097 } else /* vector */
3098 { Vector vector = points;
3099 Point pt;
3100
3101 pts = (IPoint) alloca(sizeof(ipoint) * valInt(vector->size));
3102
3103 for_vector(vector, pt,
3104 { if ( instanceOfObject(pt, ClassPoint) )
3105 { pts[npts].x = valInt(pt->x);
3106 pts[npts].y = valInt(pt->y);
3107 npts++;
3108 } else
3109 { return errorPce(pt, NAME_unexpectedType,
3110 nameToType(NAME_point));
3111 }
3112 });
3113 }
3114
3115 r_polygon(pts, npts, closed == ON);
3116 if ( notDefault(fill) && notNil(fill) )
3117 { r_fillpattern(fill, NAME_foreground);
3118 r_fill_polygon(pts, npts);
3119 }
3120
3121 succeed;
3122 }
3123
3124
3125 static status
drawArcGraphical(Graphical gr,Int x,Int y,Int w,Int h,Real start,Real end,Any fill)3126 drawArcGraphical(Graphical gr, /* has to handle mode */
3127 Int x, Int y, Int w, Int h,
3128 Real start, Real end, Any fill)
3129 { int s = (isDefault(start) ? 0 : rfloat(valReal(start) * 64.0));
3130 int e = (isDefault(end) ? 360*64 : rfloat(valReal(end) * 64.0));
3131
3132 if ( isDefault(fill) )
3133 fill = NIL;
3134
3135 r_arc(valInt(x), valInt(y), valInt(w), valInt(h), s, e, fill);
3136
3137 succeed;
3138 }
3139
3140
3141 static status
drawBoxGraphical(Graphical gr,Int x,Int y,Int w,Int h,Int r,Any fill,BoolObj up)3142 drawBoxGraphical(Graphical gr,
3143 Int x, Int y, Int w, Int h,
3144 Int r, Any fill, BoolObj up)
3145 { int radius = (isDefault(r) ? 0 : valInt(r));
3146 Any fillp;
3147 Elevation e;
3148
3149 if ( isNil(fill) || isDefault(fill) )
3150 { e = NIL;
3151 fillp = NIL;
3152 } else if ( instanceOfObject(fill, ClassElevation) )
3153 { e = fill;
3154 fillp = NIL;
3155 } else
3156 { e = NIL;
3157 fillp = fill;
3158 }
3159
3160 if ( isNil(e) )
3161 r_box(valInt(x), valInt(y), valInt(w), valInt(h), radius, fillp);
3162 else
3163 r_3d_box(valInt(x), valInt(y), valInt(w), valInt(h), radius, e, up != OFF);
3164
3165 succeed;
3166 }
3167
3168
3169 static status
drawFillGraphical(Graphical gr,Int x,Int y,Int w,Int h,Any fill)3170 drawFillGraphical(Graphical gr,
3171 Int x, Int y, Int w, Int h,
3172 Any fill)
3173 { int ax = valInt(x), ay = valInt(y), aw = valInt(w), ah = valInt(h);
3174
3175 if ( isNil(fill) )
3176 r_clear(ax, ay, aw, ah);
3177 else if ( isDefault(fill) )
3178 r_fill(ax, ay, aw, ah, fill);
3179
3180 succeed;
3181 }
3182
3183
3184 static status
drawImageGraphical(Graphical gr,Image img,Int x,Int y,Int sx,Int sy,Int sw,Int sh,BoolObj transparent)3185 drawImageGraphical(Graphical gr, Image img,
3186 Int x, Int y,
3187 Int sx, Int sy, Int sw, Int sh, BoolObj transparent)
3188 { if ( isDefault(transparent) )
3189 transparent = ON;
3190
3191 r_image(img,
3192 isDefault(sx) ? 0 : valInt(sx),
3193 isDefault(sy) ? 0 : valInt(sy),
3194 valInt(x), valInt(y),
3195 isDefault(sw) ? valInt(img->size->w) : valInt(sw),
3196 isDefault(sh) ? valInt(img->size->h) : valInt(sh),
3197 transparent);
3198
3199 succeed;
3200 }
3201
3202 static status
drawTextGraphical(Graphical gr,CharArray txt,FontObj font,Int x,Int y,Int w,Int h,Name hadjust,Name vadjust)3203 drawTextGraphical(Graphical gr, CharArray txt, FontObj font,
3204 Int x, Int y, Int w, Int h,
3205 Name hadjust, Name vadjust)
3206 { if ( isDefault(w) && isDefault(h) )
3207 { s_print(&txt->data, valInt(x), valInt(y), font);
3208 } else
3209 { if ( isDefault(hadjust) )
3210 hadjust = NAME_left;
3211 if ( isDefault(vadjust) )
3212 vadjust = NAME_top;
3213
3214 str_string(&txt->data, font,
3215 valInt(x), valInt(y), valInt(w), valInt(h),
3216 hadjust, vadjust, 0);
3217 }
3218
3219 succeed;
3220 }
3221
3222
3223 static status
solidGraphical(Graphical gr,BoolObj solid)3224 solidGraphical(Graphical gr, BoolObj solid)
3225 { if ( solid == ON )
3226 setFlag(gr, F_SOLID);
3227 else
3228 clearFlag(gr, F_SOLID);
3229
3230 succeed;
3231 }
3232
3233
3234 static BoolObj
getSolidGraphical(Graphical gr)3235 getSolidGraphical(Graphical gr)
3236 { answer(onFlag(gr, F_SOLID) ? ON : OFF);
3237 }
3238
3239
3240 /* Type declaractions */
3241
3242 static char *T_layout[] =
3243 { "attract=[real]", "nominal=[real]", "repel=[real]",
3244 "adapt=[int]", "iterations=[int]",
3245 "area=[area]",
3246 "network=[chain]",
3247 "move_only=[chain]"
3248 };
3249 static char *T_resize[] =
3250 { "factor_x=real", "factor_y=[real]", "origin=[point]" };
3251 static char *T_drawImage[] =
3252 { "image", "x=int", "y=int", "sx=[int]", "sy=[int]",
3253 "sw=[int]", "sh=[int]", "transparent=[bool]" };
3254 static char *T_postscript[] =
3255 { "landscape=[bool]", "maximum_area=[area]" };
3256 static char *T_network[] =
3257 { "link=[link]", "from_kind=[name]", "to_kind=[name]" };
3258 static char *T_handlePosition[] =
3259 { "name=name", "device=[device]" };
3260 static char *T_handles[] =
3261 { "near=[point]", "kind=[name]", "distance=[int]" };
3262 static char *T_draw[] =
3263 { "offset=[point]", "area=[area]" };
3264 static char *T_graphicsState[] =
3265 { "pen=[0..]", "texture=[texture_name]", "colour=[colour|pixmap]",
3266 "background=[colour|pixmap]" };
3267 static char *T_drawPoly[] =
3268 { "points=chain|vector", "closed=[bool]", "fill=[colour|image]*" };
3269 static char *T_focus[] =
3270 { "recogniser=[recogniser]", "cursor=[cursor]", "button=[name]" };
3271 static char *T_drawText[] =
3272 { "string=char_array", "font", "x=int", "y=int", "w=[0..]", "h=[0..]",
3273 "hadjust=[{left,center,right}]", "vadjust=[{top,center,bottom}]" };
3274 static char *T_connections[] =
3275 { "to=[graphical]", "link=[link]",
3276 "from_kind=[name]", "to_kind=[name]" };
3277 static char *T_link[] =
3278 { "to=[graphical]", "link=[link]",
3279 "to_kind=[name]", "from_kind=[name]" };
3280 static char *T_drawLine[] =
3281 { "x1=[int]", "y1=[int]", "x2=[int]", "y2=[int]" };
3282 static char *T_geometry[] =
3283 { "x=[int]", "y=[int]", "width=[int]", "height=[int]" };
3284 static char *T_inEventArea[] =
3285 { "x=int", "y=int" };
3286 static char *T_drawArc[] =
3287 { "x=int", "y=int", "w=int", "h=int",
3288 "angle1=[real]", "angle2=[real]", "fill=[colour|image]*" };
3289 static char *T_drawFill[] =
3290 { "x=int", "y=int", "w=int", "h=int", "fill=[colour|image]*" };
3291 static char *T_drawBox[] =
3292 { "x=int", "y=int", "w=int", "h=int", "radius=[0..]",
3293 "fill=[image|colour|elevation]", "up=[bool]" };
3294 static char *T_flash[] =
3295 { "area=[area]", "time=[int]" };
3296 static char *T_containerSizeChanged[] =
3297 { "width=[int]", "height=[int]" };
3298
3299 /* Instance Variables */
3300
3301 static vardecl var_graphical[] =
3302 { SV(NAME_device, "device*", IV_GET|IV_STORE, deviceGraphical,
3303 NAME_organisation, "Device I'm displayed on"),
3304 SV(NAME_area, "area", IV_NONE|IV_STORE, areaGraphical,
3305 NAME_area, "Bounding box of affected pixels"),
3306 SV(NAME_displayed, "bool", IV_GET|IV_STORE, displayedGraphical,
3307 NAME_visibility, "If @on, graphical is visible"),
3308 SV(NAME_pen, "0..", IV_GET|IV_STORE, penGraphical,
3309 NAME_appearance, "Thickness of drawing pen"),
3310 SV(NAME_texture, "texture_name", IV_GET|IV_STORE, textureGraphical,
3311 NAME_appearance, "Stipple pattern of drawing pen"),
3312 SV(NAME_colour, "[colour|pixmap]", IV_GET|IV_STORE, colourGraphical,
3313 NAME_appearance, "Colour of drawing pen"),
3314 IV(NAME_handles, "chain*", IV_NONE,
3315 NAME_relation, "Connection points for connections"),
3316 IV(NAME_connections, "chain*", IV_NONE,
3317 NAME_relation, "Connections (links) to other graphicals"),
3318 IV(NAME_name, "name", IV_BOTH,
3319 NAME_name, "Name of graphical"),
3320 SV(NAME_selected, "bool", IV_GET|IV_STORE, selectedGraphical,
3321 NAME_selection, "If @on, I'm selected"),
3322 SV(NAME_inverted, "bool", IV_GET|IV_STORE, invertedGraphical,
3323 NAME_appearance, "If @on, invert bounding box after painting"),
3324 SV(NAME_active, "bool", IV_GET|IV_STORE, activeGraphical,
3325 NAME_event, "If @off, greyed out and insensitive"),
3326 SV(NAME_cursor, "cursor*", IV_GET|IV_STORE, cursorGraphical,
3327 NAME_cursor, "Cursor when in focus of events"),
3328 SV(NAME_layoutInterface, "layout_interface*", IV_GET|IV_STORE,
3329 layoutInterfaceGraphical,
3330 NAME_layout, "Interface to layout-manager"),
3331 IV(NAME_requestCompute, "any*", IV_GET,
3332 NAME_update, "Graphical requests recomputing")
3333 };
3334
3335 /* Send Methods */
3336
3337 static senddecl send_graphical[] =
3338 { SM(NAME_initialise, 4, T_geometry, initialiseGraphical,
3339 DEFAULT, "Create from XYWH"),
3340 SM(NAME_unlink, 0, NULL, unlinkGraphical,
3341 DEFAULT, "Erase from device"),
3342 SM(NAME_key, 1, "name", keyGraphical,
3343 NAME_accelerator, "Accelerator-key pressed (fail)"),
3344 SM(NAME_flush, 0, NULL, flushGraphical,
3345 NAME_animate, "Flush changes to the display"),
3346 SM(NAME_synchronise, 1, "[always=bool]", synchroniseGraphical,
3347 NAME_animate, "->flush and process all events"),
3348 SM(NAME_apply, 1, "[bool]", virtualObject,
3349 NAME_apply, "Virtual method"),
3350 SM(NAME_restore, 0, NULL, virtualObject,
3351 NAME_apply, "Virtual method"),
3352 SM(NAME_bottomSide, 1, "int", bottomSideGraphical,
3353 NAME_area, "Resize graphical to set bottom-side"),
3354 SM(NAME_center, 1, "point", centerGraphical,
3355 NAME_area, "Move to make point the center"),
3356 SM(NAME_centerX, 1, "int", centerXGraphical,
3357 NAME_area, "Move horizontal to make int the <-x_center"),
3358 SM(NAME_centerY, 1, "int", centerYGraphical,
3359 NAME_area, "Move vertical to make int the <-y_center"),
3360 SM(NAME_corner, 1, "point", cornerGraphical,
3361 NAME_area, "Resize to make opposite of origin point"),
3362 SM(NAME_cornerX, 1, "int", cornerXGraphical,
3363 NAME_area, "Resize to set X of ->corner"),
3364 SM(NAME_cornerY, 1, "int", cornerYGraphical,
3365 NAME_area, "Resize to set Y of ->corner"),
3366 SM(NAME_doSet, 4, T_geometry, doSetGraphical,
3367 NAME_area, "Set X, Y, W and H for graphical"),
3368 SM(NAME_height, 1, "int", heightGraphical,
3369 NAME_area, "Set height"),
3370 SM(NAME_leftSide, 1, "int", leftSideGraphical,
3371 NAME_area, "Resize graphical to set left-side"),
3372 SM(NAME_move, 1, "point", positionGraphical,
3373 NAME_area, "Move origin to argument"),
3374 SM(NAME_normalise, 0, NULL, normaliseGraphical,
3375 NAME_area, "Make top-left corner the origin"),
3376 SM(NAME_orientation, 1, "{north_west,south_west,north_east,south_east}",
3377 orientationGraphical,
3378 NAME_area, "Put origin at {north,south}_{west,east}"),
3379 SM(NAME_position, 1, "point", positionGraphical,
3380 NAME_area, "Move origin to argument (as ->move)"),
3381 SM(NAME_relativeMove, 1, "point", relativeMoveGraphical,
3382 NAME_area, "Move origin by argument"),
3383 SM(NAME_resize, 3, T_resize, resizeGraphical,
3384 NAME_area, "Resize graphical with specified factor"),
3385 SM(NAME_rightSide, 1, "int", rightSideGraphical,
3386 NAME_area, "Resize graphical to set right-side"),
3387 SM(NAME_set, 4, T_geometry, setGraphical,
3388 NAME_area, "Request new X, Y, W and H for graphical"),
3389 SM(NAME_size, 1, "size", sizeGraphical,
3390 NAME_area, "Resize to specified size"),
3391 SM(NAME_topSide, 1, "int", topSideGraphical,
3392 NAME_area, "Resize graphical to set top-side"),
3393 SM(NAME_width, 1, "int", widthGraphical,
3394 NAME_area, "Width of graphical"),
3395 SM(NAME_x, 1, "int", xGraphical,
3396 NAME_area, "Move graphical horizontally"),
3397 SM(NAME_y, 1, "int", yGraphical,
3398 NAME_area, "Move graphical vertically"),
3399 SM(NAME_clip, 1, "[area]", clipGraphical,
3400 NAME_draw, "Clip subsequent drawing actions to area"),
3401 SM(NAME_drawArc, 7, T_drawArc, drawArcGraphical,
3402 NAME_draw, "Draw a ellipse-part"),
3403 SM(NAME_drawBox, 7, T_drawBox, drawBoxGraphical,
3404 NAME_draw, "Draw rectangular (rounded) box"),
3405 SM(NAME_drawFill, 5, T_drawFill, drawFillGraphical,
3406 NAME_draw, "Fill rectangle with specified pattern"),
3407 SM(NAME_drawImage, 8, T_drawImage, drawImageGraphical,
3408 NAME_draw, "Draw a bitmap or pixmap image"),
3409 SM(NAME_drawLine, 4, T_drawLine, drawLineGraphical,
3410 NAME_draw, "Draw line segment from (X1,Y1) to (X2,Y2)"),
3411 SM(NAME_drawPoly, 3, T_drawPoly, drawPolyGraphical,
3412 NAME_draw, "Draw/fill a polyfon"),
3413 SM(NAME_drawText, 8, T_drawText, drawTextGraphical,
3414 NAME_draw, "Draw text-string"),
3415 SM(NAME_graphicsState, 4, T_graphicsState, graphicsStateGraphical,
3416 NAME_draw, "Modify the graphics state"),
3417 SM(NAME_restoreGraphicsState, 0, NULL, restoreGraphicsStateGraphical,
3418 NAME_draw, "Restore saved pen, texture, colours and font"),
3419 SM(NAME_saveGraphicsState, 0, NULL, saveGraphicsStateGraphical,
3420 NAME_draw, "Save current pen, texture, colours and font"),
3421 SM(NAME_unclip, 0, NULL, unclipGraphical,
3422 NAME_draw, "Undo previous ->clip"),
3423 SM(NAME_solid, 1, "solid=bool", solidGraphical,
3424 NAME_draw, "a ->_redraw_area touched all pixels"),
3425 SM(NAME_deleteRecogniser, 1, "recogniser", deleteRecogniserGraphical,
3426 NAME_event, "Delete a recogniser"),
3427 SM(NAME_event, 1, "event", eventGraphical,
3428 NAME_event, "Handle a user-event"),
3429 SM(NAME_generateEvent, 1, "event_id", generateEventGraphical,
3430 NAME_event, "Generate named event for graphical"),
3431 SM(NAME_inEventArea, 2, T_inEventArea, inEventAreaGraphical,
3432 NAME_event, "Test if (X,Y) is in the sensitive area for events"),
3433 SM(NAME_keyboardFocus, 1, "[bool]", keyboardFocusGraphical,
3434 NAME_event, "Get <-window's keyboard_focus if ->_wants_keyboard_focus"),
3435 SM(NAME_prependRecogniser, 1, "recogniser", prependRecogniserGraphical,
3436 NAME_event, "Add recogniser for user events (first)"),
3437 SM(NAME_recogniser, 1, "recogniser", recogniserGraphical,
3438 NAME_event, "Add recogniser for user events (last)"),
3439 SM(NAME_initialiseNewSlot, 1, "new=variable", initialiseNewSlotGraphical,
3440 NAME_file, "Assigns <-shadow to ZERO, active to @off"),
3441 SM(NAME_WantsKeyboardFocus, 0, NULL, WantsKeyboardFocusGraphical,
3442 NAME_focus, "Test if graphicals wants keyboard events (fail)"),
3443 SM(NAME_focus, 3, T_focus, focusGraphical,
3444 NAME_focus, "Set window focus to this graphical"),
3445 SM(NAME_focusCursor, 1, "cursor*", focusCursorGraphical,
3446 NAME_focus, "Set cursor until focus in released"),
3447 SM(NAME_above, 1, "graphical*", aboveGraphical,
3448 NAME_layout, "Put me above argument"),
3449 SM(NAME_alignment, 1, "{left,center,right,column}", alignmentGraphical,
3450 NAME_layout, "Dialog item integration"),
3451 SM(NAME_autoAlign, 1, "bool", autoAlignGraphical,
3452 NAME_layout, "Dialog_item integration"),
3453 SM(NAME_autoLabelAlign, 1, "bool", autoLabelAlignGraphical,
3454 NAME_layout, "Dialog item integration"),
3455 SM(NAME_autoValueAlign, 1, "bool", autoValueAlignGraphical,
3456 NAME_layout, "Dialog item integration"),
3457 SM(NAME_below, 1, "graphical*", belowGraphical,
3458 NAME_layout, "Put me below argument"),
3459 SM(NAME_layout, 8, T_layout, layoutGraphical,
3460 NAME_layout, "Make graph-layout for connected graphicals"),
3461 SM(NAME_left, 1, "graphical*", leftGraphical,
3462 NAME_layout, "Put me left of argument"),
3463 SM(NAME_reference, 1, "point", referenceGraphical,
3464 NAME_layout, "Dialog item integration"),
3465 SM(NAME_right, 1, "graphical*", rightGraphical,
3466 NAME_layout, "Put me right of argument"),
3467 SM(NAME_layoutDialog, 0, NULL, layoutDialogGraphical,
3468 NAME_layout, "Compute layout as a dialog object"),
3469 SM(NAME_popup, 1, "popup", popupGraphical,
3470 NAME_menu, "Associate a popup menu with the graphical"),
3471 SM(NAME_displayOn, 1, "device*", displayOnGraphical,
3472 NAME_organisation, "Set device and ensure ->displayed: @on"),
3473 SM(NAME_reparent, 0, NULL, reparentGraphical,
3474 NAME_organisation, "Graphicals parent-chain has changed"),
3475 SM(NAME_pointer, 1, "point", pointerGraphical,
3476 NAME_pointer, "Warp pointer relative to graphical"),
3477 SM(NAME_DrawPostScript, 1, "{head,body}", drawPostScriptGraphical,
3478 NAME_postscript, "Create PostScript using intermediate image object"),
3479 SM(NAME_Postscript, 1, "{head,body}", postscriptGraphical,
3480 NAME_postscript, "Create PostScript"),
3481 SM(NAME_connect, 4, T_link, connectGraphical,
3482 NAME_relation, "Create a connection to another graphical"),
3483 SM(NAME_connected, 4, T_link, connectedGraphical,
3484 NAME_relation, "Test if graphical has specified connection"),
3485 SM(NAME_disconnect, 4, T_link, disconnectGraphical,
3486 NAME_relation, "Delete matching connections"),
3487 SM(NAME_handle, 1, "handle", handleGraphical,
3488 NAME_relation, "Add connection point for connection"),
3489 SM(NAME_draw, 2, T_draw, drawGraphical,
3490 NAME_repaint, "Draw specified area"),
3491 SM(NAME_paintSelected, 0, NULL, paintSelectedGraphical,
3492 NAME_repaint, "Paint selection feedback"),
3493 SM(NAME_redraw, 1, "[area]", redrawGraphical,
3494 NAME_repaint, "Request to repaint indicated area"),
3495 SM(NAME_alert, 0, NULL, alertGraphical,
3496 NAME_report, "Alert visual or using the bell"),
3497 SM(NAME_bell, 1, "[int]", bellGraphical,
3498 NAME_report, "Ring the bell on associated display"),
3499 SM(NAME_flash, 2, T_flash, flashGraphical,
3500 NAME_report, "Alert visual by temporary inverting"),
3501 SM(NAME_geometry, 4, T_geometry, geometryGraphical,
3502 NAME_resize, "Resize graphical"),
3503 SM(NAME_requestGeometry, 4, T_geometry, requestGeometryGraphical,
3504 NAME_resize, "Request resize for graphical"),
3505 SM(NAME_rotate, 1, "int", rotateGraphical,
3506 NAME_rotate, "Rotate (multiple of 90) degrees"),
3507 SM(NAME_toggleSelected, 0, NULL, toggleSelectedGraphical,
3508 NAME_selection, "Change selected status"),
3509 SM(NAME_expose, 1, "[graphical]", exposeGraphical,
3510 NAME_stacking, "Place graphical on top or above argument"),
3511 SM(NAME_hide, 1, "[graphical]", hideGraphical,
3512 NAME_stacking, "Place in background or below argument"),
3513 SM(NAME_overlap, 1, "graphical|area", overlapGraphical,
3514 NAME_stacking, "Succeeds if graphical overlaps with argument"),
3515 SM(NAME_swap, 1, "graphical", swapGraphical,
3516 NAME_stacking, "Swap stacking order of graphicals"),
3517 SM(NAME_compute, 0, NULL, computeGraphical,
3518 NAME_update, "Update status of graphical"),
3519 SM(NAME_requestCompute, 1, "[any]*", requestComputeGraphical,
3520 NAME_update, "Request a ->compute on next repaint"),
3521 SM(NAME_containerSizeChanged, 2, T_containerSizeChanged,
3522 virtualObject,
3523 NAME_area, "<-width or <-height of <-contained_in changed")
3524 };
3525
3526 /* Get Methods */
3527
3528 static getdecl get_graphical[] =
3529 { GM(NAME_containedIn, 0, "device|node", NULL, getContainedInGraphical,
3530 DEFAULT, "Device I'm contained in"),
3531 GM(NAME_displayColour, 0, "colour|pixmap", NULL, getDisplayColourGraphical,
3532 NAME_appearance, "Colour graphical is displayed in"),
3533 GM(NAME_absolutePosition, 1, "point", "[device]", getAbsolutePositionGraphical,
3534 NAME_area, "Get position relative to device (or window)"),
3535 GM(NAME_absoluteX, 1, "int", "[device]", getAbsoluteXGraphical,
3536 NAME_area, "Get X-position relative to device"),
3537 GM(NAME_absoluteY, 1, "int", "[device]", getAbsoluteYGraphical,
3538 NAME_area, "Get Y-position relative to device"),
3539 GM(NAME_area, 0, "area", NULL, getAreaGraphical,
3540 NAME_area, "->compute and return area slot"),
3541 GM(NAME_bottomSide, 0, "int", NULL, getBottomSideGraphical,
3542 NAME_area, "Bottom-side of graphical"),
3543 GM(NAME_center, 0, "point", NULL, getCenterGraphical,
3544 NAME_area, "New point representing center"),
3545 GM(NAME_centerX, 0, "int", NULL, getCenterXGraphical,
3546 NAME_area, "X-coordinate of center"),
3547 GM(NAME_centerY, 0, "int", NULL, getCenterYGraphical,
3548 NAME_area, "Y-coordinate of center"),
3549 GM(NAME_corner, 0, "point", NULL, getCornerGraphical,
3550 NAME_area, "New point from point opposite origin"),
3551 GM(NAME_cornerX, 0, "int", NULL, getCornerXGraphical,
3552 NAME_area, "X-coordinate of corner"),
3553 GM(NAME_cornerY, 0, "int", NULL, getCornerYGraphical,
3554 NAME_area, "Y-coordinate of corner"),
3555 GM(NAME_displayedCursor, 0, "cursor*", NULL, getDisplayedCursorGraphical,
3556 NAME_cursor, "Currently displayed cursor"),
3557 GM(NAME_displayPosition, 0, "point", NULL, getDisplayPositionGraphical,
3558 NAME_area, "Position relative to display"),
3559 GM(NAME_height, 0, "int", NULL, getHeightGraphical,
3560 NAME_area, "Height of graphical"),
3561 GM(NAME_leftSide, 0, "int", NULL, getLeftSideGraphical,
3562 NAME_area, "Left-side of graphical"),
3563 GM(NAME_orientation, 0, "{north_west,south_west,north_east,south_east}",
3564 NULL, getOrientationGraphical,
3565 NAME_area, "Current orientation"),
3566 GM(NAME_position, 0, "point", NULL, getPositionGraphical,
3567 NAME_area, "New point representing origin"),
3568 GM(NAME_rightSide, 0, "int", NULL, getRightSideGraphical,
3569 NAME_area, "Right-side of graphical"),
3570 GM(NAME_size, 0, "size", NULL, getSizeGraphical,
3571 NAME_area, "New size representing size"),
3572 GM(NAME_topSide, 0, "int", NULL, getTopSideGraphical,
3573 NAME_area, "Top-side of graphical"),
3574 GM(NAME_width, 0, "int", NULL, getWidthGraphical,
3575 NAME_area, "Width of graphical"),
3576 GM(NAME_x, 0, "int", NULL, getXGraphical,
3577 NAME_area, "X or origin"),
3578 GM(NAME_y, 0, "int", NULL, getYGraphical,
3579 NAME_area, "Y of origin"),
3580 GM(NAME_convert, 1, "graphical", "object", getConvertGraphical,
3581 NAME_conversion, "Convert using <-image"),
3582 GM(NAME_keyboardFocus, 0, "bool", NULL, getKeyboardFocusGraphical,
3583 NAME_focus, "@on if graphical is in focus of the keyboard"),
3584 GM(NAME_above, 0, "graphical", NULL, getFailObject,
3585 NAME_layout, "Dialog_item integration; fails"),
3586 GM(NAME_alignment, 0, "name", NULL, getAlignmentGraphical,
3587 NAME_layout, "Dialog_item integration"),
3588 GM(NAME_autoAlign, 0, "bool", NULL, getAutoAlignGraphical,
3589 NAME_layout, "Dialog_item integration"),
3590 GM(NAME_autoLabelAlign, 0, "bool", NULL, getAutoLabelAlignGraphical,
3591 NAME_layout, "Dialog_item integration"),
3592 GM(NAME_autoValueAlign, 0, "bool", NULL, getAutoValueAlignGraphical,
3593 NAME_layout, "Dialog_item integration"),
3594 GM(NAME_below, 0, "graphical", NULL, getFailObject,
3595 NAME_layout, "Dialog_item integration; fails"),
3596 GM(NAME_left, 0, "graphical", NULL, getFailObject,
3597 NAME_layout, "Dialog_item integration; fails"),
3598 GM(NAME_reference, 0, "point", NULL, getFailObject,
3599 NAME_layout, "Dialog_item integration; fails"),
3600 GM(NAME_horStretch, 0, "0..100", NULL, getFailObject,
3601 NAME_layout, "Horizontal stretchability of dialog item (fail)"),
3602 GM(NAME_verStretch, 0, "0..100", NULL, getFailObject,
3603 NAME_layout, "Vertical stretchability of dialog item (fail)"),
3604 GM(NAME_right, 0, "graphical", NULL, getFailObject,
3605 NAME_layout, "Dialog_item integration; fails"),
3606 GM(NAME_popup, 0, "popup", NULL, getPopupGraphical,
3607 NAME_menu, "Associated ->popup"),
3608 GM(NAME_allRecognisers, 1, "chain", "create=[bool]", getAllRecognisersGraphical,
3609 NAME_meta, "Chain with all recognisers"),
3610 GM(NAME_node, 0, "node", NULL, getNodeGraphical,
3611 NAME_nodes, "When image of node in tree, find the node"),
3612 GM(NAME_commonDevice, 1, "device", "with=graphical", getCommonDeviceGraphical,
3613 NAME_organisation, "Deepest device both are displayed on"),
3614 GM(NAME_display, 0, "display", NULL, getDisplayGraphical,
3615 NAME_organisation, "Display graphical is displayed on"),
3616 GM(NAME_monitor, 0, "monitor", NULL, getMonitorGraphical,
3617 NAME_organisation, "Monitor graphical is displayed on"),
3618 GM(NAME_application, 0, "application", NULL, getApplicationGraphical,
3619 NAME_organisation, "Application my frame belongs too"),
3620 GM(NAME_distance, 1, "int", "graphical", getDistanceGraphical,
3621 NAME_compute, "Closest distance between areas"),
3622 GM(NAME_distanceX, 1, "int", "graphical", getDistanceXGraphical,
3623 NAME_compute, "Distance between graphicals's in X-direction"),
3624 GM(NAME_distanceY, 1, "int", "graphical", getDistanceYGraphical,
3625 NAME_compute, "Distance between graphicals's in Y-direction"),
3626 GM(NAME_frame, 0, "frame", NULL, getFrameGraphical,
3627 NAME_organisation, "Frame graphical is displayed on"),
3628 GM(NAME_window, 0, "window", NULL, getWindowGraphical,
3629 NAME_organisation, "Window graphical is displayed on"),
3630 GM(NAME_boundingBox, 0, "area", NULL, getBoundingBoxGraphical,
3631 NAME_postscript, "Same as <-area; used for PostScript"),
3632 GM(NAME_postscript, 2, "string", T_postscript, getPostscriptObject,
3633 NAME_postscript, "New string holding PostScript description"),
3634 GM(NAME_connections, 4, "chain", T_connections, getConnectionsGraphical,
3635 NAME_relation, "New chain with matching connections"),
3636 GM(NAME_connected, 4, "connection", T_link, getConnectedGraphical,
3637 NAME_relation, "Find specified connection"),
3638 GM(NAME_handle, 1, "handle", "name", getHandleGraphical,
3639 NAME_relation, "Find handle with given name"),
3640 GM(NAME_handlePosition, 2, "point", T_handlePosition, getHandlePositionGraphical,
3641 NAME_relation, "New point with position of handle"),
3642 GM(NAME_handles, 3, "chain", T_handles, getHandlesGraphical,
3643 NAME_relation, "New chain with matching handles"),
3644 GM(NAME_network, 3, "chain", T_network, getNetworkGraphical,
3645 NAME_relation, "New chain with connected graphicals"),
3646 GM(NAME_isDisplayed, 1, "bool", "[device]", getIsDisplayedGraphical,
3647 NAME_visibility, "@on if graphical is visible on device"),
3648 GM(NAME_solid, 0, "bool", NULL, getSolidGraphical,
3649 NAME_draw, "a ->_redraw_area touched all pixels")
3650 };
3651
3652 /* Resources */
3653
3654 static classvardecl rc_graphical[] =
3655 { RC(NAME_colour, "[colour|pixmap]", "@default",
3656 "Default colour for this object"),
3657 RC(NAME_pen, "0..", "1", NULL),
3658 RC(NAME_texture, NULL, "none", NULL),
3659 RC(NAME_inactiveColour, "colour|pixmap*",
3660 "when(@colour_display, colour(grey60), @grey50_image)",
3661 "Colour when <-active == @off"),
3662 RC(NAME_selectedForeground, "colour*",
3663 UXWIN("white", "win_highlighttext"),
3664 "Colour when <-selected == @on"),
3665 RC(NAME_selectedBackground, "colour*",
3666 UXWIN("black", "win_highlight"),
3667 "Background when <-selected == @on"),
3668 RC(NAME_selectionHandles, "{corners,sides,corners_and_sides,line}*",
3669 "corners_and_sides",
3670 "Visual feedback of <->selected"),
3671 RC(NAME_visualBell, "bool", "@on",
3672 "@on: flash; @off: ring bell on ->alert"),
3673 RC(NAME_visualBellDuration, "int", "100",
3674 "Length of flash in milliseconds"),
3675 RC(NAME_eventTolerance, "0..", "5",
3676 "Minimum size of event-area")
3677 };
3678
3679 /* Class Declaration */
3680
3681 static Name graphical_termnames[] = { NAME_x, NAME_y, NAME_width, NAME_height };
3682
3683 ClassDecl(graphical_decls,
3684 var_graphical, send_graphical, get_graphical, rc_graphical,
3685 4, graphical_termnames,
3686 "$Rev$");
3687
3688 status
makeClassGraphical(Class class)3689 makeClassGraphical(Class class)
3690 { declareClass(class, &graphical_decls);
3691
3692 saveStyleVariableClass(class, NAME_device, NAME_nil);
3693 cloneStyleVariableClass(class, NAME_device, NAME_nil);
3694 setRedrawFunctionClass(class, RedrawAreaGraphical);
3695 delegateClass(class, NAME_layoutInterface);
3696
3697 ChangedWindows = globalObject(NAME_changedWindows, ClassChain, EAV);
3698
3699 succeed;
3700 }
3701
3702