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:- module(draw_attribute, []).
36:- use_module(library(pce)).
37:- require([ between/3
38           , chain_list/2
39           , default/3
40           , forall/2
41           , get_config/2
42           , get_object/4
43           , listen/3
44           , member/2
45           , send_list/3
46           , set_config/2
47           , unlisten/1
48           ]).
49
50:- pce_autoload(font_item, library(pce_font_item)).
51
52/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
53This module defines a  separate frame that allows the  user to set the
54values of attributes (pen, font, etc.) of  shapes in the drawing.  The
55frame contains a single dialog window, which contains dialog_items for
56each of the (graphical shape) attributes that can be edited.
57
58Regardless of the shape(s) for  which we  are editing attributes,  all
59dialog items are  always  displayed.  Items that represent  attributes
60not present in the  shapes edited are  greyed out to indicate such  to
61the user.  As the contents  of the window  changes  each time the user
62changes the selection, non-used items are not removed from the dialog.
63This would change too much  to the dialog,  transforming the interface
64into a ``video clip''.
65- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
66
67:- pce_begin_class(draw_attribute_editor, frame).
68
69variable(editor,        object,         get,
70         "Editor I'm attached too").
71variable(client,        chain*,         get,
72         "Objects I'm editing the attributes for").
73variable(blocked,       int := 0,       get,
74         "Blocked count to avoid quadratic behaviour").
75
76%       attributes(?Label, ?Selector)
77%
78%       Label is the label of the menu is the dialog.  Selector is the
79%       name of the method to be activated to change the value.   Used
80%       both ways around and only local to  this file, Prolog is a far
81%       easier way to store this  table.  The  alternative would be to
82%       create  a  sheet and  attach  it to the   class.   This  needs
83%       extensions to the preprocessor.
84
85attribute(pen,          pen).
86attribute(dash,         texture).
87attribute(arrow_1,      first_arrow).
88attribute(arrow_2,      second_arrow).
89%attribute(arrows,      arrows).
90attribute(fill,         fill_pattern).
91attribute(colour,       colour).
92attribute(font,         font).
93attribute(transparent,  transparent).
94attribute(radius,       radius).
95attribute(x,            x).
96attribute(y,            y).
97attribute(w,            width).
98attribute(h,            height).
99attribute(closed,       closed).
100attribute(interpolation,interpolation).
101attribute(shadow,       shadow).
102
103
104/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
105Create the attribute  window.  Like  the drawing-tool as a whole,  the
106window is a subclass of the PCE class `frame' for simple communication
107with its various parts.  Note the use of default/3.
108
109`Frame <->done_message' is activated when the   frame is deleted on user
110request using the normal mechanism provided by the window system.
111- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
112
113initialise(A, Draw:object, Label:[name]) :->
114    default(Label, 'Attributes', Lbl),
115    send(A, send_super, initialise, Lbl),
116    send(A, done_message, message(A, quit)),
117    send(A, append, new(dialog)),
118    send(A, slot, editor, Draw),
119    send(A, fill_dialog),
120    listen(A,
121           set_config(draw_config:resources/_, _),
122           send(A, config_changed)).
123
124
125config_changed(A) :->
126    get(A, member, dialog, D),
127    send(D, clear),
128    send(D, fill_dialog),
129    send(D, layout),
130    send(D, fit),
131    (   get(A, client, Client), Client \== @nil
132    ->  send(A, client, Client)
133    ;   true
134    ).
135
136
137open(A, Pos:[point]) :->
138    "Open at position from config database"::
139    (   Pos == @default,
140        get(A, editor, Draw), Draw \== @nil,
141        get_config(draw_config:history/geometry/attributes, Diff)
142    ->  get(Draw?area, position, Pos1),
143        send(Pos1, plus, Diff)
144    ;   Pos1 = Pos
145    ),
146    send(A, send_super, open, Pos1, normalise := @on).
147
148
149unlink(A) :->
150    "Save position in config database"::
151    (   get(A, editor, Draw), Draw \== @nil,
152        get(Draw?area, position, PDraw),
153        get(A?area, position, PA),
154        get_object(PA, difference, PDraw, Diff),
155        set_config(draw_config:history/geometry/attributes, Diff)
156    ->  true
157    ;   true
158    ),
159    unlisten(A),
160    send(A, send_super, unlink).
161
162
163/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
164Fill the dialog with the various menus.  We defined some generic Prolog
165predicates to create the various menu's.
166- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
167
168fill_dialog(A) :->
169    get(A, member, dialog, D),
170    get(A, editor, Canvas),
171    get(Canvas, frame, Draw),
172
173    make_line_menu(Pen,     pen,     [0,1,2,3,4,5]),
174    make_line_menu(Texture, texture, [none, dotted, dashed, dashdot]),
175    make_arrow_menu(Arrows1, Draw, first_arrow),
176    make_arrow_menu(Arrows2, Draw, second_arrow),
177    make_fill_pattern_menu(Draw, FillPattern),
178    make_colour_menu(Draw, Colour),
179    make_font_menu(Font),
180    make_transparent_menu(Transparent),
181    make_coordinate_menu(X, x),
182    make_coordinate_menu(Y, y),
183    make_coordinate_menu(W, width),
184    make_coordinate_menu(H, height),
185    make_radius_menu(Radius),
186    make_closed_menu(Closed),
187    make_shadow_menu(Shadow),
188    make_interpolation_menu(Interpolation),
189
190    send_list([Interpolation, Shadow], alignment, right),
191    send_list([Y, W, H], alignment, left),
192
193    send_list(D, append, [Pen, Texture]),
194    send(D, append, Arrows1),
195    (   get(Arrows1, width, WArrows1),
196        WArrows1 > 200
197    ->  send(D, append, Arrows2)
198    ;   send(Arrows2, alignment, left),
199        send(D, append, Arrows2, right)
200    ),
201    send_list(D, append, [FillPattern, Colour, Radius]),
202    send(D, append, Shadow, right),
203    send(D, append, Closed),
204    send(D, append, Interpolation, right),
205    send(D, append, Font),
206    send(Transparent, alignment, left),
207    send(D, append, Transparent, right),
208    send(D, append, X),
209    send(D, append, Y, right),
210    send(D, append, W, right),
211    send(D, append, H, right),
212
213    send(D, append, button(quit, message(A, quit))).
214
215
216                /********************************
217                *             MENU'S            *
218                ********************************/
219
220/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221To create the menu's, we defined a predicate  make_proto_menu/4.  Each
222menu_item has as value the attribute value and as  label an image with
223the prototype with the corresponding value  set.  Using this approach,
224the user can easily  see what a specific   attribute means.  When  the
225user selects a menu-item, the menu will send the value itself.
226- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
227
228make_line_menu(Menu, Attribute, Values) :-
229    new(Proto, line(2, 8, 28, 8)),
230    make_proto_menu(Menu, Proto, Attribute, Values),
231    send(Proto, done).
232
233
234make_arrow_menu(Menu, _Draw, Attribute) :-
235    get_config(draw_config:resources/arrows, ArrowsChain),
236    chain_list(ArrowsChain, Arrows),
237    make_line_menu(Menu, Attribute, [@nil|Arrows]),
238    send(Menu, attribute, equal_predicates,
239         chain(equal_arrows, close_arrows)).
240
241equal_arrows(X, X) :- !.
242equal_arrows(A1, A2) :-
243    send(A1, instance_of, arrow),
244    send(A2, instance_of, arrow),
245    equal_attributes([ class_name,
246                       length, wing,
247                       pen, texture, style,
248                       fill_pattern, colour
249                     ],
250                     A1, A2).
251
252close_arrows(X, X) :- !.
253close_arrows(A1, A2) :-
254    send(A1, instance_of, arrow),
255    send(A2, instance_of, arrow),
256    equal_attributes([ class_name,
257                       pen, texture, style,
258                       fill_pattern, colour
259                     ],
260                     A1, A2).
261
262equal_attributes([], _, _).
263equal_attributes([A|T], O1, O2) :-
264    (   send(O1, has_get_method, A)
265    ->  get(O1, A, V1),
266        get(O2, A, V2),
267        catch(send(V1, equal, V2), _, fail)
268    ;   true
269    ),
270    equal_attributes(T, O1, O2).
271
272make_fill_pattern_menu(_Draw, Menu) :-
273    get_config(draw_config:resources/fill_palette, PatternsChain),
274    chain_list(PatternsChain, Patterns0),
275    realise_patterns(Patterns0, Patterns),
276    new(Proto, box(30, 16)),
277    make_proto_menu(Menu, Proto, fill_pattern, Patterns),
278    send(Proto, done).
279
280realise_patterns([], []).
281realise_patterns([Image|T0], [Image|T]) :-
282    object(Image),
283    send(Image, instance_of, image),
284    !,
285    realise_patterns(T0, T).
286realise_patterns([Name|T0], [Image|T]) :-
287    pce_catch_error(_Error, new(Image, image(Name))),
288    !,
289    realise_patterns(T0, T).
290realise_patterns([_|T0], T) :-
291    realise_patterns(T0, T).
292
293
294/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
295The colour menu.  When the display  is not a colour  display, the only
296possible colours of an object are @default (implying the colour of the
297device),  `white' and `black'.   On colour displays  we will show some
298more  possibilities.  For  a somewhat  larger  set of choices, a cycle
299menu may be more appropriate.
300
301\index{colour}
302Currently  the only  way  to  find   out  whether you are   using    a
303black-and-white or colour display is `@display  <-depth'.  This is the
304number of bits the screen uses to represent a single pixel.
305
306Note   that  the colour  palette   is  constructed  from   a  box with
307@black_image    fill pattern.   The problem  here     is  the name  of
308@black_image.  It does  not represent  the  colour black, but only  an
309image with all pixels set to 1.
310- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
311
312colour_display :-
313    \+ get(@display, depth, 1).
314
315colour(_Draw, Colour) :-
316    colour_display,
317    !,
318    get_config(draw_config:resources/colour_palette, ColoursChain),
319    chain_list(ColoursChain, Colours),
320    member(ColourName, Colours),
321    get(@pce, convert, ColourName, colour, Colour).
322colour(_, colour(white)).
323colour(_, colour(black)).
324
325make_colour_menu(Draw, Menu) :-
326    new(Proto, box(30, 16)),
327    send(Proto, fill_pattern, @black_image),
328    findall(Colour, colour(Draw, Colour), Colours),
329    make_proto_menu(Menu, Proto, colour, [@default|Colours]),
330    send(Proto, done).
331
332/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
333The menu below is for the `transparent'  attribute of text.   When @on
334(default), only the pixels of  the font are affected.   Otherwise, the
335bounding box of the text will be  cleared first.  Non-transparent text
336is often used to mark lines or display on top of filled areas.
337- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
338
339make_transparent_menu(Menu) :-
340    new(Proto, figure),
341    send(Proto, display, new(B, box(30,16))),
342    send(B, fill_pattern, @grey50_image),
343    send(Proto, display, new(T, text('T', left,
344                                      font(screen, roman, 10)))),
345    send(T, center, B?center),
346    send(Proto, send_method, send_method(transparent, vector(bool),
347                                         message(T, transparent, @arg1))),
348    make_proto_menu(Menu, Proto, transparent, [@on, @off]),
349    get(Menu, reference, Ref),
350    get(Ref, copy, CRef),
351    send(Menu, show_label, @off),
352    send(Menu, reference, CRef),
353    send(Proto, done).
354
355
356/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
357Create  a menu for  some prototype attribute.   Each menu_item   has a
358`menu_item <->value'  equal   to  the corresponding  element    of the
359`Values'  chain.  Each  label  is a image   with an  outline-box  and
360`Proto' with the appropriate attribute setting drawn into it.
361- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
362
363:- pce_global(@menu_proto_box, new(box(30,16))).
364
365make_proto_menu(Menu, Proto, Attribute, Values) :-
366    new(Menu, draw_proto_menu(Attribute)),
367    (   Attribute == colour
368    ->  Kind = pixmap
369    ;   Kind = bitmap
370    ),
371    (   member(Value, Values),
372            send(Proto, Attribute, Value),
373            new(I, image(@nil, 30, 16, Kind)),
374            send(I, draw_in, @menu_proto_box),
375            send(I, draw_in, Proto),
376            send(Menu, append, menu_item(Value, @default, I)),
377            fail
378    ;   true
379    ),
380    length(Values, N),
381    Cols is (N+9) // 10,
382    send(Menu, columns, Cols).
383
384
385/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
386The coordibate menu is a rather trivial  text_item.  Note the setting of
387the field-width and `dialog_item ->alignment:  left'.  The latter places
388the items just right to one  another   instead  of vertically aligned in
389columns.
390
391NOTE:   We should make a subclass to allow for entering integers only.
392        To do this properly, we should know about each keystroke in
393        the menu rather than only the return.
394- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
395
396make_coordinate_menu(Menu, Selector) :-
397    attribute(Label, Selector),
398    coordinate_range(Selector, Low, High),
399    new(Menu, int_item(Label, 0,
400                       message(@receiver?frame, client_attribute,
401                               Selector, @arg1), Low, High)),
402    send(Menu, length, 5).
403
404coordinate_range(x,      -9999, 9999).
405coordinate_range(y,      -9999, 9999).
406coordinate_range(width,  -9999, 9999).
407coordinate_range(height, -9999, 9999).
408
409/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
410The radius of a box is  the radius of  the circle sections (arcs) used
411for rounding  the corners.  As the  user propably   does  not want  to
412specify an exact   number of pixels,   a  slider-menu is used.   As  a
413disadvantage, the range has to be specified in advance, and 100 is not
414the absolute limit.  Note that by setting both the range and the width
415to 100, the slider operates 1:1.
416- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
417
418make_radius_menu(Menu) :-
419    attribute(Label, radius),
420    new(Menu, slider(Label, 0, 100, 0,
421                     message(@receiver?frame, client_attribute,
422                             radius, @arg1))),
423    send(Menu, drag, @on),
424    send(Menu, width, 100).
425
426
427make_shadow_menu(Menu) :-
428    attribute(Label, shadow),
429    new(Menu, menu(Label, cycle,
430                   message(@receiver?frame, client_attribute,
431                           shadow, @arg1))),
432    forall(between(0, 5, Shadow), send(Menu, append, Shadow)).
433
434
435make_closed_menu(Menu) :-
436    attribute(Label, closed),
437    new(Menu, menu(Label, choice,
438                   message(@receiver?frame, client_attribute,
439                           closed, @arg1))),
440    send_list(Menu, append, [@off, @on]).
441
442
443make_interpolation_menu(Menu) :-
444    attribute(Label, interpolation),
445    new(Menu, slider(Label, 0, 10, 0,
446                     message(@receiver?frame, client_attribute,
447                             interpolation, @arg1))),
448    send(Menu, width, 100).
449
450
451                /********************************
452                *             FONTS             *
453                ********************************/
454
455make_font_menu(M) :-
456    new(M, font_item(font, @default,
457                     message(@receiver?frame, client_attribute,
458                             font, @arg1))).
459
460
461                /********************************
462                *              QUIT             *
463                ********************************/
464
465/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
466For a secondary  window like  this  attribute  editor,  it might be  a
467useful idea  not to destroy the window  if the user  hits  `quit', but
468just to unmap it from the display using `Frame ->show: @off'.  In this
469case, it can  be remapped on the  display very  quickly   and when the
470window has certain status  information attached to  it,  this  will be
471maintained.   For the   case of this editor,  this  only concernes the
472coordinates of the window.
473
474To control between  actual  destruction  and   just unmapping it,   an
475optional   boolean   argument has been   attached.  This  approach has
476several advantages.  If  the caller wants to  descriminate, it can  do
477so.  For all cases where the caller does not want  to discriminate, we
478have one central place to change the default behaviour.
479- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
480
481quit(A, ShowOff:[bool]) :->
482    (   ShowOff == @on
483    ->  send(A, show, @off)
484    ;   send(A?editor, attribute_editor, @nil),
485        send(A, free)
486    ).
487
488
489                /********************************
490                *     CLIENT COMMUNICATION      *
491                ********************************/
492
493/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
494->fill_items fills and  (de)activates all  dialog items.  The argument
495is a chain of shapes (normally the <-selection of the canvas).  If one
496of the elements of the selection  has the specified attribute, it will
497be activated and the ->selection of the menu will be set accordingly.
498
499If more than one object   in the  selection  has some  attribute,  the
500->selection  of the  item  will  be the attribute  value of  the first
501object in the chain that is has the attibute.  This is a rather simple
502way of handling this case, but what else can we do?
503- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
504
505fill_items(A, Client:chain) :->
506    "Fill the dialog items from chain of shapes"::
507    get(A, member, dialog, Dialog),
508    (   attribute(Label, Selector),
509        get(Dialog, member, Label, Menu),
510        (   get(Client, find,
511                and(message(@arg1, has_send_method, has_attribute),
512                    message(@arg1, has_attribute, Selector)),
513                Proto),
514            get(Proto, draw_attribute, Selector, Value)
515        ->  send(Menu, active, @on),
516            set_selection(Menu, Value)
517        ;   send(Menu, active, @off)
518        ),
519        fail
520    ;   true
521    ).
522
523set_selection(Menu, Value) :-
524    send(Menu, instance_of, menu),
525    !,
526    (   get(Menu, member, Value, Item)
527    ->  send(Menu, selection, Item)
528    ;   get(Menu, attribute, equal_predicates, PredChain),
529        chain_list(PredChain, Preds),
530        member(Pred, Preds),
531        get(Menu?members, find,
532            message(@prolog, Pred, @arg1?value, Value),
533            Item)
534    ->  send(Menu, selection, Item)
535    ;   true
536    ).
537set_selection(Menu, Value) :-
538    send(Menu, selection, Value).
539
540
541block(A) :->
542    "<-blocked++"::
543    get(A, blocked, B0),
544    B1 is B0 + 1,
545    send(A, slot, blocked, B1).
546
547unblock(A) :->
548    "<-blocked--"::
549    get(A, blocked, B0),
550    B1 is B0 - 1,
551    send(A, slot, blocked, B1).
552
553/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
554Set the chain of shapes for which we are editing the attributes.  Note
555that if the window is not shown, we won't update the contents.
556- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
557
558client(A, Client:chain*) :->
559    "Set the graphical I'm editing"::
560    get(A, member, dialog, Dialog),
561    (   get(A, blocked, B), B == 0
562    ->  (    Client == @nil
563        ->   send(Dialog?graphicals, for_some,
564                  message(@arg1, active, @off))
565        ;    send(A, fill_items, Client)
566        )
567    ;   true
568    ),
569    send(A, slot, client, Client).
570
571
572/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
573Set the value of an attribute for the clients.  The value is set for
574each shape that accepts ->has_attribute.
575- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
576
577client_attribute(A, Selector:name, Val:any) :->
578    "Set attribute of client object"::
579    (   get(A, client, Chain),
580        Chain \== @nil,
581        get(Chain, head, Head)
582    ->  send(A, block),
583        get(Head, window, Window),
584        send(Window, open_undo_group),
585        send(A?client, for_some,
586             if(message(@arg1, has_attribute, Selector),
587                message(@arg1, draw_attribute, Selector, Val))),
588        send(Window, close_undo_group),
589        send(A, unblock)
590    ;   true
591    ).
592
593:- pce_end_class.
594
595:- pce_begin_class(draw_proto_menu, menu).
596
597initialise(Menu, Attribute:name) :->
598    attribute(Label, Attribute),
599    send(Menu, send_super, initialise,
600         Label, choice,
601         message(@receiver?frame, client_attribute, Attribute, @arg1)),
602    send(Menu, off_image, @nil),
603    send(Menu, border, 2),
604    send(Menu, layout, horizontal).
605
606:- pce_end_class.
607