/* 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_gesture, []). :- use_module(library(pce)). :- use_module(align). :- require([ between/3 , send_list/3 , ignore/1 ]). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module defines event handling for the shapes. Event handling for dialog_items is predefined because the UI of dialog_items is standardised. Event handling for general purpose graphicals can be specified by defining the method `Graphical ->event'. The default behaviour of ->event (defined at the level of class graphical) is to look up the `recognisers' slot of the attached interceptor (see `Object ->recogniser') and test if any of the attached interceptor is prepared to accept the event. This implies there are three ways to define event parsing for graphical objects: 1) Attach a recogniser the object. 2) Write an ->event method that parses the events. 3) Write an ->event method that forwards the event to recognisers. For PceDraw we chose the latter approach for shapes. See also the file canvas.pl. Provided the recognisers do not directly refer to the object for which they handle events as in send(B, recogniser, click_gesture(left, '', single, message(B, inverted, @on))) but, refer indirectly as in send(B, recogniser, click_gesture(left, '', single, message(@receiver, inverted, @on))) recognisers can be attached to any number of graphical objects. This file defines generic recognisers that are used by `Shape ->event'. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /******************************** * RECOGNISER OBJECTS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Below are the declarations of the various recognisers. Note that using pce_global/2, the actual creation of the recogniser is delayed to the first time an event occurs on an object that uses a specific recogniser. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Create shapes */ :- pce_global(@draw_create_resize_gesture, new(draw_create_resize_gesture)). :- pce_global(@draw_create_line_gesture, new(draw_create_line_gesture)). :- pce_global(@draw_create_bezier_gesture, new(draw_create_bezier_gesture)). :- pce_global(@draw_create_path_gesture, new(draw_create_path_gesture)). :- pce_global(@draw_connect_gesture, new(handler_group(new(draw_connect_gesture), new(draw_connect_create_gesture)))). /* Select shapes */ :- pce_global(@draw_shape_select_recogniser, make_draw_shape_select_recogniser). :- pce_global(@draw_warp_select_gesture, new(draw_warp_select_gesture)). /* Move/Resize shapes */ :- pce_global(@draw_move_outline_gesture, new(handler_group(new(draw_move_selection_gesture), draw_move_selection_gesture(left), new(draw_move_outline_gesture)))). :- pce_global(@draw_resize_gesture, new(handler_group(new(draw_resize_selection_gesture), draw_resize_selection_gesture(left), new(draw_resize_gesture)))). /* Combined shape recognisers */ :- pce_global(@draw_resizable_shape_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_resize_gesture, @draw_move_outline_gesture, @draw_connect_gesture, @draw_shape_popup_gesture))). :- pce_global(@draw_text_recogniser, new(handler_group(@draw_edit_text_recogniser, @draw_shape_select_recogniser, @draw_text_paste_recogniser, new(draw_resize_selection_gesture), draw_move_selection_gesture(left), @draw_move_outline_gesture, @draw_connect_gesture, @draw_shape_popup_gesture))). :- pce_global(@draw_compound_recogniser, new(handler_group(@draw_compound_draw_text_recogniser, @draw_resizable_shape_recogniser))). :- pce_global(@draw_connection_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_connect_gesture, @draw_shape_popup_gesture))). :- pce_global(@draw_bitmap_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_move_outline_gesture, @draw_connect_gesture, @draw_shape_popup_gesture))). :- pce_global(@draw_line_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_connect_gesture, @draw_shape_popup_gesture, new(draw_change_line_gesture), draw_change_line_gesture(left), new(draw_move_selection_gesture), draw_move_selection_gesture(left), new(draw_move_gesture)))). :- pce_global(@draw_path_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_shape_popup_gesture, new(draw_modify_path_gesture), draw_modify_path_gesture(left), @draw_edit_path_gesture, @draw_resize_gesture, @draw_move_outline_gesture, new(draw_move_gesture)))). :- pce_global(@draw_bezier_recogniser, new(handler_group(@draw_shape_select_recogniser, @draw_shape_popup_gesture, new(draw_modify_bezier_gesture), draw_modify_bezier_gesture(left), new(draw_edit_bezier_gesture), @draw_move_outline_gesture, new(draw_move_gesture)))). /******************************** * SELECT * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - When in select mode, left-click on an object makes it the selection, shift-left-click adds or deletes it to/from the selection and left-dragging indicates an area in which all objects should be selected. Clicking on an object is to be defined at the level of the object itself, where the drag version is to be defined at the level of the canvas. This is not very elegant as it implies we have to create two recognisers; one for the shapes and one for the canvas. The alternative would be one recogniser at the level of the canvas and find the object below the mouse on a click. It is difficult to say which of the two approaches is better. The recogniser for shapes is defined below. It consists of a handler_group with two click_gestures. This implementation is far simpler than defining a new class. Note the definition of the obtainers before defining the gestures themselves. This method employs reusability of object and is easier to read. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ make_draw_shape_select_recogniser(G) :- new(Shape, @event?receiver), new(Canvas, Shape?window), new(SelectMode, Canvas?(mode) == select), new(G, handler_group(click_gesture(left, '', single, message(Canvas, selection, Shape), SelectMode), click_gesture(left, s, single, message(Canvas, toggle_select, Shape), SelectMode))). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The `warp_gesture' allows the user to indicate an area by dragging a button and then selects all objects inside the indicated area. It is a rather typical example of a gesture definition. The class_variable/3 declarations define the defaults that apply: the button that activates the gesture, the modifiers required (shift, control, meta) and the cursor that indicates the gesture is active. These class variables values are handled by the super-class gesture. The variable `outline' keeps track of the box that is used to indicate the area. It can be stored here, as only one gesture can be active at a time. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_warp_select_gesture, gesture). class_variable(button, button_name, left). class_variable(modifier, modifier, ''). class_variable(cursor, cursor, hand2). variable(outline, box, get, "Outline to `warp' objects"). initialise(G, B:[button_name], M:[modifier]) :-> send(G, send_super, initialise, B, M), send(G, slot, outline, new(Box, box(0,0))), send(Box, texture, dotted). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The verify method is called to validate it is ok to start the gesture. In this context, this implies the canvas is in select mode and there are actually objects displayed. It is called after a button-down of the appropriate button with the appropriate modifier is detected. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ verify(_G, Ev:event) :-> get(Ev, receiver, Canvas), get(Canvas, mode, select), \+ send(Canvas?graphicals, empty). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - After `Gesture ->verify' succeeds `Gesture ->initiate' is called to start the gesture. It resizes the outline to size(0,0) using the `Graphical ->set' (which avoids creating a size object) and than displays it at the mouse-position. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> get(Ev, receiver, Canvas), send(G?outline, set, @default, @default, 0, 0), send(Canvas, display, G?outline, Ev?position). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - On each drag-event, this method is called. It just resizes the outline. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ drag(G, Ev:event) :-> send(G?outline, corner, Ev?position). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - On the corresponding up-event, this method is called. It removes the outline from the device and sends `draw_canvas ->selection' to the canvas with a chain of all objects inside the area. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> send(G, drag, Ev), get(G, outline, Outline), get(Ev, receiver, Canvas), send(Outline, device, @nil), get(Canvas, inside, Outline?area, ToSelect), send(ToSelect, for_all, if(not(message(@arg1?class, instance_of, draw_shape_class)), message(ToSelect, delete, @arg1))), send(Canvas, selection, ToSelect). :- pce_end_class. /******************************** * CREATE FROM PROTOTYPE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Prototypes have their own size, which implies creating a prototype is done using a simple click. It first displays a clone of `draw_canvas <-proto' at the position of the mouse. Next it sends the ->start_text message to the created prototype to allow the user filling the text-fields of the proto instance. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@draw_create_proto_recogniser, make_create_proto_recogniser). make_create_proto_recogniser(R) :- new(Canvas, @event?receiver), new(Pos, @event?position), new(R, click_gesture(left, '', single, message(@prolog, create_prototype, Canvas, Pos), Canvas?(mode) == draw_proto)). create_prototype(Canvas, Pos) :- send(Canvas, keyboard_focus, @nil), % ensure closing open text get(Canvas?proto, clone, Clone), send(Canvas, open_undo_group), send(Canvas, display, Clone), send(Clone, center, Pos), send(Canvas, clear_undo_group), ( send(Clone, has_send_method, start_text) -> send(Clone, start_text) ; true ), send(Canvas, undo_action, message(Clone, cut)), send(Canvas, auto_align, Clone, move), send(Canvas, close_undo_group). /******************************** * CREATE RESIZABLE SHAPE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create shapes that do not have a predefined size. The top-left-corner of the object will be at the mouse-down location, the bottom-right-corner at the mouse-up location. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_create_resize_gesture, gesture). class_variable(button, button_name, left). class_variable(modifier, modifier, ''). class_variable(cursor, cursor, bottom_right_corner). class_variable(minimum_size, int, 3, "Minimum width/height of the object"). variable(object, graphical*, both, "Object created"). verify(_G, Ev:event) :-> "Only active when in create_resize mode":: get(Ev?receiver, mode, draw_resize). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Display a clone of `draw_canvas <-proto' and attach it to the gesture. The latter is necessary because @event?receiver refers to the canvas. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> "Paint the prototype":: get(Ev, receiver, Canvas), get(Canvas?proto, clone, Object), get(Ev, position, point(X, Y)), send(Object, do_set, X, Y, 0, 0), send(G, object, Object), send(Canvas, open_undo_group), send(Canvas, undo_action, message(Object, cut)), send(Canvas, display, Object). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Drag is easy. The only non-standard thing it does is to disallow the width or height of the created object to become negative. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ drag(G, Ev:event) :-> "Resize the object":: get(Ev, position, Pos), get(G, object, Obj), get(Pos, x, EX), get(Pos, y, EY), get(Obj, x, OX), get(Obj, y, OY), max(EX, OX, CX), max(EY, OY, CY), send(Obj, corner, point(CX, CY)). max(A, B, M) :- A >= B, !, M = A. max(_, B, B). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Terminate checks whether the created object is too small and then deletes it. It resets the <->object variable of the gesture. The latter is necessary to avoid a dangling reference when the created object would be destroyed: this object does not know it is referenced by the gesture. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> "Delete the object if it is too small":: get(Ev, receiver, Canvas), send(G, drag, Ev), get(G, object, Obj), send(G, object, @nil), get(Obj, width, W), get(Obj, height, H), get(G, minimum_size, S), ( (abs(W) < S ; abs(H) < S) -> send(Obj, cut) ; send(Canvas, auto_align, Obj, create), send(Canvas, modified) ), send(Canvas, close_undo_group). :- pce_end_class. /******************************** * LINE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Creating a line is very similar to creating a resizable shape. Only, ->drag sets the end-point rather than the corner and ->terminate should validate the length rather than the minimum of width and height. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_create_line_gesture, draw_create_resize_gesture). class_variable(cursor, cursor, plus). verify(_G, Ev:event) :-> "Only active when in create_line_mode":: get(Ev?receiver, mode, draw_line). initiate(G, Ev:event) :-> send(G, send_super, initiate, Ev), get(G, object, Line), get(Ev, position, Pos), send(Line, start, Pos), send(Line, end, Pos). drag(G, Ev:event) :-> send(G?object, end, Ev?position). terminate(G, Ev:event) :-> send(G, drag, Ev), get(G, object, Line), send(G, object, @nil), get(Line, length, L), get(G, minimum_size, MS), get(Ev, receiver, Canvas), ( L < MS -> send(Line, cut) ; send(Canvas, auto_align, Line, create) ), send(Canvas, close_undo_group). :- pce_end_class. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The draw_change_line_gesture does to a line what the resize_gesture does to an object that has a real area: one can drag one of the end-points. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_change_line_gesture, gesture). class_variable(button, button_name, middle). class_variable(cursor, cursor, plus). variable(side, name*, both, "Start or end"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Verify tries to find the end-point and records the result in the variable <->side. It fails if the event is too far away from either end of the line. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ verify(G, Ev:event) :-> get(Ev, receiver, Line), ( get(G, button, left) -> get(Line, selected, @on) ; true ), get(Ev, position, Line?device, Pos), ( get(Line?start, distance, Pos, D), D < 5 -> send(G, side, start) ; get(Line?end, distance, Pos, D), D < 5 -> send(G, side, end) ; fail ). initiate(G, Ev:event) :-> get(Ev, receiver, Line), get(Ev, window, Canvas), send(Line?device, pointer, Line?(G?side)), send(Canvas, open_undo_group). drag(G, Ev:event) :-> get(Ev, receiver, Line), get(G, side, Side), send(Line, Side, ?(Ev, position, Line?device)). terminate(_, Ev:event) :-> get(Ev, receiver, Line), send(Line?window, auto_align, Line, resize), get(Ev, window, Canvas), send(Canvas, close_undo_group). :- pce_end_class. /******************************** * BEZIER CURVE * ********************************/ :- pce_begin_class(draw_create_bezier_gesture, draw_create_resize_gesture). class_variable(cursor, cursor, plus). verify(_G, Ev:event) :-> "Only active when in create_line_mode":: get(Ev?receiver, mode, draw_bezier). initiate(G, Ev:event) :-> send(G, send_super, initiate, Ev), get(G, object, Bezier), get(Ev, position, Pos), send(Bezier, start, Pos), send(Bezier, end, Pos), send(Bezier, control1, Pos), send(Bezier, selected, @on). drag(G, Ev:event) :-> get(G, object, Bezier), send(Bezier, end, Ev?position), get(Bezier, start, point(SX, SY)), get(Bezier, end, point(EX, EY)), MX is (SX+EX)//2, MY is (SY+EY)//2, CX is MX + (EY-SY)//2, CY is MY - (EX-SX)//2, send(Bezier, control1, point(CX, CY)). terminate(G, Ev:event) :-> send(G, drag, Ev), get(G, object, Bezier), send(G, object, @nil), get(Bezier, start, point(SX, SY)), get(Bezier, end, point(EX, EY)), L is sqrt((EX-SX)**2 + (EY-SY)**2), get(G, minimum_size, MS), get(Ev, receiver, Canvas), ( L < MS -> send(Bezier, cut) ; true /*send(Canvas, auto_align, Bezier, create)*/ ), send(Canvas, close_undo_group). :- pce_end_class. :- pce_begin_class(draw_modify_bezier_gesture, gesture). class_variable(cursor, cursor, plus). class_variable(button, button_name, middle). variable(point, point*, both, "Point to move"). verify(G, Ev:event) :-> "Start if event is close to point":: get(Ev, receiver, Bezier), ( get(G, button, left) -> get(Bezier, selected, @on) ; true ), get(Bezier, point, Ev, Point), send(G, point, Point). initiate(G, Ev:event) :-> "Move pointer to point":: get(Ev, window, Canvas), send(Canvas, open_undo_group), get(Ev, receiver, Bezier), get(G, point, Point), send(Bezier?device, pointer, Point). drag(G, Ev:event) :-> "Move point to pointer":: get(Ev, receiver, Bezier), get(Bezier, device, Dev), get(Ev, position, Dev, Pos), send(Bezier, set_point, G?point, Pos?x, Pos?y). terminate(G, Ev:event) :-> send(G, drag, Ev), get(Ev, window, Canvas), send(Canvas, close_undo_group). :- pce_end_class. :- pce_begin_class(draw_edit_bezier_gesture, click_gesture, "Add/delete control point"). initialise(G) :-> send_super(G, initialise, left, c, single, message(G, execute, @event)). execute(G, Ev:event) :-> get(Ev, receiver, Bezier), ( get(Bezier, point, Ev, 5, Point) % trying to delete -> ( get(Bezier, control2, Point) -> send(Bezier, control2, @nil) ; get(Bezier, control1, Point), get(Bezier, control2, C2), C2 \== @nil -> send(Bezier, control1, C2), send(Bezier, control2, @nil) ; send(G, report, warning, 'Can only delete control-point of cubic Bezier curve') ) ; get(Ev, position, Bezier?device, Pos), get(Bezier?start, mid, Bezier?control1, M1), get(Bezier?end, mid, Bezier?control1, M2), get(M1, distance, Pos, D1), get(M2, distance, Pos, D2), ( D1 < D2 -> get(Bezier, control1, C1), send(Bezier, control2, C1), send(Bezier, control1, Pos) ; send(Bezier, control2, Pos) ) ). :-pce_end_class. /******************************** * PATH * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Class `draw_create_path_gesture' is the most complicated of PceDraw's gestures because it does not yet fit very well with the concept of `gesture' that describes event-handling from a button-down upto the corresponding button-up. A path is created by clicking on each subsequent control-point. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_create_path_gesture, gesture). class_variable(cursor, cursor, cross). class_variable(button, button_name, left). variable(path, path*, both, "Currently painted path"). variable(line, line, get, "Line segment for last"). initialise(G, Button:[button_name]) :-> send(G, send_super, initialise, Button), send(G, slot, line, new(Line, line)), send(Line, texture, dotted). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The ->event method is redefined for two purposes: 1) when a path is beeing created a dotted line is displayed from the last control-point to the current mouse location (achieved by trapping the `loc_move' events) and 2) when the user presses ESC or another mouse-button, the path is terminated. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ event(G, Ev:event) :-> "Process an event":: get(Ev?receiver, mode, draw_path), ( send(G, send_super, event, Ev) -> true ; get(G, path, Path), Path \== @nil, ( send(Ev, is_a, loc_move) -> send(G, move, Ev) ; ( send(Ev, is_a, 27) ; send(Ev, is_a, button) ) -> send(Ev?window, focus, @nil), ( send(Ev, has_modifier, c) % control-something: close -> send(G?path, closed, @on) ; true ), send(G, terminate_path) ) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->Initiate is called on each button-down. If there is no current path it is a `real' initiate. If there is already a current path this method just succeeds. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> "Paint the prototype":: get(G, path, CurrentPath), ( CurrentPath == @nil -> get(Ev, receiver, Canvas), get(Ev, position, Canvas, Pos), get(Canvas?proto, clone, Path), send(Path, clear), send(G, path, Path), get(G, line, Line), send(Line, start, Pos), send(Line, end, Pos), send(Canvas, display, Line), send(Canvas, open_undo_group), send(Canvas, display, Path), send(Canvas, undo_action, message(Path, cut)) ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The method ->move is called from ->event when there is a current path and the mouse is moved. It replaces the ->drag method called in normal gestures when the mouse is moved with a button pressed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ move(G, Ev:event) :-> get(G, line, Line), get(Ev, position, Pos), send(Line, end, Pos). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Terminate implies a button-up. This method appends the current location to the path; moves the start of the feedback line to the end of the path and invokes `window ->focus'. The 3-th argument of this method is the button that caused the event-focus to be grabbed. A button-up event related to this button will release the focus. By setting this button to @nil, the focus will not be released. See also ->event. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> send(G, move, Ev), ( get(G, path, Path), Path \== @nil -> get(G?line, end, point(X0, Y0)), ( get(Path?window, auto_align_mode, @on) -> align_path_point(Path, point(X0,Y0), point(X,Y)) ; X=X0, Y=Y0 ), send(Path, append_at_create, point(X, Y)), send(G?line, start, point(X, Y)), send(Ev?window, focus, Ev?receiver, G, G?cursor, @nil) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Terminate the path. Remove the feedback-line; set the current path to @nil and finally remove the path if it consists of only 1 point (similar removing text objects without characters; graphicals smallers than a defined minimal size; etc.). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate_path(G) :-> get(G, path, Path), get(Path, window, Canvas), send(G?line, device, @nil), send(G, path, @nil), ( get(Path?points, size, Size), Size =< 1 -> send(Path, cut) ; true ), send(Canvas, close_undo_group). cancel(G) :-> send(G, terminate_path). :- pce_end_class. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The `draw_modify_path_gesture' allows the user to drag control-points with the middle-mouse button. The method `path <-point' is used to find the control-point. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_modify_path_gesture, gesture). class_variable(cursor, cursor, plus). class_variable(button, button_name, middle). variable(point, point*, both, "Point to move"). verify(G, Ev:event) :-> "Start if event is close to point":: get(Ev, receiver, Path), \+ ( send(Path, has_get_method, editable), get(Path, editable, @off) ), ( get(G, button, left) -> get(Path, selected, @on) ; true ), get(Path, point, Ev, Point), send(G, point, Point). initiate(G, Ev:event) :-> "Move pointer to point":: get(Ev, window, Canvas), send(Canvas, open_undo_group), get(Ev, receiver, Path), get(G, point, Point), get(Path, offset, Offset), get(Point, copy, P2), send(P2, plus, Offset), send(Path?device, pointer, P2). drag(G, Ev:event) :-> "Move point to pointer":: get(Ev, receiver, Path), get(Path, device, Dev), get(Ev, position, Dev, Pos), get(Path, offset, Offset), send(Pos, minus, Offset), send(Path, set_point, G?point, Pos?x, Pos?y). terminate(G, Ev:event) :-> send(G, drag, Ev), get(Ev, window, Canvas), send(Canvas, close_undo_group). :- pce_end_class. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The two click-gestures below allow the user to insert/delete control-points by left-clicking on them with the control-key depressed. If the user clicks within 3 pixels from a control-point this point is deleted. Otherwise, if the user clicks close to a line-segment, a control-point is inserted between the two points that define the line-segment. Note that the first click_gesture defines a condition. Whether or not an event is accepted by a click_gesture does not depend on the return-status of the called message. Without a condition, the first click_gesture will accept all left-clicks with the control-key helt down. The second click_gesture would never be activated. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@draw_edit_path_gesture, make_draw_edit_path_gesture). make_draw_edit_path_gesture(G) :- new(G, handler_group), send(G, append, new(C1, click_gesture(left, c, single, message(@receiver, delete, ?(@receiver, point, @event, 3))))), new(Path, @event?receiver), new(Editable, if(message(Path, has_get_method, editable), Path?editable == @on)), send(C1, condition, and(Editable, ?(Path, point, @event, 3))), send(G, append, new(C2, click_gesture(left, c, single, message(@receiver, insert, ?(@event, position, @receiver?device), ?(@receiver, segment, @event))))), send(C2, condition, Editable). /******************************** * TEXT * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The recognisers below define the creation of a text object and start editing a text object. Note the use of keyboard_focus; if `Window <->keyboard_focus' is nonequal to @nil, all typing is tranferred to the keyboard_focus. Objects receive `obtain_keyboard_focus' and `release_keyboard_focus' events when they get or loose the keyboard focus. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@draw_create_text_recogniser, make_draw_create_text_recogniser). :- pce_global(@draw_edit_text_recogniser, make_draw_edit_text_recogniser). :- pce_global(@draw_compound_draw_text_recogniser, make_draw_compound_draw_text_recogniser). :- pce_global(@draw_text_paste_recogniser, make_draw_text_paste_recogniser). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - After `Device ->display' the new graphical is at the end of the `Device <-graphicals' chain and thus can be found using: Canvas?graphicals?tail Note that the last argument of the click_gesture is the preview action, but may also be used as a condition. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ make_draw_create_text_recogniser(R) :- new(Canvas, @event?receiver), new(Pos, @event?position), new(R, click_gesture(left, '', single, message(@prolog, create_text, Canvas, Pos), Canvas?(mode) == draw_text)). create_text(Canvas, Pos) :- send(Canvas, keyboard_focus, @nil), % close open text if there get(Canvas?proto, clone, Text), send(Text, string, ''), send(Canvas, open_undo_group), send(Canvas, display, Text, Pos), send(Canvas, keyboard_focus, Text), send(Canvas, auto_align, Text, create), send(Canvas, undo_action, message(Text, cut)), send(Canvas, close_undo_group). make_draw_edit_text_recogniser(R) :- new(Text, @event?receiver), new(Canvas, Text?window), new(Pointed, ?(Text, pointed, @event?position)), new(R, click_gesture(left, '', single, and(message(Canvas, keyboard_focus, Text), message(Text, caret, Pointed)), Text?selected == @on)). make_draw_compound_draw_text_recogniser(G) :- new(Compound, @event?receiver), new(R, click_gesture(left, '', single, message(Compound, start_text, @event), Compound?selected == @on)), new(K, handler(obtain_keyboard_focus, message(@receiver, start_text, @event))), new(G, handler_group(R, K)). make_draw_text_paste_recogniser(G) :- new(G, click_gesture(middle, '', single, message(@receiver, paste))), send(G, condition, @event?receiver?show_caret == @on). /******************************** * MOVE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The move_selection gesture is active when an object is moved that is selected and there are more objects selected. In this case all selected objects are moved by the same amount. This is indicated by showing an outline that reflects the bounding box of all objects moved. This gesture illustrates how another gesture can be encapsulated. It is a subclass of `move_gesture' to inherit the button and modifier class_variables. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_move_selection_gesture, move_gesture). variable(outline, box, get, "Box used to indicate move"). variable(selection, chain*, both, "Stored value of device selection"). variable(origin, point, get, "Start origin of selection"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The gesture maintains an outline, the selection to be moved and the positon where the move orginiated. The outline itself is given a normal move_gesture to make it move on dragging. This move_gesture should operate on the same button and modifier. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initialise(G, B:[button_name], M:[modifier]) :-> send(G, send_super, initialise, B, M), send(G, slot, outline, new(Box, box(0,0))), send(G, slot, origin, point(0,0)), send(Box, texture, dotted), send(Box, recogniser, move_gesture(G?button, G?modifier)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Verify the object is selected and there is at least one more object selected. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ verify(_G, Ev:event) :-> get(Ev, receiver, Receiver), get(Receiver, selected, @on). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initiating implies finding the device and the bounding box of all selected objects (= the `union' of their areas). Next, the outline is displayed and all events are posted to the outline. The move_gesture of the outline ensures the outline is moved by the dragging events. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> get(Ev?receiver, device, Dev), get(G, outline, Outline), send(G, selection, Dev?selection), get(G, selection, Selection), new(Union, area(0,0,0,0)), send(Selection, for_all, message(Union, union, @arg1?area)), send(G?origin, copy, Union?position), send(Outline, area, Union), send(Union, done), send(Dev, display, Outline), ignore(send(Ev, post, Outline)). drag(G, Ev) :-> send(Ev, post, G?outline). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Terminate. First undisplay the outline. Next calculate by how much the outline has been dragged and move all objects of the selection by this amount. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> ignore(send(G, drag, Ev)), get(G, outline, Outline), send(Outline, device, @nil), get(Outline?area?position, difference, G?origin, Offset), get(Ev, window, Canvas), send(Canvas, open_undo_group), get(G, selection, Selection), send(Selection, for_all, message(@arg1, relative_move, Offset)), ( get(Selection, size, 1) -> get(Selection, head, Shape), send(Shape?device, auto_align, Shape, move) ; true ), send(G, selection, @nil), send(Canvas, close_undo_group), send(Canvas, modified). :- pce_end_class. /******************************** * RESIZE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Resizing the selection is very similar to moving it. Resizing a group of object implies finding the origin of the resize (e.i. the coordinates of the corner of the resized area that does not move) and the resize factor in both X and Y-direction. Thus, the following steps are taken: 1) On initiating, display a box indicating the bounding box of the selection and start resizing this box. 2) After resizing of the bounding box is completed, compute the static origin and the resize factors. 3) Send a ->resize message to all the individual graphicals. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_resize_selection_gesture, resize_gesture). variable(outline, box, get, "Box used for feedback"). variable(selection, chain*, both, "Stored value of device selection"). variable(start, area, get, "Area before resize started"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The outline operates the same way as the outline of the selection_move handler. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initialise(G, B:[button_name], M:[modifier]) :-> send(G, send_super, initialise, B, M), send(G, slot, outline, new(Box, box(0,0))), send(G, slot, start, area(0,0,0,0)), send(Box, texture, dotted), send(G, min_size, size(3, 3)), send(Box, recogniser, resize_gesture(G?button, G?modifier)). verify(G, Ev:event) :-> get(Ev, receiver, Receiver), get(Receiver, selected, @on), send(G, send_super, verify, Ev). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compute the bounding box of the selection, display the outline and post the event to the outline. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> get(Ev?receiver, device, Dev), get(G, outline, Outline), send(G, selection, Dev?selection), get(G, selection, Selection), get(G, start, Start), send(Start, clear), send(Selection, for_all, message(Start, union, @arg1?area)), send(Outline, area, Start), send(Dev, display, Outline), ( send(Ev, post, Outline) % cancel! -> true ; send(Outline, device, @nil), send(G, selection, @nil), fail ). drag(G, Ev) :-> send(Ev, post, G?outline). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Compute the resize factors and resize the contents of the selection. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> send(G, drag, Ev), get(G, outline, Outline), send(Outline, device, @nil), get(G, start, A0), get(Outline, area, A1), x_resize(A0, A1, X0, Xfactor), y_resize(A0, A1, Y0, Yfactor), get(Ev, window, Canvas), send(Canvas, open_undo_group), get(G, selection, Selection), send(Selection, for_all, message(@arg1, resize, Xfactor, Yfactor, point(X0, Y0))), ( get(Selection, size, 1) -> get(Selection, head, Shape), send(Shape?window, auto_align, Shape, resize) ; true ), send(G, selection, @nil), send(Canvas, close_undo_group), send(Canvas, modified). x_resize(A0, A1, X0, Xfactor) :- get(A0, left_side, Left), get(A1, left_side, Left), % left-side has not changed !, X0 = Left, get(A0, width, W0), get(A1, width, W1), Xfactor is W1 / W0. x_resize(A0, A1, X0, Xfactor) :- get(A0, right_side, Right), X0 = Right, get(A0, width, W0), get(A1, width, W1), Xfactor is W1 / W0. y_resize(A0, A1, Y0, Yfactor) :- get(A0, top_side, Top), get(A1, top_side, Top), % top has not changed !, Y0 = Top, get(A0, height, H0), get(A1, height, H1), Yfactor is H1 / H0. y_resize(A0, A1, Y0, Yfactor) :- get(A0, bottom_side, Bottom), Y0 = Bottom, get(A0, height, H0), get(A1, height, H1), Yfactor is H1 / H0. :- pce_end_class. :- pce_begin_class(draw_resize_gesture, resize_outline_gesture). verify(G, Ev:event) :-> "Verify target is editable":: send(G, send_super, verify, Ev), get(Ev, receiver, Shape), \+ ( send(Shape, has_get_method, editable), get(Shape, editable, @off) ). terminate(G, Ev:event) :-> "Invoke auto_align":: get(Ev, receiver, Shape), get(Shape, window, Canvas), send(Canvas, open_undo_group), send(G, send_super, terminate, Ev), send(Shape?device, auto_align, Shape, resize), send(Canvas, close_undo_group). :- pce_end_class. :- pce_begin_class(draw_move_outline_gesture, move_outline_gesture). terminate(G, Ev:event) :-> "Invoke auto_align":: get(Ev, receiver, Shape), get(Shape, window, Canvas), send(Canvas, open_undo_group), send(G, send_super, terminate, Ev), send(Shape?device, auto_align, Shape, move), send(Canvas, close_undo_group). :- pce_end_class. :- pce_begin_class(draw_move_gesture, move_gesture). initiate(G, Ev:event) :-> send(G, send_super, initiate, Ev), get(Ev, window, Canvas), send(Canvas, open_undo_group). terminate(G, Ev:event) :-> "Invoke auto_align":: get(Ev, receiver, Shape), get(Shape, window, Canvas), send(G, send_super, terminate, Ev), send(Shape?device, auto_align, Shape, move), send(Canvas, close_undo_group). :- pce_end_class. /******************************** * CONNECT * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The code below is a refinement of the connect_gesture defined in PCE itself. It verifies the canvas is in the right mode and sets the <->link attribute of the gesture. This attribute will later be used to create the connection from. The `connect_gesture ->connect' behaviour has been redefined as well. The standard one uses a `connection', while this one should create a `draw_connection'. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_connect_gesture, connect_gesture). verify(G, Ev:event) :-> "Verify canvas is in connect-mode":: get(Ev?receiver, device, Dev), Dev \== @nil, get(Dev, mode, draw_connect), send(G, link, Dev?proto), send(G, send_super, verify, Ev). connect(_G, From:graphical, To:graphical, Link:link, FH:[name], TH:[name]) :-> "Connect the graphicals (using a draw_connection)":: ( get(Link, attribute, draw_connection_class, ClassName) -> true ; ClassName = draw_connection ), get(From, window, Canvas), send(Canvas, open_undo_group), Term =.. [ClassName, From, To, Link, FH, TH], new(C, Term), send(C, start_text), send(Canvas, close_undo_group), send(Canvas, modified). :- pce_end_class. /******************************** * CONNECT CREATE HANDLE * ********************************/ :- pce_begin_class(draw_connect_create_gesture, gesture). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The `draw_connect_create_gesture' is an example of a complete gesture class. It connects two graphicals at arbitrary points by attaching new handles to the graphicals and creating a connection between them. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ variable(line, line, get, "Line indicating link"). variable(from_indicator, bitmap, get, "Indicator at `from' side"). variable(to_indicator, bitmap, get, "Indicator at `to' side"). variable(to, graphical*, get, "Graphical to connect to"). class_variable(button, button_name, left, "Button used to connect (left)"). class_variable(modifier, modifier, '', "Modifier used to connect"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialise the line and markers of the gesture. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initialise(G, B:[button_name], M:[modifier]) :-> send(G, send_super, initialise, B, M), send(G, slot, line, line(0,0,0,0)), send(G, slot, from_indicator, new(bitmap(@mark_handle_image))), send(G, slot, to_indicator, new(bitmap(@mark_handle_image))). verify(_G, Ev:event) :-> "Verify canvas is in connect_create-mode":: get(Ev?receiver?device, mode, draw_cconnect). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Indicate the start-location using the <-from_indicator, give the feedback-line the appropriate attributes and display it. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initiate(G, Ev:event) :-> "Start drawing line":: get(Ev?receiver, device, Dev), get(Dev, proto, Link), get(Ev, position, Dev, Pos), send(G?line, copy, Link?line), send(G?line, texture, dotted), send(G?line, start, Pos), send(G?line, end, Pos), send(Dev, display, G?line), send(G, indicate, Ev?receiver, Pos, G?from_indicator). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Update the line, check whether the mouse points to a valid target and display a marker on it. Note how the target is located using the method `Chain <-find'. This keeps everything inside PCE, avoiding interface overhead and producing far less garbage. `Gesture ->drag' should be as fast as possible and not produce too much garbage as it will be called about 40 times per second while the mouse is dragged. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ drag(G, Ev:event) :-> get(Ev, receiver, Receiver), get(Receiver, device, Dev), get(Ev, position, Dev, Pos), send(G?line, end, Pos), ( get(?(Dev, pointed_objects, Pos), find, and(Receiver \== @arg1, G?line \== @arg1, G?from_indicator \== @arg1, G?to_indicator \== @arg1), To) -> send(G, indicate, To, Pos, G?to_indicator), send(G, slot, to, To) ; send(G, slot, to, @nil), send(G?to_indicator, device, @nil) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - If there is a target, create unique handles on both sides and link them together. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ terminate(G, Ev:event) :-> send(G, drag, Ev), send(G?line, device, @nil), send(G?from_indicator, device, @nil), send(G?to_indicator, device, @nil), get(G, to, To), ( To \== @nil -> send(G, slot, to, @nil), get(Ev, receiver, Receiver), get(Receiver?device, proto, Link), get(Ev, window, Canvas), send(Canvas, open_undo_group), get(G, handle, Receiver, G?from_indicator?center, Link?from, FH), get(G, handle, To, G?to_indicator?center, Link?to, TH), new(_, draw_connection(Receiver, To, Link, FH, TH)), send(Canvas, close_undo_group), send(Canvas, modified) ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create a unique handle on a graphical at the indicated position. The position of the handle is taken relative to the size of the graphical. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ handle(_G, Gr:graphical, Pos:point, Kind:name, Name) :<- "Attach a handle at specified position and return it's name":: get(Gr, x, X), get(Gr, y, Y), get(Gr, width, W), get(Gr, height, H), get(Pos, x, PX), get(Pos, y, PY), RX is PX - X, RY is PY - Y, unique_handle_name(Gr, Name), send(Gr, handle, handle((RX/W) * w, (RY/H) * h, Kind, Name)). unique_handle_name(Gr, Name) :- between(1, 10000, N), atom_concat(c, N, Name), \+ get(Gr, handle, Name, _), !. indicate(_G, Gr:graphical, Pos:point, Indicator:bitmap) :-> "Display indication-marker for position":: send(Indicator, center, Pos), send(Gr?device, display, Indicator). :- pce_end_class. /******************************** * SHAPE POPUP * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The code of this section attaches a popup-menu to the shapes. On a mouse-right-down event, the shape on which the down occurred is selected to indicate on which object the operation will take place. Next, the menu is shown. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@draw_shape_popup_gesture, make_draw_shape_popup_gesture). make_draw_shape_popup_gesture(G) :- new(Gr, @event?receiver), new(Canvas, Gr?device), new(P, popup), send_list(P, append, [ menu_item(align, message(Canvas, align_with_selection, Gr), @default, @off), menu_item(distribute, message(Canvas, distribute_selection), @default, @on), menu_item(duplicate, and(message(Canvas, selection, Gr), message(Canvas, duplicate_selection))), menu_item(cut, message(Canvas, cut_selection, create(chain, @arg1)), @default, @off), menu_item(copy, message(Canvas, copy_selection, create(chain, @arg1)), @default, @on), menu_item(edit_attributes, and(message(Canvas, selection, Gr), message(Canvas, edit_selection)), @default, @on), new(Alignment, popup(alignment, message(Gr, format, @arg1))), gap, menu_item(send_to_foreground, message(Canvas, edit, message(@arg1, expose), Gr), @default, @on), menu_item(send_to_background, message(Canvas, edit, message(@arg1, hide), Gr)) ]), get(P, member, alignment, Item), send(Item, condition, message(Gr, instance_of, text)), send_list(Alignment, append, [ left, center, right ]), new(G, draw_draw_shape_popup_gesture(P)). :- pce_begin_class(draw_draw_shape_popup_gesture, popup_gesture). variable(old_selected, bool*, both, "Was graphical selected"). verify(G, Ev:event) :-> get(Ev?receiver, device, Dev), Dev \== @nil, send(Dev?class, is_a, draw_canvas), send(G, send_super, verify, Ev). initiate(G, Ev:event) :-> get(Ev, receiver, Receiver), send(G, old_selected, Receiver?selected), send(Receiver, selected, @on), send(G, send_super, initiate, Ev). terminate(G, Ev:event) :-> get(G, context, Gr), send(Gr, selected, G?old_selected), send(G, send_super, terminate, Ev). :- pce_end_class.