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