Trurl-based/System/Mod/Controllers.txt

   1 MODULE Controllers;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Controllers.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Kernel, Services, Ports, Stores, Models, Views;
   7
   8         CONST
   9                 (** Forward target **)
  10                 targetPath* = TRUE; frontPath* = FALSE;
  11
  12                 (** ScrollMsg.op **)
  13                 decLine* = 0; incLine* = 1; decPage* = 2; incPage* = 3; gotoPos* = 4;
  14
  15                 (** PageMsg.op **)
  16                 nextPageX* = 0; nextPageY* = 1; gotoPageX* = 2; gotoPageY* = 3;
  17
  18                 (** PollOpsMsg.valid, EditMsg.op **)
  19                 cut* = 0; copy* = 1;
  20                 pasteChar* = 2; (* pasteLChar* = 3; *) paste* = 4; (* pasteView* = 5; *)
  21
  22                 (** TrackMsg.modifiers, EditMsg.modifiers **)
  23                 doubleClick* = 0;       (** clicking history **)
  24                 extend* = 1; modify* = 2;       (** modifier keys **)
  25                 (* extend = Sub.extend; modify = Sub.modify *)
  26
  27                 (** PollDropMsg.mark, PollDrop mark **)
  28                 noMark* = FALSE; mark* = TRUE;
  29                 (** PollDropMsg.show, PollDrop show **)
  30                 hide* = FALSE; show* = TRUE;
  31
  32                 minVersion = 0; maxVersion = 0;
  33
  34
  35         TYPE
  36
  37                 (** messages **)
  38
  39                 Message* = Views.CtrlMessage;
  40
  41                 PollFocusMsg* = EXTENSIBLE RECORD (Message)
  42                         focus*: Views.Frame     (** OUT, preset to NIL **)
  43                 END;
  44
  45                 PollSectionMsg* = RECORD (Message)
  46                         focus*, vertical*: BOOLEAN;     (** IN **)
  47                         wholeSize*: INTEGER;    (** OUT, preset to 1 **)
  48                         partSize*: INTEGER;     (** OUT, preset to 1 **)
  49                         partPos*: INTEGER;      (** OUT, preset to 0 **)
  50                         valid*, done*: BOOLEAN  (** OUT, preset to (FALSE, FALSE) **)
  51                 END;
  52
  53                 PollOpsMsg* = RECORD (Message)
  54                         type*: Stores.TypeName; (** OUT, preset to "" **)
  55                         pasteType*: Stores.TypeName;    (** OUT, preset to "" **)
  56                         singleton*: Views.View; (** OUT, preset to NIL **)
  57                         selectable*: BOOLEAN;   (** OUT, preset to FALSE **)
  58                         valid*: SET     (** OUT, preset to {} **)
  59                 END;
  60
  61                 ScrollMsg* = RECORD (Message)
  62                         focus*, vertical*: BOOLEAN;     (** IN **)
  63                         op*: INTEGER;   (** IN **)
  64                         pos*: INTEGER;  (** IN **)
  65                         done*: BOOLEAN  (** OUT, preset to FALSE **)
  66                 END;
  67
  68                 PageMsg* = RECORD (Message)
  69                         op*: INTEGER;   (** IN **)
  70                         pageX*, pageY*: INTEGER;        (** IN **)
  71                         done*, eox*, eoy*: BOOLEAN      (** OUT, preset to (FALSE, FALSE, FALSE) **)
  72                 END;
  73
  74                 TickMsg* = RECORD (Message)
  75                         tick*: INTEGER  (** IN **)
  76                 END;
  77
  78                 MarkMsg* = RECORD (Message)
  79                         show*: BOOLEAN; (** IN **)
  80                         focus*: BOOLEAN (** IN **)
  81                 END;
  82
  83                 SelectMsg* = RECORD (Message)
  84                         set*: BOOLEAN   (** IN **)
  85                 END;
  86
  87
  88                 RequestMessage* = ABSTRACT RECORD (Message)
  89                         requestFocus*: BOOLEAN  (** OUT, preset (by framework) to FALSE **)
  90                 END;
  91
  92                 EditMsg* = RECORD (RequestMessage)
  93                         op*: INTEGER;   (** IN **)
  94                         modifiers*: SET;        (** IN, valid if op IN {pasteChar, pasteLchar} **)
  95                         char*: CHAR;    (** IN, valid if op = pasteChar **)
  96                         view*: Views.View; w*, h*: INTEGER;     (** IN, valid if op  = paste **)
  97                                                                                                                 (** OUT, valid if op IN {cut, copy} **)
  98                         isSingle*: BOOLEAN;     (** dito **)
  99                         clipboard*: BOOLEAN     (** IN, valid if op IN {cut, copy, paste} **)
 100                 END;
 101
 102                 ReplaceViewMsg* = RECORD (RequestMessage)
 103                         old*, new*: Views.View  (** IN **)
 104                 END;
 105
 106
 107                 CursorMessage* = ABSTRACT RECORD (RequestMessage)
 108                         x*, y*: INTEGER (** IN, needs translation when passed on **)
 109                 END;
 110
 111                 PollCursorMsg* = RECORD (CursorMessage)
 112                         cursor*: INTEGER;       (** OUT, preset to Ports.arrowCursor **)
 113                         modifiers*: SET (** IN **)
 114                 END;
 115
 116                 TrackMsg* = RECORD (CursorMessage)
 117                         modifiers*: SET (** IN **)
 118                 END;
 119
 120                 WheelMsg* = RECORD (CursorMessage)
 121                         done*: BOOLEAN;                 (** must be set if the message is handled **)
 122                         op*, nofLines*: INTEGER;
 123                 END;
 124
 125
 126                 TransferMessage* = ABSTRACT RECORD (CursorMessage)
 127                         source*: Views.Frame;   (** IN, home frame of transfer originator, may be NIL if unknown **)
 128                         sourceX*, sourceY*: INTEGER     (** IN, reference point in source frame, defined if source # NIL **)
 129                 END;
 130
 131                 PollDropMsg* = RECORD (TransferMessage)
 132                         mark*: BOOLEAN; (** IN, request to mark drop target **)
 133                         show*: BOOLEAN; (** IN, if mark then show/hide target mark **)
 134                         type*: Stores.TypeName; (** IN, type of view to drop **)
 135                         isSingle*: BOOLEAN;     (** IN, view to drop is singleton **)
 136                         w*, h*: INTEGER;        (** IN, size of view to drop, may be 0, 0 **)
 137                         rx*, ry*: INTEGER;      (** IN, reference point in view **)
 138                         dest*: Views.Frame      (** OUT, preset to NIL, set if DropMsg is acceptable **)
 139                 END;
 140
 141                 DropMsg* = RECORD (TransferMessage)
 142                         view*: Views.View;      (** IN, drop this *)
 143                         isSingle*: BOOLEAN;     (** IN, view to drop is singleton **)
 144                         w*, h*: INTEGER;        (** IN, proposed size *)
 145                         rx*, ry*: INTEGER       (** IN, reference point in view **)
 146                 END;
 147
 148
 149                 (** controllers **)
 150
 151                 Controller* = POINTER TO ABSTRACT RECORD (Stores.Store) END;
 152
 153
 154                 (** forwarders **)
 155
 156                 Forwarder* = POINTER TO ABSTRACT RECORD
 157                         next: Forwarder
 158                 END;
 159
 160                 TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
 161                 PathInfo = POINTER TO RECORD
 162                         path: BOOLEAN; prev: PathInfo
 163                 END;
 164
 165                 BalanceCheckAction = POINTER TO RECORD (Services.Action)
 166                         wait: WaitAction
 167                 END;
 168                 WaitAction = POINTER TO RECORD (Services.Action)
 169                         check: BalanceCheckAction
 170                 END;
 171
 172         VAR
 173                 path-: BOOLEAN;
 174
 175                 list: Forwarder;
 176
 177                 cleaner: TrapCleaner;
 178                 prevPath, cache: PathInfo;
 179
 180
 181
 182         (** BalanceCheckAction **)
 183
 184         PROCEDURE (a: BalanceCheckAction) Do;
 185         BEGIN
 186                 Services.DoLater(a.wait, Services.resolution);
 187                 ASSERT(prevPath = NIL, 100);
 188         END Do;
 189
 190         PROCEDURE (a: WaitAction) Do;
 191         BEGIN
 192                 Services.DoLater(a.check, Services.immediately)
 193         END Do;
 194
 195         (** Cleaner **)
 196
 197         PROCEDURE (c: TrapCleaner) Cleanup;
 198         BEGIN
 199                 path := frontPath;
 200                 prevPath := NIL
 201         END Cleanup;
 202
 203         PROCEDURE NewPathInfo(): PathInfo;
 204                 VAR c: PathInfo;
 205         BEGIN
 206                 IF cache = NIL THEN NEW(c)
 207                 ELSE c := cache; cache := cache.prev
 208                 END;
 209                 RETURN c
 210         END NewPathInfo;
 211
 212         PROCEDURE DisposePathInfo(c: PathInfo);
 213         BEGIN
 214                 c.prev := cache; cache := c
 215         END DisposePathInfo;
 216
 217
 218         (** Controller **)
 219
 220         PROCEDURE (c: Controller) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
 221         (** pre: ~c.init **)
 222         (** post: c.init **)
 223                 VAR thisVersion: INTEGER;
 224         BEGIN
 225                 c.Internalize^(rd);
 226                 rd.ReadVersion(minVersion, maxVersion, thisVersion)
 227         END Internalize;
 228
 229         PROCEDURE (c: Controller) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
 230         (** pre: c.init **)
 231         BEGIN
 232                 c.Externalize^(wr);
 233                 wr.WriteVersion(maxVersion)
 234         END Externalize;
 235
 236
 237         (** Forwarder **)
 238
 239         PROCEDURE (f: Forwarder) Forward* (target: BOOLEAN; VAR msg: Message), NEW, ABSTRACT;
 240         PROCEDURE (f: Forwarder) Transfer* (VAR msg: TransferMessage), NEW, ABSTRACT;
 241
 242         PROCEDURE Register* (f: Forwarder);
 243                 VAR t: Forwarder;
 244         BEGIN
 245                 ASSERT(f # NIL, 20);
 246                 t := list; WHILE (t # NIL) & (t # f) DO t := t.next END;
 247                 IF t = NIL THEN f.next := list; list := f END
 248         END Register;
 249
 250         PROCEDURE Delete* (f: Forwarder);
 251                 VAR t: Forwarder;
 252         BEGIN
 253                 ASSERT(f # NIL, 20);
 254                 IF f = list THEN
 255                         list := list.next
 256                 ELSE
 257                         t := list; WHILE (t # NIL) & (t.next # f) DO t := t.next END;
 258                         IF t # NIL THEN t.next := f.next END
 259                 END;
 260                 f.next := NIL
 261         END Delete;
 262
 263
 264         PROCEDURE ForwardVia* (target: BOOLEAN; VAR msg: Message);
 265                 VAR t: Forwarder;
 266         BEGIN
 267                 t := list; WHILE t # NIL DO t.Forward(target, msg); t := t.next END
 268         END ForwardVia;
 269
 270         PROCEDURE SetCurrentPath* (target: BOOLEAN);
 271                 VAR p: PathInfo;
 272         BEGIN
 273                 IF prevPath = NIL THEN Kernel.PushTrapCleaner(cleaner) END;
 274                 p := NewPathInfo(); p.prev := prevPath; prevPath := p; p.path := path;
 275                 path := target
 276         END SetCurrentPath;
 277
 278         PROCEDURE ResetCurrentPath*;
 279                 VAR p: PathInfo;
 280         BEGIN
 281                 IF prevPath # NIL THEN (* otherwise trap cleaner may have already removed prefPath objects *)
 282                         p := prevPath; prevPath := p.prev; path := p.path;
 283                         IF prevPath = NIL THEN Kernel.PopTrapCleaner(cleaner) END;
 284                         DisposePathInfo(p)
 285                 END
 286         END ResetCurrentPath;
 287
 288         PROCEDURE Forward* (VAR msg: Message);
 289         BEGIN
 290                 ForwardVia(path, msg)
 291         END Forward;
 292
 293         PROCEDURE PollOps* (VAR msg: PollOpsMsg);
 294         BEGIN
 295                 msg.type := "";
 296                 msg.pasteType := "";
 297                 msg.singleton := NIL;
 298                 msg.selectable := FALSE;
 299                 msg.valid := {};
 300                 Forward(msg)
 301         END PollOps;
 302
 303         PROCEDURE PollCursor* (x, y: INTEGER; modifiers: SET; OUT cursor: INTEGER);
 304                 VAR msg: PollCursorMsg;
 305         BEGIN
 306                 msg.x := x; msg.y := y; msg.cursor := Ports.arrowCursor; msg.modifiers := modifiers;
 307                 Forward(msg);
 308                 cursor := msg.cursor
 309         END PollCursor;
 310
 311         PROCEDURE Transfer* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER; VAR msg: TransferMessage);
 312                 VAR t: Forwarder;
 313         BEGIN
 314                 ASSERT(source # NIL, 20);
 315                 msg.x := x; msg.y := y;
 316                 msg.source := source; msg.sourceX := sourceX; msg.sourceY := sourceY;
 317                 t := list; WHILE t # NIL DO t.Transfer(msg); t := t.next END
 318         END Transfer;
 319
 320         PROCEDURE PollDrop* (x, y: INTEGER;
 321                                                         source: Views.Frame; sourceX, sourceY: INTEGER;
 322                                                         mark, show: BOOLEAN;
 323                                                         type: Stores.TypeName;
 324                                                         isSingle: BOOLEAN;
 325                                                         w, h, rx, ry: INTEGER;
 326                                                         OUT dest: Views.Frame; OUT destX, destY: INTEGER);
 327                 VAR msg: PollDropMsg;
 328         BEGIN
 329                 ASSERT(source # NIL, 20);
 330                 msg.mark := mark; msg.show := show; msg.type := type; msg.isSingle := isSingle;
 331                 msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry; msg.dest := NIL;
 332                 Transfer(x, y, source, sourceX, sourceY, msg);
 333                 dest := msg.dest; destX := msg.x; destY := msg.y
 334         END PollDrop;
 335
 336         PROCEDURE Drop* (x, y: INTEGER; source: Views.Frame; sourceX, sourceY: INTEGER;
 337                                                                         view: Views.View; isSingle: BOOLEAN; w, h, rx, ry: INTEGER);
 338                 VAR msg: DropMsg;
 339         BEGIN
 340                 ASSERT(source # NIL, 20); ASSERT(view # NIL, 21);
 341                 msg.view := view; msg.isSingle := isSingle;
 342                 msg.w := w; msg.h := h; msg.rx := rx; msg.ry := ry;
 343                 Transfer(x, y, source, sourceX, sourceY, msg)
 344         END Drop;
 345
 346         PROCEDURE PasteView* (view: Views.View; w, h: INTEGER; clipboard: BOOLEAN);
 347                 VAR msg: EditMsg;
 348         BEGIN
 349                 ASSERT(view # NIL, 20);
 350                 msg.op := paste; msg.isSingle := TRUE;
 351                 msg.clipboard := clipboard;
 352                 msg.view := view; msg.w := w; msg.h := h;
 353                 Forward(msg)
 354         END PasteView;
 355
 356
 357         PROCEDURE FocusFrame* (): Views.Frame;
 358                 VAR msg: PollFocusMsg;
 359         BEGIN
 360                 msg.focus := NIL; Forward(msg); RETURN msg.focus
 361         END FocusFrame;
 362
 363         PROCEDURE FocusView* (): Views.View;
 364                 VAR focus: Views.Frame;
 365         BEGIN
 366                 focus := FocusFrame();
 367                 IF focus # NIL THEN RETURN focus.view ELSE RETURN NIL END
 368         END FocusView;
 369
 370         PROCEDURE FocusModel* (): Models.Model;
 371                 VAR focus: Views.Frame;
 372         BEGIN
 373                 focus := FocusFrame();
 374                 IF focus # NIL THEN RETURN focus.view.ThisModel() ELSE RETURN NIL END
 375         END FocusModel;
 376
 377
 378         PROCEDURE HandleCtrlMsgs (op: INTEGER; f, g: Views.Frame; VAR msg: Message; VAR mark, front, req: BOOLEAN);
 379         (* g = f.up OR g = NIL *)
 380                 CONST pre = 0; translate = 1; backoff = 2; final = 3;
 381         BEGIN
 382                 CASE op OF
 383                   pre:
 384                         WITH msg: MarkMsg DO
 385                                 IF msg.show & (g # NIL) THEN mark := TRUE; front := g.front END
 386                         | msg: RequestMessage DO
 387                                 msg.requestFocus := FALSE
 388                         ELSE
 389                         END
 390                 | translate:
 391                         WITH msg: CursorMessage DO
 392                                 msg.x := msg.x + f.gx - g.gx;
 393                                 msg.y := msg.y + f.gy - g.gy
 394                         ELSE
 395                         END
 396                 | backoff:
 397                         WITH msg: MarkMsg DO
 398                                 IF ~msg.show THEN mark := FALSE; front := FALSE END
 399                         | msg: RequestMessage DO
 400                                 req := msg.requestFocus
 401                         ELSE
 402                         END
 403                 | final:
 404                         WITH msg: PollFocusMsg DO
 405                                 IF msg.focus = NIL THEN msg.focus := f END
 406                         | msg: MarkMsg DO
 407                                 IF ~msg.show THEN mark := FALSE; front := FALSE END
 408                         | msg: RequestMessage DO
 409                                 req := msg.requestFocus
 410                         ELSE
 411                         END
 412                 END
 413         END HandleCtrlMsgs;
 414
 415
 416         PROCEDURE Init;
 417                 VAR action: BalanceCheckAction; w: WaitAction;
 418         BEGIN
 419                 Views.InitCtrl(HandleCtrlMsgs);
 420                 NEW(cleaner);
 421                 NEW(action); NEW(w); action.wait := w; w.check := action; Services.DoLater(action, Services.immediately);
 422         END Init;
 423
 424 BEGIN
 425         Init
 426 END Controllers.