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