/* 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) 1996-2011, 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_undo, []). :- use_module(library(pce)). :- require([ append/3 , default/3 ]). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module defines the undo facility for PceDraw. Undo is implemented by redefining the methods that manipulate the graphical objects such that they inform the redo system how the reverse operation is peformed. These operations are recorded as XPCE code objects (usually messages). As one user operation may map into multiple actions to undo (for example, moving the selection), a sequence of action is bracketed using ->open_undo_group and ->close_undo_group messages to the manager. These two methods maintain an <-open_count. Actions presented using ->undo_action are added to an `and' object, which is XPCE's natural notion of a sequence of actions. The `and' object currently under construction is stored in the instance variable <-action. The logic has a number of rules that avoid unnecessary built-up of actions. For example, moving the same object twice only requires the undo of the first, storing the original position, to be remembered. This is probably the most PceDraw dependend part of this class. The final ->close_undo_group checks whether the <-action represents a non-no-op sequence of actions, and finally adds the `and' object to the list of undo actions. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /******************************* * CLASS DRAW-UNDO-MANAGER * *******************************/ :- pce_begin_class(draw_undo_manager, chain, "List of undo/redo actions"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The variable <-length represents the number of steps remembered. This is currently not implemented. <-report_to is the object that opened us. This is intended for sending ->report messages to. See `visual <-report_to' for a description of this mechanism. <-direction remembers whether we are `undoing' or `redoing'. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ variable(length, int, get, "#Steps remembered"). variable(at_start, bool := @off, get, "Signals no more undo's"). variable(report_to, any, get, "Normally my client"). variable(action, and*, none, "Collected action (sofar)"). variable(open_count, int, get, "Count for opened"). variable(direction, {forwards,backwards}*, get, "Current undo direction"). initialise(UB, ReportTo:any, Size:[int]) :-> "Create with Size steps":: default(Size, 10, TheSize), send(UB, send_super, initialise), send(UB, slot, report_to, ReportTo), send(UB, slot, length, TheSize), send(UB, slot, open_count, 0). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->open_undo_group associates a new <-action, and resets the undo-pointer to the tail of the undo list. Further ->open_undo_group simply increment <-open_count, so actions making a group can call each other, and only the outer-most group, normally invoked from the GUI will combine the undo messages. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ open_undo_group(UB) :-> "Add a new entry":: get(UB, open_count, OC), ( OC == 0 -> debug('**** New Undo ****~n', []), send(UB, slot, action, new(and)), send(UB, current, @nil), send(UB, slot, at_start, @off) ; true ), NC is OC + 1, send(UB, slot, open_count, NC). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - discardable_undo/1 deals with two situations: empty undos are cases where a group was started and ended, but nothing was actually modified. The create-resize gestures create objects, and remove them if the object is smaller then the minimal size. The second clause checks for this. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ discardable_undo(And) :- send(And, empty), !. discardable_undo(And) :- get(And, tail, T), classify_message(T, cut(Gr)), get(And?members, find, message(@prolog, classify_message, @arg1, un_cut, Gr), _). classify_message(Msg, Action, Object) :- Term =.. [Action, Object], classify_message(Msg, Term). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->close_undo_group closes the group opened by ->open_undo_group. If the count drops to 0, the <-actions is appended to the manager itself. Special cases are if the group can be discarded (see above), or the <-action is a `redo', and there is an `undo' just before it. These couples may be created by the user scanning backwards and forwards through the undo chain for the right spot, and can be deleted. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ close_undo_group(UB) :-> "Add undo group":: get(UB, open_count, OC), NC is OC - 1, send(UB, slot, open_count, NC), ( NC == 0 -> get(UB, slot, action, Msg), ( discardable_undo(Msg) -> debug('**** Discarded undo~n', []) ; ( get(Msg, attribute, undo, forwards), get(UB?tail, attribute, undo, backwards) -> send(UB, delete_tail), debug('**** Removed undo/redo pair~n', []) ; send(UB, append, Msg), send(UB, slot, action, @nil), send(UB, current, @nil), debug('**** Closed undo~n', []) ) ) ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->reset is called from `draw_canvas->reset', which in turn is called on aborts and other resets of the system. It clears the grouping system, as the ->close_undo_group calls will not come. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ reset(UB) :-> "Reset after abort":: send(UB, slot, action, @nil), send(UB, slot, open_count, 0), send(UB, slot, at_start, @off), send(UB, current, @nil). clear(UB) :-> send(UB, send_super, clear), send(UB, reset). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - classify_message/2 extracts the vital information from a message, such that the checking whether messages may be removed can be implemented easily using Prolog matching rules. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ classification(do_set, do_set(receiver)). classification(cut, cut(receiver)). classification(un_cut, un_cut(receiver)). classification(set_point, set_point(receiver, argument(1))). classify_message(M, X) :- send(M, instance_of, message), get(M, selector, Sel), classification(Sel, Term), functor(Term, Name, Arity), functor(X, Name, Arity), class_args(0, Arity, M, Term, X). class_args(Arity, Arity, _, _, _). class_args(N, Arity, M, In, Out) :- NN is N + 1, arg(NN, In, What), What =.. List, append(List, [Val], L2), Goal =.. [get, M | L2], Goal, arg(NN, Out, Val), class_args(NN, Arity, M, In, Out). merge(do_set(G), do_set(G)). merge(set_point(G, P), set_point(G, P)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->undo_action is called from the various shape manipulation codes. Most of the calls come from the shape module. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ undo_action(UB, M:code) :-> "Add an action to undo":: get(UB, slot, action, A), ( A \== @nil -> ( get(A, head, H), classify_message(M, CM), classify_message(H, CH), merge(CM, CH) -> debug('~t~16|(merged)~n', []) ; send(A, prepend, M) ) ; true ), object(M, Term), debug('~t~8|Added to group: ~w~n', [Term]). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This message may be used by toplevel undo-group if the last added action undos all relevant operations. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ clear_group(UB) :-> "Empty the current action group":: ( get(UB, open_count, 1) % can only clear on outer -> get(UB, slot, action, And), send(And?members, clear) ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->undo basically just picks the current undo message and executes it. It sets up a group, so the `undo of the undo' (redo) will be appended to the chain automatically. `chain <->current' is used to remember the current location in the undo chain. If there is no current, no undo has been executed previously, and the system will use the last. If the head has been executed, <-at_start is set to @on to indicate such. Finally, <-actions recorded as a result of an undo are marked with their direction (undo/redo) to be able to remove undo/redo pairs from the chain. See also ->close_undo_group. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ undo(UB) :-> "Undo the latest action":: ( get(UB, at_start, @on) -> send(UB, report, warning, 'No further undo') ; ( ( get(UB, current, Current) ; get(UB, tail, Current) ) -> send(UB, open_undo_group), % reopen for `redo' action send(Current, execute), get(UB, slot, action, Action), send(Action, attribute, undo, UB?direction), ( get(UB, previous, Current, Prev) -> true ; Prev = @nil ), send(UB, close_undo_group), ( Prev \== @nil -> send(UB, current, Prev) ; send(UB, slot, at_start, @on) ) ) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->start_undo, ->end_undo and ->direction are used to control the undo process. ->start_undo sets the pointer to the end, so the last operation will be undone. ->end_undo clears the <-direction. ->direction changes the direction of the undo. Basically, any change of direction simply implies to go back to the end of the chain, to undo recorded `redo' operations. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ start_undo(UB) :-> "Open an undo session":: send(UB, slot, direction, backwards), send(UB, current, @nil), send(UB, slot, at_start, @off). end_undo(UB) :-> "Close an undo session":: send(UB, slot, direction, @nil). direction(UB, Dir:{forwards,backwards}) :-> "Determine undo direction":: ( get(UB, direction, Dir) -> true ; send(UB, slot, direction, Dir), send(UB, current, @nil), send(UB, slot, at_start, @off) ). can_undo(UB) :-> "succeeds if ready for undo":: \+ send(UB, empty), get(UB, at_start, @off). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ->open opens a visualisation of the undo buffer, so the process is represented in a natural manner to the user. The visualiser is made a `transient' window of PceDraw, so the window manager will properly connect the two windows, and the ->modal message on the undo visualiser makes it impossible to interact with the drawing canvas itself while undoing. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ open(UB, V:[frame]) :-> "Visualise the status":: ( V == @default -> send(draw_undo_view(UB), open) ; get(V, area, area(X, Y, _W, _H)), new(UV, draw_undo_view(UB)), send(UV, transient_for, V), send(UV, open, point(X+200, Y+30)) ). :- pce_end_class. /******************************* * VISUAL * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The relation between the undo manager (data object) and the visualiser is managed by a hyper. Hypers guarantee consistency of the database, should one of the objects be destroyed, while they can be programmed to make the existence of one side being dependant on the existence of the other. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_part_hyper, hyper). initialise(H, Whole:object, Part:object, PartName:[name], WholeName:[name]) :-> default(PartName, part, PN), default(WholeName, whole, WN), send(H, send_super, initialise, Whole, Part, PN, WN). delete_from(H) :-> get(H, to, Part), free(Part), free(H). :- pce_end_class. /******************************* * CLASS DRAW-UNDO-VIEW * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This class defines the rather trivial visualiser for the undo buffer. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_undo_view, dialog, "Window to visualise undo process"). variable(index, int, get, "Current index"). initialise(UV, UB:draw_undo_manager) :-> "Create for undo manager":: send(UV, send_super, initialise, 'Undo'), new(_, draw_part_hyper(UB, UV, visualiser, buffer)), Low = 0, get(UB, size, High), send(UV, slot, index, High), send(UV, append, slider(undo, Low, High, High, message(UV, goto, @arg1))), send(UV, append, button(undo, message(UV, undo))), send(UV, append, button(redo, message(UV, redo))), send(UV, append, button(quit, and(message(UB, end_undo), message(UV, destroy)))), send(UV, modal, transient), send(UB, start_undo). undo_buffer(UV, UB:draw_undo_manager) :<- "Find the buffer I am showing":: get(UV, hypered, buffer, UB). index(UV, Idx:int) :-> get(UV, member, undo, Slider), send(Slider, selection, Idx), send(UV, slot, index, Idx). undo(UV) :-> get(UV, member, undo, Slider), get(Slider, low, Low), get(UV, index, Here), ( Here == Low -> send(UV, report, warning, 'No further undo available') ; get(UV, undo_buffer, UB), send(UB, direction, backwards), send(UB, undo), NHere is Here - 1, send(UV, index, NHere) ). redo(UV) :-> get(UV, member, undo, Slider), get(Slider, high, High), get(UV, index, Here), ( Here == High -> send(UV, report, warning, 'At end-point') ; get(UV, undo_buffer, UB), send(UB, direction, forwards), send(UB, undo), NHere is Here + 1, send(UV, index, NHere) ). goto(UV, Goto:int) :-> goto(UV, Goto). goto(UV, Goto) :- get(UV, index, Here), ( Goto > Here -> send(UV, redo), goto(UV, Goto) ; Goto < Here -> send(UV, undo), goto(UV, Goto) ; true ). :- pce_end_class. /******************************* * DEBUG * *******************************/ debug(_, _) :- !. %debug(Fmt, Args) :- % format(Fmt, Args).