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)  1996-2011, 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_undo, []).
36:- use_module(library(pce)).
37:- require([ append/3
38           , default/3
39           ]).
40
41/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42This module defines the undo facility   for PceDraw. Undo is implemented
43by redefining the methods that  manipulate   the  graphical objects such
44that they inform the redo system how  the reverse operation is peformed.
45These operations are recorded as XPCE code objects (usually messages).
46
47As one user operation  may  map  into   multiple  actions  to  undo (for
48example, moving the selection), a sequence  of action is bracketed using
49->open_undo_group and ->close_undo_group messages to  the manager. These
50two  methods  maintain  an   <-open_count.    Actions   presented  using
51->undo_action are added to an  `and'   object,  which  is XPCE's natural
52notion of a sequence  of  actions.   The  `and'  object  currently under
53construction is stored in the instance  variable <-action. The logic has
54a number of rules  that  avoid   unnecessary  built-up  of  actions. For
55example, moving the same object twice  only   requires  the  undo of the
56first, storing the original position, to be remembered. This is probably
57the most PceDraw dependend part of this class.
58
59The final ->close_undo_group checks whether   the  <-action represents a
60non-no-op sequence of actions, and finally adds  the `and' object to the
61list of undo actions.
62- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
63
64                 /*******************************
65                 *    CLASS DRAW-UNDO-MANAGER   *
66                 *******************************/
67
68:- pce_begin_class(draw_undo_manager, chain,
69                   "List of undo/redo actions").
70
71/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72The variable <-length represents the number of steps remembered. This is
73currently not implemented. <-report_to is  the   object  that opened us.
74This  is  intended  for  sending  ->report   messages  to.  See  `visual
75<-report_to' for a description of  this mechanism. <-direction remembers
76whether we are `undoing' or `redoing'.
77- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
78
79variable(length,        int,            get,  "#Steps remembered").
80variable(at_start,      bool := @off,   get,  "Signals no more undo's").
81variable(report_to,     any,            get,  "Normally my client").
82variable(action,        and*,           none, "Collected action (sofar)").
83variable(open_count,    int,            get,  "Count for opened").
84variable(direction,     {forwards,backwards}*, get, "Current undo direction").
85
86initialise(UB, ReportTo:any, Size:[int]) :->
87    "Create with Size steps"::
88    default(Size, 10, TheSize),
89    send(UB, send_super, initialise),
90    send(UB, slot, report_to, ReportTo),
91    send(UB, slot, length, TheSize),
92    send(UB, slot, open_count, 0).
93
94
95/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
96->open_undo_group associates a new <-action, and resets the undo-pointer
97to the tail of the undo list. Further ->open_undo_group simply increment
98<-open_count, so actions making a group can   call  each other, and only
99the outer-most group, normally invoked  from   the  GUI will combine the
100undo messages.
101- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
102
103open_undo_group(UB) :->
104    "Add a new entry"::
105    get(UB, open_count, OC),
106    (   OC == 0
107    ->  debug('**** New Undo ****~n', []),
108        send(UB, slot, action, new(and)),
109        send(UB, current, @nil),
110        send(UB, slot, at_start, @off)
111    ;   true
112    ),
113    NC is OC + 1,
114    send(UB, slot, open_count, NC).
115
116
117/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
118discardable_undo/1 deals with two  situations:   empty  undos  are cases
119where a group was started and ended,  but nothing was actually modified.
120The create-resize gestures create objects, and remove them if the object
121is smaller then the minimal size. The second clause checks for this.
122- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
123
124discardable_undo(And) :-
125    send(And, empty),
126    !.
127discardable_undo(And) :-
128    get(And, tail, T),
129    classify_message(T, cut(Gr)),
130    get(And?members, find,
131        message(@prolog, classify_message, @arg1, un_cut, Gr),
132        _).
133
134classify_message(Msg, Action, Object) :-
135    Term =.. [Action, Object],
136    classify_message(Msg, Term).
137
138/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
139->close_undo_group closes the group opened  by ->open_undo_group. If the
140count drops to 0, the  <-actions  is   appended  to  the manager itself.
141Special cases are if the group  can   be  discarded  (see above), or the
142<-action is a `redo', and  there  is   an  `undo'  just before it. These
143couples may be created  by  the   user  scanning  backwards and forwards
144through the undo chain for the right spot, and can be deleted.
145- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
146
147close_undo_group(UB) :->
148    "Add undo group"::
149    get(UB, open_count, OC),
150    NC is OC - 1,
151    send(UB, slot, open_count, NC),
152    (   NC == 0
153    ->  get(UB, slot, action, Msg),
154        (   discardable_undo(Msg)
155        ->  debug('**** Discarded undo~n', [])
156        ;   (   get(Msg, attribute, undo, forwards),
157                get(UB?tail, attribute, undo, backwards)
158            ->  send(UB, delete_tail),
159                debug('**** Removed undo/redo pair~n', [])
160            ;   send(UB, append, Msg),
161                send(UB, slot, action, @nil),
162                send(UB, current, @nil),
163                debug('**** Closed undo~n', [])
164            )
165        )
166    ;   true
167    ).
168
169/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
170->reset is called from `draw_canvas->reset', which  in turn is called on
171aborts and other resets of the system. It clears the grouping system, as
172the ->close_undo_group calls will not come.
173- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
174
175reset(UB) :->
176    "Reset after abort"::
177    send(UB, slot, action, @nil),
178    send(UB, slot, open_count, 0),
179    send(UB, slot, at_start, @off),
180    send(UB, current, @nil).
181
182
183clear(UB) :->
184    send(UB, send_super, clear),
185    send(UB, reset).
186
187
188/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
189classify_message/2 extracts the vital information   from a message, such
190that the checking whether messages  may   be  removed can be implemented
191easily using Prolog matching rules.
192- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
193
194classification(do_set,    do_set(receiver)).
195classification(cut,       cut(receiver)).
196classification(un_cut,    un_cut(receiver)).
197classification(set_point, set_point(receiver, argument(1))).
198
199classify_message(M, X) :-
200    send(M, instance_of, message),
201    get(M, selector, Sel),
202    classification(Sel, Term),
203    functor(Term, Name, Arity),
204    functor(X, Name, Arity),
205    class_args(0, Arity, M, Term, X).
206
207class_args(Arity, Arity, _, _, _).
208class_args(N, Arity, M, In, Out) :-
209    NN is N + 1,
210    arg(NN, In, What),
211    What =.. List,
212    append(List, [Val], L2),
213    Goal =.. [get, M | L2],
214    Goal,
215    arg(NN, Out, Val),
216    class_args(NN, Arity, M, In, Out).
217
218merge(do_set(G), do_set(G)).
219merge(set_point(G, P), set_point(G, P)).
220
221/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
222->undo_action is called from the various  shape manipulation codes. Most
223of the calls come from the shape module.
224- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
225
226undo_action(UB, M:code) :->
227    "Add an action to undo"::
228    get(UB, slot, action, A),
229    (   A \== @nil
230    ->  (   get(A, head, H),
231            classify_message(M, CM),
232            classify_message(H, CH),
233            merge(CM, CH)
234        ->  debug('~t~16|(merged)~n', [])
235        ;   send(A, prepend, M)
236        )
237    ;   true
238    ),
239    object(M, Term),
240    debug('~t~8|Added to group: ~w~n', [Term]).
241
242
243/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
244This message may be used by toplevel undo-group if the last added action
245undos all relevant operations.
246- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
247
248clear_group(UB) :->
249    "Empty the current action group"::
250    (   get(UB, open_count, 1)      % can only clear on outer
251    ->  get(UB, slot, action, And),
252        send(And?members, clear)
253    ;   true
254    ).
255
256/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
257->undo basically just picks the current undo message and executes it. It
258sets up a group, so the `undo of   the  undo' (redo) will be appended to
259the chain automatically. `chain <->current'  is   used  to  remember the
260current location in the undo chain. If there  is no current, no undo has
261been executed previously, and the system will  use the last. If the head
262has been executed, <-at_start is set to @on to indicate such.
263
264Finally, <-actions recorded as a result of an undo are marked with their
265direction (undo/redo) to be able  to   remove  undo/redo  pairs from the
266chain.  See also ->close_undo_group.
267- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
268
269undo(UB) :->
270    "Undo the latest action"::
271    (   get(UB, at_start, @on)
272    ->  send(UB, report, warning, 'No further undo')
273    ;   (   (   get(UB, current, Current)
274            ;   get(UB, tail, Current)
275            )
276        ->  send(UB, open_undo_group),      % reopen for `redo' action
277            send(Current, execute),
278            get(UB, slot, action, Action),
279            send(Action, attribute, undo, UB?direction),
280            (   get(UB, previous, Current, Prev)
281            ->  true
282            ;   Prev = @nil
283            ),
284            send(UB, close_undo_group),
285            (   Prev \== @nil
286            ->  send(UB, current, Prev)
287            ;   send(UB, slot, at_start, @on)
288            )
289        )
290    ).
291
292
293/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294->start_undo, ->end_undo and ->direction are used   to  control the undo
295process. ->start_undo sets the pointer to the end, so the last operation
296will be undone. ->end_undo clears   the <-direction. ->direction changes
297the direction of the undo.  Basically,   any  change of direction simply
298implies to go back to the end  of   the  chain,  to undo recorded `redo'
299operations.
300- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
301
302start_undo(UB) :->
303    "Open an undo session"::
304    send(UB, slot, direction, backwards),
305    send(UB, current, @nil),
306    send(UB, slot, at_start, @off).
307
308
309end_undo(UB) :->
310    "Close an undo session"::
311    send(UB, slot, direction, @nil).
312
313
314direction(UB, Dir:{forwards,backwards}) :->
315    "Determine undo direction"::
316    (   get(UB, direction, Dir)
317    ->  true
318    ;   send(UB, slot, direction, Dir),
319        send(UB, current, @nil),
320        send(UB, slot, at_start, @off)
321    ).
322
323
324can_undo(UB) :->
325    "succeeds if ready for undo"::
326    \+ send(UB, empty),
327    get(UB, at_start, @off).
328
329/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
330->open opens a visualisation of  the  undo   buffer,  so  the process is
331represented in a natural manner to the   user.  The visualiser is made a
332`transient' window of PceDraw,  so  the   window  manager  will properly
333connect the two windows, and the ->modal  message on the undo visualiser
334makes it impossible to interact  with   the  drawing canvas itself while
335undoing.
336- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
337
338open(UB, V:[frame]) :->
339    "Visualise the status"::
340    (   V == @default
341    ->  send(draw_undo_view(UB), open)
342    ;   get(V, area, area(X, Y, _W, _H)),
343        new(UV, draw_undo_view(UB)),
344        send(UV, transient_for, V),
345        send(UV, open, point(X+200, Y+30))
346    ).
347
348:- pce_end_class.
349
350
351                 /*******************************
352                 *             VISUAL           *
353                 *******************************/
354
355/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
356The relation between the undo manager   (data object) and the visualiser
357is managed by a hyper.  Hypers   guarantee  consistency of the database,
358should one of the objects be destroyed,  while they can be programmed to
359make the existence of one side being   dependant on the existence of the
360other.
361- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
362
363:- pce_begin_class(draw_part_hyper, hyper).
364
365initialise(H, Whole:object, Part:object, PartName:[name], WholeName:[name]) :->
366    default(PartName, part, PN),
367    default(WholeName, whole, WN),
368    send(H, send_super, initialise, Whole, Part, PN, WN).
369
370delete_from(H) :->
371    get(H, to, Part),
372    free(Part),
373    free(H).
374
375:- pce_end_class.
376
377                 /*******************************
378                 *      CLASS DRAW-UNDO-VIEW    *
379                 *******************************/
380
381/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
382This class defines the rather trivial visualiser for the undo buffer.
383- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
384
385:- pce_begin_class(draw_undo_view, dialog,
386                   "Window to visualise undo process").
387
388variable(index,       int,                  get, "Current index").
389
390initialise(UV, UB:draw_undo_manager) :->
391    "Create for undo manager"::
392    send(UV, send_super, initialise, 'Undo'),
393    new(_, draw_part_hyper(UB, UV, visualiser, buffer)),
394    Low = 0,
395    get(UB, size, High),
396    send(UV, slot, index, High),
397    send(UV, append, slider(undo, Low, High, High,
398                            message(UV, goto, @arg1))),
399    send(UV, append, button(undo,
400                            message(UV, undo))),
401    send(UV, append, button(redo,
402                            message(UV, redo))),
403    send(UV, append, button(quit,
404                            and(message(UB, end_undo),
405                                message(UV, destroy)))),
406    send(UV, modal, transient),
407    send(UB, start_undo).
408
409
410undo_buffer(UV, UB:draw_undo_manager) :<-
411    "Find the buffer I am showing"::
412    get(UV, hypered, buffer, UB).
413
414
415index(UV, Idx:int) :->
416    get(UV, member, undo, Slider),
417    send(Slider, selection, Idx),
418    send(UV, slot, index, Idx).
419
420
421undo(UV) :->
422    get(UV, member, undo, Slider),
423    get(Slider, low, Low),
424    get(UV, index, Here),
425    (   Here == Low
426    ->  send(UV, report, warning, 'No further undo available')
427    ;   get(UV, undo_buffer, UB),
428        send(UB, direction, backwards),
429        send(UB, undo),
430        NHere is Here - 1,
431        send(UV, index, NHere)
432    ).
433
434redo(UV) :->
435    get(UV, member, undo, Slider),
436    get(Slider, high, High),
437    get(UV, index, Here),
438    (   Here == High
439    ->  send(UV, report, warning, 'At end-point')
440    ;   get(UV, undo_buffer, UB),
441        send(UB, direction, forwards),
442        send(UB, undo),
443        NHere is Here + 1,
444        send(UV, index, NHere)
445    ).
446
447goto(UV, Goto:int) :->
448    goto(UV, Goto).
449
450goto(UV, Goto) :-
451    get(UV, index, Here),
452    (   Goto > Here
453    ->  send(UV, redo),
454        goto(UV, Goto)
455    ;   Goto < Here
456    ->  send(UV, undo),
457        goto(UV, Goto)
458    ;   true
459    ).
460
461:- pce_end_class.
462
463
464                 /*******************************
465                 *             DEBUG            *
466                 *******************************/
467
468debug(_, _) :- !.
469%debug(Fmt, Args) :-
470%       format(Fmt, Args).
471