Trurl-based/Dev/Mod/Commanders.txt

   1 MODULE DevCommanders;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Commanders.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT
   7                 Kernel, Fonts, Ports, Stores, Models, Views, Controllers, Properties, Dialog, Controls,
   8                 TextModels, TextSetters, TextMappers, Services, StdLog;
   9
  10         CONST
  11                 (* additional Scan types *)
  12                 ident = 19; qualident = 20; execMark = 21;
  13
  14                 point = Ports.point;
  15
  16                 minVersion = 0; maxVersion = 0; maxStdVersion = 0;
  17
  18
  19         TYPE
  20                 View* = POINTER TO ABSTRACT RECORD (Views.View)
  21                 END;
  22                 EndView* = POINTER TO ABSTRACT RECORD (Views.View)
  23                 END;
  24
  25                 Par* = POINTER TO RECORD
  26                         text*: TextModels.Model;
  27                         beg*, end*: INTEGER
  28                 END;
  29
  30                 Directory* = POINTER TO ABSTRACT RECORD END;
  31
  32
  33                 StdView = POINTER TO RECORD (View) END;
  34                 StdEndView = POINTER TO RECORD (EndView) END;
  35
  36                 StdDirectory = POINTER TO RECORD (Directory) END;
  37
  38                 Scanner = RECORD
  39                         s: TextMappers.Scanner;
  40                         ident: ARRAY LEN(Kernel.Name) OF CHAR;
  41                         qualident: ARRAY LEN(Kernel.Name) * 2 - 1 OF CHAR
  42                 END;
  43
  44                 TrapCleaner = POINTER TO RECORD (Kernel.TrapCleaner) END;
  45
  46         VAR
  47                 par*: Par;
  48                 dir-, stdDir-: Directory;
  49
  50                 cleaner: TrapCleaner;
  51                 cleanerInstalled: BOOLEAN;
  52
  53
  54         (** Cleaner **)
  55
  56         PROCEDURE (c: TrapCleaner) Cleanup;
  57         BEGIN
  58                 par := NIL;
  59                 cleanerInstalled := FALSE;
  60         END Cleanup;
  61
  62         (** View **)
  63
  64         PROCEDURE (v: View) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
  65         BEGIN
  66                 v.Externalize^(wr);
  67                 wr.WriteVersion(maxVersion);
  68                 wr.WriteXInt(execMark)
  69         END Externalize;
  70
  71         PROCEDURE (v: View) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
  72                 VAR thisVersion, type: INTEGER;
  73         BEGIN
  74                 v.Internalize^(rd);
  75                 IF rd.cancelled THEN RETURN END;
  76                 rd.ReadVersion(minVersion, maxVersion, thisVersion);
  77                 IF rd.cancelled THEN RETURN END;
  78                 rd.ReadXInt(type)
  79         END Internalize;
  80
  81
  82         (** Directory **)
  83
  84         PROCEDURE (d: Directory) New* (): View, NEW, ABSTRACT;
  85         PROCEDURE (d: Directory) NewEnd* (): EndView, NEW, ABSTRACT;
  86
  87
  88         (* auxilliary procedures *)
  89
  90         PROCEDURE IsIdent (VAR s: ARRAY OF CHAR): BOOLEAN;
  91                 VAR i: INTEGER; ch: CHAR;
  92         BEGIN
  93                 ch := s[0]; i := 1;
  94                 IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
  95                         REPEAT
  96                                 ch := s[i]; INC(i)
  97                         UNTIL ~( ("0" <= ch) & (ch <= "9") OR ("A" <= CAP(ch)) & (CAP(ch) <= "Z")
  98                                                 OR (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") );
  99                         RETURN (ch = 0X) & (i <= LEN(Kernel.Name))
 100                 ELSE
 101                         RETURN FALSE
 102                 END
 103         END IsIdent;
 104
 105         PROCEDURE Scan (VAR s: Scanner);
 106                 VAR done: BOOLEAN;
 107         BEGIN
 108                 s.s.Scan;
 109                 IF (s.s.type = TextMappers.view) THEN
 110                         IF Properties.ThisType(s.s.view, "DevCommanders.View") # NIL THEN s.s.type := execMark END
 111                 ELSIF (s.s.type = TextMappers.string) & TextMappers.IsQualIdent(s.s.string) THEN
 112                         s.s.type := qualident; s.qualident := s.s.string$
 113                 ELSIF (s.s.type = TextMappers.string) & IsIdent(s.s.string) THEN
 114                         s.ident := s.s.string$;
 115                         TextMappers.ScanQualIdent(s.s, s.qualident, done);
 116                         IF done THEN s.s.type := qualident ELSE s.s.type := ident END
 117                 END
 118         END Scan;
 119
 120         PROCEDURE GetParExtend (r: TextModels.Reader; VAR end: INTEGER);
 121                 VAR v, v1: Views.View;
 122         BEGIN
 123                 REPEAT r.ReadView(v);
 124                         IF v # NIL THEN
 125                                 v1 := v;
 126                                 v := Properties.ThisType(v1, "DevCommanders.View") ;
 127                                 IF v = NIL THEN v := Properties.ThisType(v1, "DevCommanders.EndView")  END
 128                         END
 129                 UNTIL r.eot OR (v # NIL);
 130                 end := r.Pos(); IF ~r.eot THEN DEC(end) END
 131         END GetParExtend;
 132
 133         PROCEDURE Unload (cmd: Dialog.String);
 134                 VAR modname: Kernel.Name; str: Dialog.String; i: INTEGER; ch: CHAR; mod: Kernel.Module;
 135         BEGIN
 136                 i := 0; ch := cmd[0];
 137                 WHILE (ch # 0X) & (ch # ".") DO modname[i] := SHORT(ch); INC(i); ch := cmd[i] END;
 138                 modname[i] := 0X;
 139                 mod := Kernel.ThisLoadedMod(modname);
 140                 IF mod # NIL THEN
 141                         Kernel.UnloadMod(mod);
 142                         IF mod.refcnt < 0 THEN
 143                                 str := modname$;
 144                                 Dialog.MapParamString("#Dev:Unloaded", str, "", "", str);
 145                                 StdLog.String(str); StdLog.Ln;
 146                                 Controls.Relink
 147                         ELSE
 148                                 str := modname$;
 149                                 Dialog.ShowParamMsg("#Dev:UnloadingFailed", str, "", "")
 150                         END
 151                 END
 152         END Unload;
 153
 154         PROCEDURE Execute (t: TextModels.Model; pos: INTEGER; VAR end: INTEGER; unload: BOOLEAN);
 155                 VAR s: Scanner; beg, res: INTEGER; cmd: Dialog.String;
 156         BEGIN
 157                 end := t.Length();
 158                 s.s.ConnectTo(t); s.s.SetPos(pos); s.s.SetOpts({TextMappers.returnViews});
 159                 Scan(s); ASSERT(s.s.type = execMark, 100);
 160                 Scan(s);
 161                 IF s.s.type IN {qualident, TextMappers.string} THEN
 162                         beg := s.s.Pos() - 1; GetParExtend(s.s.rider, end);
 163                         ASSERT(~cleanerInstalled, 101);
 164                         Kernel.PushTrapCleaner(cleaner); cleanerInstalled := TRUE;
 165                         NEW(par); par.text := t; par.beg := beg; par.end := end;
 166                         IF s.s.type = qualident THEN cmd := s.qualident$ ELSE cmd := s.s.string$ END;
 167                         IF unload (* & (s.s.type = qualident)*) THEN Unload(cmd) END;
 168                         Dialog.Call(cmd, " ",  res);
 169                         par := NIL;
 170                         Kernel.PopTrapCleaner(cleaner); cleanerInstalled := FALSE;
 171                 END
 172         END Execute;
 173
 174         PROCEDURE Track (v: View; f: Views.Frame; x, y: INTEGER; buttons: SET);
 175                 VAR c: Models.Context; w, h, end: INTEGER; isDown, in, in0: BOOLEAN; m: SET;
 176         BEGIN
 177                 c := v.context; c.GetSize(w, h); in0 := FALSE; in := TRUE;
 178                 REPEAT
 179                         IF in # in0 THEN
 180                                 f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.show); in0 := in
 181                         END;
 182                         f.Input(x, y, m, isDown);
 183                         in := (0 <= x) & (x < w) & (0 <= y) & (y < h)
 184                 UNTIL ~isDown;
 185                 IF in0 THEN
 186                         f.MarkRect(0, 0, w, h, Ports.fill, Ports.invert, Ports.hide);
 187                         WITH c:TextModels.Context DO
 188                                 Execute(c.ThisModel(), c.Pos(), end,Controllers.modify IN buttons)
 189                         ELSE Dialog.Beep
 190                         END
 191                 END
 192         END Track;
 193
 194         (* StdView *)
 195
 196         PROCEDURE (v: StdView) Externalize (VAR wr: Stores.Writer);
 197         BEGIN
 198                 v.Externalize^(wr);
 199                 wr.WriteVersion(maxStdVersion)
 200         END Externalize;
 201
 202         PROCEDURE (v: StdView) Internalize (VAR rd: Stores.Reader);
 203                 VAR thisVersion: INTEGER;
 204         BEGIN
 205                 v.Internalize^(rd);
 206                 IF rd.cancelled THEN RETURN END;
 207                 rd.ReadVersion(minVersion, maxStdVersion, thisVersion)
 208         END Internalize;
 209
 210         PROCEDURE (v: StdView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
 211                 CONST u = point;
 212                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
 213                         size, d, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
 214         BEGIN
 215                 ASSERT(v.context # NIL, 20);
 216                 c := v.context;
 217                 WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
 218                 ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
 219                 END;
 220                 font.GetBounds(asc, dsc, fw);
 221                 size := asc + dsc; d := size DIV 2;
 222                 f.DrawOval(u, 0, u + size, size, Ports.fill, color);
 223                 s := "!";
 224                 w := font.StringWidth(s);
 225                 f.DrawString(u + d - w DIV 2, size - dsc, Ports.background, s, font)
 226         END Restore;
 227
 228         PROCEDURE (v: StdView) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
 229                                                                                                                                                 VAR focus: Views.View);
 230         BEGIN
 231                 WITH msg: Controllers.TrackMsg DO
 232                         Track(v, f, msg.x, msg.y, msg.modifiers)
 233                 | msg: Controllers.PollCursorMsg DO
 234                         msg.cursor := Ports.refCursor
 235                 ELSE
 236                 END
 237         END HandleCtrlMsg;
 238
 239         PROCEDURE (v: StdView) HandlePropMsg (VAR msg: Properties.Message);
 240                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
 241         BEGIN
 242                 WITH msg: Properties.Preference DO
 243                         WITH msg: Properties.SizePref DO
 244                                 c := v.context;
 245                                 IF (c # NIL) & (c IS TextModels.Context) THEN
 246                                         a := c(TextModels.Context).Attr(); font := a.font
 247                                 ELSE font := Fonts.dir.Default()
 248                                 END;
 249                                 font.GetBounds(asc, dsc, fw);
 250                                 msg.h := asc + dsc; msg.w := msg.h + 2 * point
 251                         | msg: Properties.ResizePref DO
 252                                 msg.fixed := TRUE
 253                         | msg: Properties.FocusPref DO
 254                                 msg.hotFocus := TRUE
 255                         | msg: TextSetters.Pref DO
 256                                 c := v.context;
 257                                 IF (c # NIL) & (c IS TextModels.Context) THEN
 258                                         a := c(TextModels.Context).Attr(); font := a.font
 259                                 ELSE font := Fonts.dir.Default()
 260                                 END;
 261                                 font.GetBounds(asc, msg.dsc, fw)
 262                         | msg: Properties.TypePref DO
 263                                 IF Services.Is(v, msg.type) THEN msg.view := v END
 264                         ELSE
 265                         END
 266                 ELSE
 267                 END
 268         END HandlePropMsg;
 269
 270
 271         (* StdEndView *)
 272
 273         PROCEDURE (v: StdEndView) Restore (f: Views.Frame; l, t, r, b: INTEGER);
 274                 CONST u = point;
 275                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; color: Ports.Color;
 276                         size, w, asc, dsc, fw: INTEGER; s: ARRAY 2 OF CHAR;
 277                         points: ARRAY 3 OF Ports.Point;
 278         BEGIN
 279                 ASSERT(v.context # NIL, 20);
 280                 c := v.context;
 281                 WITH c: TextModels.Context DO a := c.Attr(); font := a.font; color := a.color
 282                 ELSE font := Fonts.dir.Default(); color := Ports.defaultColor
 283                 END;
 284                 font.GetBounds(asc, dsc, fw);
 285                 size := asc + dsc;
 286                 points[0].x := 0; points[0].y := size;
 287                 points[1].x := u + (size DIV 2); points[1].y := size DIV 2;
 288                 points[2].x := u + (size DIV 2); points[2].y := size;
 289                 f.DrawPath(points, 3, Ports.fill, color, Ports.closedPoly)
 290         END Restore;
 291
 292         PROCEDURE (v: StdEndView) HandlePropMsg (VAR msg: Properties.Message);
 293                 VAR c: Models.Context; a: TextModels.Attributes; font: Fonts.Font; asc, dsc, fw: INTEGER;
 294         BEGIN
 295                 WITH msg: Properties.Preference DO
 296                         WITH msg: Properties.SizePref DO
 297                                 c := v.context;
 298                                 IF (c # NIL) & (c IS TextModels.Context) THEN
 299                                         a := c(TextModels.Context).Attr(); font := a.font
 300                                 ELSE font := Fonts.dir.Default()
 301                                 END;
 302                                 font.GetBounds(asc, dsc, fw);
 303                                 msg.h := asc + dsc; msg.w := (msg.h + 2 * point) DIV 2
 304                         | msg: Properties.ResizePref DO
 305                                 msg.fixed := TRUE
 306                         | msg: Properties.FocusPref DO
 307                                 msg.hotFocus := TRUE
 308                         | msg: TextSetters.Pref DO
 309                                 c := v.context;
 310                                 IF (c # NIL) & (c IS TextModels.Context) THEN
 311                                         a := c(TextModels.Context).Attr(); font := a.font
 312                                 ELSE font := Fonts.dir.Default()
 313                                 END;
 314                                 font.GetBounds(asc, msg.dsc, fw)
 315                         | msg: Properties.TypePref DO
 316                                 IF Services.Is(v, msg.type) THEN msg.view := v END
 317                         ELSE
 318                         END
 319                 ELSE
 320                 END
 321         END HandlePropMsg;
 322
 323         (* StdDirectory *)
 324
 325         PROCEDURE (d: StdDirectory) New (): View;
 326                 VAR v: StdView;
 327         BEGIN
 328                 NEW(v); RETURN v
 329         END New;
 330
 331         PROCEDURE (d: StdDirectory) NewEnd (): EndView;
 332                 VAR v: StdEndView;
 333         BEGIN
 334                 NEW(v); RETURN v
 335         END NewEnd;
 336
 337         PROCEDURE Deposit*;
 338         BEGIN
 339                 Views.Deposit(dir.New())
 340         END Deposit;
 341
 342         PROCEDURE DepositEnd*;
 343         BEGIN
 344                 Views.Deposit(dir.NewEnd())
 345         END DepositEnd;
 346
 347         PROCEDURE SetDir* (d: Directory);
 348         BEGIN
 349                 dir := d
 350         END SetDir;
 351
 352         PROCEDURE Init;
 353                 VAR d: StdDirectory;
 354         BEGIN
 355                 NEW(d); dir := d; stdDir := d;
 356                 NEW(cleaner); cleanerInstalled := FALSE;
 357         END Init;
 358
 359 BEGIN
 360         Init
 361 END DevCommanders.