/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: jan@swi.psy.uva.nl WWW: http://www.swi.psy.uva.nl/projects/xpce/ Copyright (c) 1985-2002, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(draw_shapes, []). :- use_module(library(pce)). :- use_module(library(pce_template)). :- require([ default/3 , forall/2 , get_config/2 , ignore/1 , member/2 ]). :- multifile user:pce_pre_expansion_hook/2. :- dynamic user:pce_pre_expansion_hook/2. user:pce_pre_expansion_hook((:- draw_begin_shape(Name, Super, Summary, Recognisers)), [(:- pce_begin_class(draw_shape_class:Name, Super, Summary)), (:- use_class_template(draw_shape)), (:- pce_class_directive(draw_shapes:associate_recognisers(Recognisers))) ]). user:pce_pre_expansion_hook((:- draw_end_shape), (:- pce_end_class)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module defines the various shapes that can be used to construct the diagram. Most of the shapes are very close the PCE's drawing primitives. Two things have to be added for each of them: handles for connecting lines (connections) and event-handling. Programming can be done both at the class and at the instance level. I decided to add them at the class level. As there are normally multiple instances of the classe, this approach reduces memory cost. A more important issue is kloning and saving. These operations work recursively and therefore would clone and save the object-level extensions. For saving, this has two disadvantages. The saved files would get bigger and, more important, the gestures -defining the UI of the tool- would be saved too. This leads to a bad separation of UI and the actual data manipulated. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /******************************** * COMMON TEMPLATE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - To facilate users to refine PceDraw for their own needs, we designed a very simple schema for defining new shapes. A PceDraw shape is a subclass of a PCE graphical or of another PceDraw shape. Such classes are defined between the braces: :- draw_begin_shape(Name, Super, Summary, Recognisers). ... :- draw_end_shape. The public predicate draw_begin_shape/4 creates a new XPCE class `Name' below `Super'. The class object itself is an instance of class draw_shape_class, rather then of the normal XPCE class class. The reason for this is to allow for certain definitions to be raised to the meta-class level. We extend the meta-knowledge represented in classes with `hidden' attributes (attributes that *can*, but *are not* edited by the attribute editor (see `draw_shape ->has_attribute') and recognisers. NOTE: I consider allowing for class-level recognisers anyway, avoiding the need for explicit event-handling methods in many cases. First the definition of the meta-class draw_shape_class: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_shape_class, class, "Handle class-level stuff"). variable(hidden_attributes, chain, get, "Masked attributes"). variable(recognisers, chain, get, "Event-handling recognisers"). variable(part_attributes, sheet*, get, "Compound attribute dispatching"). initialise(Class, Name, Super) :-> send(Class, send_super, initialise, Name, Super), ( get(Class, super_class, SuperClass), send(SuperClass, instance_of, draw_shape_class) -> send(Class, slot, hidden_attributes, SuperClass?hidden_attributes?copy), send(Class, slot, recognisers, SuperClass?recognisers?copy), send(Class, slot, part_attributes, SuperClass?part_attributes?clone) ; send(Class, slot, hidden_attributes, new(chain)), send(Class, slot, recognisers, new(chain)) ). :- pce_group(attribute). hidden_attribute(Class, Attr:name) :-> "Register a hidden attribute":: get(Class, hidden_attributes, Hidden), send(Hidden, add, Attr). part_attribute(Class, Attribute:name, Part:name) :-> "Attribute must be manipulated on part":: get(Class, part_attributes, A0), ( A0 == @nil -> send(Class, slot, part_attributes, new(Mapping, sheet)) ; Mapping = A0 ), send(Mapping, value, Attribute, Part). :- pce_group(handle). delete_all_handles(Class) :-> "Delete all registered handles":: ( get(Class, handles, Chain), Chain \== @nil -> send(Chain, clear) ; true ). :- pce_group(event). recogniser(Class, Recogniser:recogniser) :-> "Register (prepend) a recogniser":: get(Class, recognisers, Recognisers), send(Recognisers, add, Recogniser). :- pce_end_class. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - EXPANSION The following fragment defines compiler expansion for: :- draw_begin_shape ... :- draw_end_shape. :- draw_begin_shape should create an instance of call draw_shape_class rarther then class class. This is achieved using the construct :- pce_begin_class(MetaClass:Class(...), ...) Which tells pce_realise_class/1 that it should create the new class using the call new(_, MetaClass(Class, Super)) rather then the default get(Super, sub_class, Class, _) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ associate_recognisers(Recognisers) :- forall(member(R, Recognisers), send(@class, recogniser, R)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - All shape classes need to implement a protocol to the draw_canvas class (and through there to the attribute editor). To do this, draw_begin_shape/4 will include the `class template' draw_shape in each direct subclass of a non-PceDraw class. Including a class template implies that all methods defined on the template class below class `template' (an empty class below class object) will be included into the current class. Neither the implementation, nor the method/variable object itself is copied: their references are simply included in the `class <-send_methods', `class <-get_methods' or `class <-instance_variables', depending on the object included. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_shape, template, "Common methods for PceDraw objects"). geometry(Gr, X:[int], Y:[int], W:[int], H:[int]) :-> "Like super-method, but activate ->modified":: ( get(Gr, window, Window) -> send(Window, open_undo_group), get(Gr, area, area(OX, OY, OW, OH)), Msg =.. [message, Gr, do_set, OX, OY, OW, OH], send(Window, undo_action, Msg), send(Gr, send_super, geometry, X, Y, W, H), send(Window, close_undo_group) ; send(Gr, send_super, geometry, X, Y, W, H) ), send(Gr, modified). cut(Gr) :-> "Remove graphical from the drawing":: ( get(Gr, attribute, cutting, _) % avoid recursion -> true ; send(Gr, attribute, cutting), get(Gr, window, Window), send(Window, open_undo_group), get(Gr, device, OldDev), send(Gr, device, @nil), send(Window, undo_action, message(Gr, un_cut, OldDev)), send(Window, close_undo_group), send(Gr, delete_attribute, cutting) ). un_cut(Gr, Dev:device*) :-> "Redisplay a cutted graphical":: send(Gr, device, Dev), get(Gr, window, Window), send(Window, open_undo_group), send(Window, undo_action, message(Gr, cut)), send(Window, close_undo_group). :- pce_group(attribute). draw_attribute(Gr, Att, Val) :-> "Modify an attribute if ->has_attribute":: send(Gr, has_attribute, Att), get(Gr, draw_attribute, Att, OldVal), send(OldVal, lock_object, @on), ( catch(send(OldVal, equal, Val), _, fail) -> true ; get(Gr, window, Window), send(Window, open_undo_group), send(Gr, Att, Val), send(Window, undo_action, message(Gr, draw_attribute, Att, OldVal)), send(Window, close_undo_group) ), send(Gr, modified). draw_attribute(Gr, Att, Val) :<- "Just completeness":: get(Gr, Att, Val). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->has_attribute is used by the attribute editor to find the attributes that can be manipulated on the currently selected object. A name is defined an attribute if it can both be modified and requested (i.e. there is send- and get-behaviour for the name). The class (an instance of draw_shape_class), defines a chain of attributes that are explicitely masked. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ has_attribute(Gr, Att:name) :-> "Test if object defines attribute":: send(Gr, has_send_method, Att), send(Gr, has_get_method, Att), \+ send(Gr, hidden_attribute, Att). hidden_attribute(Gr, Att:name) :-> "True if attibute is not editable":: get(Gr, class, Class), get(Class, hidden_attributes, Hidden), send(Hidden, member, Att). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - If an object is ->modified, the modified flag of the drawing should be updated and the attribute editor should be notified. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_group(modified). modified(Gr) :-> "Inform <-window and update attribute editor":: ( get(Gr, window, Window), send(Window, modified), get(Gr, selected, @on), send(Window, update_attribute_editor) -> true ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->event just walks through the recognisers defined on the class. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_group(event). event(Gr, Ev:event) :-> "Handle <-class recognisers":: ( send(Gr, send_super, event, Ev) ; get(Gr?class, recognisers, Chain), get(Chain, find, message(@arg1, event, Ev), _) ). :- pce_group(mode). mode(Gr, Mode:name) :<- "Request <-window's <-mode":: get(Gr, window, Window), get(Window, mode, Mode). :- pce_group(edit). undo_restack_action(Gr) :-> "Register restack-undo action":: ( get(Gr, window, Canvas) -> send(Canvas, open_undo_group), get(Gr?device, graphicals, Grs), ( get(Grs, next, Gr, Next) -> send(Canvas, undo_action, message(Gr, hide, Next)) ; send(Canvas, undo_action, message(Gr, expose)) ), send(Canvas, close_undo_group) ; true ). hide(Gr, Behind:[graphical]) :-> send(Gr, undo_restack_action), send(Gr, send_super, hide, Behind). expose(Gr, Before:[graphical]) :-> send(Gr, undo_restack_action), send(Gr, send_super, expose, Before). restack(Gr, How:'{hide,expose}|int') :-> "Hide one step or to background":: ( integer(How) -> get(Gr?device, graphicals, Grs), get(Grs, index, Gr, Idx), I is Idx + How, ( get(Grs, nth1, I, Before) -> ( How < 0 -> send(Gr, hide, Before) ; send(Gr, expose, Before) ) ) ; send(Gr, How) % hide, expose ). :- pce_end_class. /******************************** * BOX * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Box is the most prototypical example of a graphical. Boxes in PceDraw have handles for connections in the middle of each side. Event handling is realised by the reusable object @draw_resizable_shape_recogniser. The handle/4 construct attaches a handle with specified <->kind and <->name at the specified position. The handle is attached to the class (see `class ->handle') rather than to the instances (see `graphical ->handle'). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- draw_begin_shape(draw_box, box, "PceDraw editable box", [@draw_resizable_shape_recogniser]). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). :- draw_end_shape. /******************************** * ELLIPSE * ********************************/ :- draw_begin_shape(draw_ellipse, ellipse, "PceDraw editable ellipse", [@draw_resizable_shape_recogniser]). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). :- draw_end_shape. /******************************* * METAFILE * *******************************/ :- draw_begin_shape(draw_metafile, win_metafile, "PceDraw Windows Metafile", [@draw_resizable_shape_recogniser]). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). :- draw_end_shape. /******************************** * TEXT * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - In draw_text, we'd like to write ->event, but this has already been defined in the template. XPCE does not support this. Therefore we first define draw_text1, which will include the template, and then draw_text as a subclass thereof in which we redefine the ->event method. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- draw_begin_shape(draw_text1, text, "PceDraw editable text (support)", []). :- draw_end_shape. :- draw_begin_shape(draw_text, draw_text1, "PceDraw editable text", []). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). initialise(T, String:[string], Format:[name], Font:[font]) :-> default(String, '', Str), default(Format, center, Fmt), ( Font == @default -> get_config(draw_config:resources/default_font, Fnt) ; Fnt = Font ), send(T, send_super, initialise, Str, Fmt, Fnt). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This method illustrates another way to define event-handling at the class level: just analyse the type of the event and perform the necessary action. For complex event-sequences gestures are to be preferred as they take care of many of the difficulties such as managing the focus, cursor and state-variables needed to parse the event sequence. For simple events all this is not necessary, so we might just as well parse them within the ->event method. NOTE: Events types will be changed shortly. Having to refer to ESC as `27' is not the right way to program. I'm not yet sure on the details. NOTE: PCE will probably provided higher-level primitives such as a special subclass of recogniser to deal with most of the details of this method. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ event(Text, Ev:event) :-> get(Ev, window, Canvas), ( send(Ev, is_a, focus) -> ignore(send(Text, send_super, event, Ev)), ( send(Ev, is_a, release_keyboard_focus) -> ( get(Text?string, size, 0), send(Text?device, instance_of, draw_canvas) % HACK -> send(Text, cut) ; send(Text, show_caret, @off) ), get(Text, attribute, old_string, Old), ( send(Old, equal, Text?string) -> true ; send(Canvas, undo_action, message(Text, string, Old)) ), send(Text, delete_attribute, old_string), send(Canvas, close_undo_group) ; send(Ev, is_a, obtain_keyboard_focus) -> send(Canvas, open_undo_group), send(Text, attribute, old_string, Text?string?copy) ; true ) ; get(Text, show_caret, @on), ( get(Ev, id, Id), event(Id, Text) -> true ; send(Ev, is_a, keyboard), send(Text, typed, Ev), send(Text, modified) ) ; send(@draw_text_recogniser, event, Ev) ). event(27, Text) :- % ESC send(Text?window, keyboard_focus, @nil). event(9, Text) :- % TAB send(Text?device, advance, Text). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Indicate to the device that this graphical is willing to accept the keyboard focus. It is interpreted by the `Device ->advance' method to set the keyboard focus to the next object that wants to accept keystrokes. NOTE: This mechanism needs some redesign and documentation. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ '_wants_keyboard_focus'(_T) :-> "Indicate device I'm sensitive for typing":: true. paste(T) :-> get(T?string, copy, Old), send(T, send_super, paste), ( get(T, window, Canvas), send(Canvas, has_send_method, undo_action) -> send(Canvas, open_undo_group), send(Canvas, undo_action, message(T, string, Old)), send(Canvas, close_undo_group) ; true ). format(T, Fmt:{left,center,right}) :-> ( get(T, window, Canvas), send(Canvas, has_send_method, undo_action) -> send(Canvas, open_undo_group), get(T, format, Old), send(Canvas, undo_action, message(T, format, Old)), send(Canvas, close_undo_group) ; true ), send(T, send_super, format, Fmt). string(T, Str:char_array) :-> ( send(Str, equal, T?string) -> true ; ( get(T, window, Canvas), send(Canvas, has_send_method, undo_action) -> send(Canvas, open_undo_group), get(T?string, copy, Old), send(Canvas, undo_action, message(T, string, Old)), send(Canvas, close_undo_group) ; true ), send(T, send_super, string, Str) ). :- pce_group(menu). menu_text(T, Scale:[bool]) :-> "Prepare text for menu ('T')":: send(T, string, 'T'), ( Scale == @on -> get(T, font, Font), get(Font, family, Family), get(Font, style, Style), new(S, var(value := Font)), send(@fonts, for_all, if(and(@arg2?family == Family, @arg2?style == Style, @arg2?points < S?points, @arg2?points > 5), assign(S, @arg2, global))), send(T, font, S) ; true ). :- draw_end_shape. /******************************** * LINE * ********************************/ :- draw_begin_shape(draw_line, line, "PceDraw editable line", [@draw_line_recogniser]). handle(w/2, h/2, link, center). handle(0, 0, link, start). handle(w, h, link, end). :- draw_end_shape. /******************************** * PATH * ********************************/ :- draw_begin_shape(draw_path, path, "PceDraw editable path", [@draw_path_recogniser]). :- pce_class_directive(send(@class, hidden_attribute, radius)). interpolation(L, N:int) :-> ( N == 0 -> send(L, kind, poly) ; send(L, intervals, N), send(L, kind, smooth) ). interpolation(L, N:int) :<- ( get(L, kind, poly) -> N = 0 ; get(L, intervals, N) ). append(Path, P:point) :-> "Activate undo system":: send(Path, send_super, append, P), ( get(Path, window, Window), send(Window, has_send_method, undo_action) -> send(Window, undo_action, message(Path, delete, P)) ; true ). append_at_create(Path, P:point) :-> "->append, but do not inform undo":: send(Path, send_super, append, P). delete(Path, P:point) :-> "Activate undo system":: ( get(Path, window, Window), send(Window, has_send_method, undo_action) -> get(Path, points, Pts), ( get(Pts, previous, P, Prev) -> send(Window, undo_action, message(Path, insert, P, Prev)) ; send(Window, undo_action, message(Path, insert, P, @nil)) ) ; true ), send_super(Path, delete, P). insert(Path, P:point, After:point*) :-> send(Path, send_super, insert, P, After), ( get(Path, window, Window), send(Window, has_send_method, undo_action) -> send(Window, undo_action, message(Path, delete, P)) ; true ). set_point(Path, P:point, X:int, Y:int) :-> ( get(Path, window, Window), send(Window, has_send_method, undo_action) -> object(P, point(OX, OY)), send(Window, undo_action, message(Path, set_point, P, OX, OY)) ; true ), send(Path, send_super, set_point, P, X, Y). :- draw_end_shape. /******************************* * BEZIER CURVE * *******************************/ :- draw_begin_shape(draw_bezier, bezier_curve, "PceDraw editable Bezier curve", [@draw_bezier_recogniser]). set_point(Path, P:point, X:int, Y:int) :-> ( get(Path, window, Window), send(Window, has_send_method, undo_action) -> object(P, point(OX, OY)), send(Window, undo_action, message(Path, set_point, P, OX, OY)) ; true ), send(Path, send_super, set_point, P, X, Y). :- draw_end_shape. /******************************** * CONNECTIONS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - A connection is a line between two handles on two different graphical objects. See clas handle, graphical and connection for details. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- draw_begin_shape(draw_connection, connection, "PceDraw editable connection", [@draw_connection_recogniser]). handle(w/2, h/2, link, center). initialise(C, F:graphical, T:graphical, L:[link], HF:[name]*, HT:[name]*) :-> send(C, send_super, initialise, F, T, L, HF, HT), ( get(C, window, Window), send(Window, open_undo_group), send(Window, undo_action, message(C, cut)), send(Window, close_undo_group) ; true ). geometry(Gr, X:[int], Y:[int], W:[int], H:[int]) :-> "No logging needed":: send(Gr, send_super, geometry, X, Y, W, H). cut(Gr) :-> "Remove graphical from the drawing":: get(Gr, window, Window), send(Window, open_undo_group), get(Gr, from, From), get(Gr, to, To), send(Window, undo_action, message(Gr, un_cut, From, To)), send(Gr, relate, @nil, @nil), send(Window, close_undo_group). un_cut(Gr, From:graphical, To:graphical) :-> "Redisplay a cutted graphical":: send(Gr, relate, From, To), get(Gr, window, Window), send(Window, open_undo_group), send(Window, undo_action, message(Gr, cut)), send(Window, close_undo_group). start_text(_C, _Ev:[event]) :-> "Dummy method":: true. :- draw_end_shape. /******************************** * BITMAP * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Bitmaps are used to import arbitrary images into a drawing. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- draw_begin_shape(draw_bitmap, bitmap, "PceDraw editable bitmap", [@draw_bitmap_recogniser]). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). :- draw_end_shape. /******************************** * COMPOUNDS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compounds are used to realise (user-defined) prototypes that consist of more than one shape. Compound is a subclass of the PCE class `device', that manages a collection of graphicals. In addition to devices, compounds define distribution of keyboard events to one of the text objects inside it and resizing the device. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- draw_begin_shape(draw_compound, figure, "PceDraw editable device", [@draw_compound_recogniser]). handle(w/2, 0, link, north). handle(w/2, h, link, south). handle(0, h/2, link, west). handle(w, h/2, link, east). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Resizing compounds. PCE's primitives do not provide for that. However, any attempt to change to the area of the graphical via `Graphical ->set', `Graphical ->x', `Graphical ->area', etc. will invoke `Graphical ->geometry' to do the actual moving/resizing. By default, devices will move themselve, but not resize their contents. In the method below, we first resize the contents of the device in a way very similar to resizing the selection as described in the file `gesture.pl' and than invoke the super-behaviour to realise the move. Never try to do the move yourself: the superclass might do (and in the case of device does) additional things to changing the coordinates. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ geometry(C, X:[int], Y:[int], W:[int], H:[int]) :-> "Resize compound graphical":: ( get(C, window, Window) -> send(Window, open_undo_group), get(C, area, area(OX, OY, OW, OH)), send(Window, undo_action, message(C, do_set, OX, OY, OW, OH)) ; true ), resize_factor(W, C, width, Xfactor), resize_factor(H, C, height, Yfactor), ( (Xfactor \== 1 ; Yfactor \== 1) -> get(C?area, position, Origin), send(Origin, minus, C?position), send(C?graphicals, for_all, message(@arg1, resize, Xfactor, Yfactor, Origin)), send(Origin, done) ; true ), send(C, send_super, geometry, X, Y, W, H), ( get(C, window, Window) -> send(Window, close_undo_group) ; true ), send(C, modified). resize_factor(@default, _, _, 1) :- !. resize_factor(W1, C, S, F) :- get(C, S, W0), F is W1 / W0. event(C, Ev:event) :-> "Handle <-class recognisers":: ( get(C, all_recognisers, InstanceRecognisers), get(InstanceRecognisers, find, message(@arg1, event, Ev), _) ; get(C?class, recognisers, Chain), get(Chain, find, message(@arg1, event, Ev), _) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The method below sets the string of all text objects. Used by the icon manager (menu.pl) and the create gesture (gesture.pl) to set the strings to `T', resp '' (nothing). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ string(C, Str:string) :-> "Set string of all texts":: send(C?graphicals, for_all, if(message(@arg1, has_send_method, string), message(@arg1, string, Str))). menu_text(C) :-> "Set all <-graphicals to `T'":: send(C?graphicals, for_all, if(message(@arg1, has_send_method, menu_text), message(@arg1, menu_text, @on))). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The method below is called from the compound_recogniser on a ms_left_down if the editor is in text_edit mode. If the down is in the area of a text, the caret is positioned as close as possible to the location of the down. Otherwise it is placed on the first text object of the compound. First all text objects are found. Next, it tries to find the first text that overlaps with the position of the down-event. If this succeeds, the caret is placed as close as possible to the down location. Otherwise the caret is located at the end of the first text object of the compound. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ start_text(C, Ev:[event]) :-> "Enter typing mode":: get(C?graphicals, find_all, message(@arg1, instance_of, text), Texts), ( Ev \== @default, get(Texts, find, message(Ev, inside, @arg1), Pointed) -> send(C?window, keyboard_focus, Pointed), get(Pointed, pointed, ?(Ev, position, Pointed), Caret), send(Pointed, caret, Caret) ; get(Texts, head, First) -> send(First, caret, @default), send(C?window, keyboard_focus, First) ; true % Thanks, Lourens van der Meij ), send(Texts, done). '_wants_keyboard_focus'(C) :-> "Test if I contain editable components":: get(C?graphicals, find, message(@arg1, '_wants_keyboard_focus'), _). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The code below illustrates another reason for not communicating the attribute setting using ->x, ->pen, etc. For a compound, the x, y, width and height attributes should hold for the compound as a whole, while the other attributes should only hold for the parts. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_group(attribute). geometry_selector(x). geometry_selector(y). geometry_selector(width). geometry_selector(height). :- pce_global(@is_draw_shape, new(message(@arg1?class, instance_of, draw_shape_class))). has_attribute(C, Att:name) :-> "Test if object has attribute":: \+ send(C, hidden_attribute, Att), ( geometry_selector(Att) -> true ; get(C?graphicals, find, if(@is_draw_shape, message(@arg1, has_attribute, Att), and(message(@arg1, has_send_method, Att), message(@arg1, has_get_method, Att))), _) ). draw_attribute(C, Att:name, Val:any) :-> ( geometry_selector(Att) -> send(C, Att, Val) ; get(C?class, part_attributes, Sheet), Sheet \== @nil, get(Sheet, value, Att, PartName) -> get(C, member, PartName, Part), ( send(Part, has_send_method, draw_attribute) -> send(Part, draw_attribute, Att, Val) ; send(Part, Att, Val) ) ; send(C?graphicals, for_some, if(@is_draw_shape, message(@arg1, draw_attribute, Att, Val), and(message(@arg1, has_send_method, Att), message(@arg1, Att, Val), message(C, modified)))) ). draw_attribute(C, Att:name, Val) :<- ( geometry_selector(Att) -> get(C, Att, Val) ; get(C?class, part_attributes, Sheet), Sheet \== @nil, get(Sheet, value, Att, PartName) -> get(C, member, PartName, Part), ( send(Part, has_get_method, draw_attribute) -> get(Part, draw_attribute, Att, Val) ; get(Part, Att, Val) ) ; get(C?graphicals, find, if(@is_draw_shape, message(@arg1, has_attribute, Att), and(message(@arg1, has_send_method, Att), message(@arg1, has_get_method, Att))), Shape), get(Shape, Att, Val) ). :- draw_end_shape.