Trurl-based/Text/Mod/Rulers.txt

   1 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Text/Mod/Rulers.odc *)
   2 (* DO NOT EDIT *)
   3
   4 MODULE TextRulers;
   5
   6 (**
   7         project = "BlackBox"
   8         organization    = "www.oberon.ch"
   9         contributors    = "Oberon microsystems"
  10         version = "System/Rsrc/About"
  11         copyright       = "System/Rsrc/About"
  12         license = "Docu/BB-License"
  13         changes = ""
  14         issues  = ""
  15
  16 **)
  17
  18         (* re-check alien attributes: consider projection semantics *)
  19
  20         IMPORT
  21                 Kernel, Strings, Services, Fonts, Ports, Stores,
  22                 Models, Views, Controllers, Properties, Dialog,
  23                 TextModels;
  24
  25         CONST
  26                 (** Attributes.valid, Prop.known/valid **)      (* Mark.kind *)
  27                 first* = 0; left* = 1; right* = 2; lead* = 3; asc* = 4; dsc* = 5; grid* = 6;
  28                 opts* = 7; tabs* = 8;
  29                 (* additional values for icons held by Mark.kind *)
  30                 invalid = -1;
  31                 firstIcon = 10; lastIcon = 25;
  32                 rightToggle = 10;
  33                 gridDec = 12; gridVal = 13; gridInc = 14;
  34                 leftFlush = 16; centered = 17; rightFlush = 18; justified = 19;
  35                 leadDec = 21; leadVal = 22; leadInc = 23;
  36                 pageBrk = 25;
  37
  38                 modeIcons = {leftFlush .. justified};
  39                 validIcons = {rightToggle, gridDec .. gridInc, leftFlush .. justified, leadDec .. leadInc, pageBrk};
  40                 fieldIcons = {gridVal, leadVal};
  41
  42                 (** Attributes.opts **)
  43                 leftAdjust* = 0; rightAdjust* = 1;
  44                                 (** both: fully justified; none: centered **)
  45                 noBreakInside* = 2; pageBreak* = 3; parJoin* = 4;
  46                                 (** pageBreak of this ruler overrides parJoin request of previous ruler **)
  47                 rightFixed* = 5;        (** has fixed right border **)
  48
  49                 options = {leftAdjust .. rightFixed};   (* options mask *)
  50                 adjMask = {leftAdjust, rightAdjust};
  51
  52                 (** Attributes.tabType[i] **)
  53                 maxTabs* = 32;
  54                 centerTab* = 0; rightTab* = 1;
  55                         (** both: (reserved); none: leftTab **)
  56                 barTab* = 2;
  57
  58                 tabOptions = {centerTab .. barTab};     (* mask for presently valid options *)
  59
  60                 mm = Ports.mm; inch16 = Ports.inch DIV 16; point = Ports.point;
  61                 tabBarHeight = 11 * point; scaleHeight = 10 * point; iconBarHeight = 14 * point;
  62                 rulerHeight = tabBarHeight + scaleHeight + iconBarHeight;
  63                 iconHeight = 10 * point; iconWidth = 12 * point; iconGap = 2 * point;
  64                 iconPin = rulerHeight - (iconBarHeight - iconHeight) DIV 2;
  65
  66                 rulerChangeKey = "#Text:RulerChange";
  67
  68                 minVersion = 0;
  69                 maxAttrVersion = 2; maxStyleVersion = 0; maxStdStyleVersion = 0;
  70                 maxRulerVersion = 0; maxStdRulerVersion = 0;
  71
  72
  73         TYPE
  74                 Tab* = RECORD
  75                         stop*: INTEGER;
  76                         type*: SET
  77                 END;
  78
  79                 TabArray* = RECORD      (* should be POINTER TO ARRAY OF Tab -- but cannot protect *)
  80                         len*: INTEGER;
  81                         tab*: ARRAY maxTabs OF Tab
  82                 END;
  83
  84                 Attributes* = POINTER TO EXTENSIBLE RECORD (Stores.Store)
  85                         init-: BOOLEAN; (* immutable once init holds *)
  86                         first-, left-, right-, lead-, asc-, dsc-, grid-: INTEGER;
  87                         opts-: SET;
  88                         tabs-: TabArray
  89                 END;
  90
  91                 AlienAttributes* = POINTER TO RECORD (Attributes)
  92                         store-: Stores.Alien
  93                 END;
  94
  95                 Style* = POINTER TO ABSTRACT RECORD (Models.Model)
  96                         attr-: Attributes
  97                 END;
  98
  99                 Ruler* = POINTER TO ABSTRACT RECORD (Views.View)
 100                         style-: Style
 101                 END;
 102
 103
 104                 Prop* = POINTER TO RECORD (Properties.Property)
 105                         first*, left*, right*, lead*, asc*, dsc*, grid*: INTEGER;
 106                         opts*: RECORD val*, mask*: SET END;
 107                         tabs*: TabArray
 108                 END;
 109
 110
 111                 UpdateMsg* = RECORD (Models.UpdateMsg)
 112                         (** domaincast upon style update **)
 113                         style*: Style;
 114                         oldAttr*: Attributes
 115                 END;
 116
 117
 118                 Directory* = POINTER TO ABSTRACT RECORD
 119                         attr-: Attributes
 120                 END;
 121
 122
 123                 StdStyle = POINTER TO RECORD (Style) END;
 124
 125                 StdRuler = POINTER TO RECORD (Ruler)
 126                         sel: INTEGER;   (* sel # invalid => sel = kind of selected mark *)
 127                         px, py: INTEGER (* sel # invalid => px, py of selected mark *)
 128                 END;
 129
 130                 StdDirectory = POINTER TO RECORD (Directory) END;
 131
 132                 Mark = RECORD
 133                         ruler: StdRuler;
 134                         l, r, t, b: INTEGER;
 135                         px, py, px0, py0, x, y: INTEGER;
 136                         kind, index: INTEGER;
 137                         type: SET;      (* valid if kind = tabs *)
 138                         tabs: TabArray; (* if valid: tabs[index].type = type *)
 139                         dirty: BOOLEAN
 140                 END;
 141
 142                 SetAttrOp = POINTER TO RECORD (Stores.Operation)
 143                         style: Style;
 144                         attr: Attributes
 145                 END;
 146
 147                 NeutralizeMsg = RECORD (Views.Message) END;
 148
 149
 150         VAR
 151                 dir-, stdDir-: Directory;
 152
 153                 def: Attributes;
 154                 prop: Prop;     (* recycled *)
 155                 globRd: TextModels.Reader;      (* cache for temp reader; beware of reentrance *)
 156                 font: Fonts.Font;
 157
 158                 marginGrid, minTabWidth, tabGrid: INTEGER;
 159
 160
 161         PROCEDURE ^ DoSetAttrOp (s: Style; attr: Attributes);
 162
 163         PROCEDURE CopyTabs (IN src: TabArray; OUT dst: TabArray);
 164         (* a TabArray is a 256 byte structure - copying of used parts is much faster than ":= all" *)
 165                 VAR i, n: INTEGER;
 166         BEGIN
 167                 n := src.len; dst.len := n;
 168                 i := 0; WHILE i < n DO dst.tab[i] := src.tab[i]; INC(i) END
 169         END CopyTabs;
 170
 171
 172         (** Attributes **)
 173
 174         PROCEDURE (a: Attributes) CopyFrom- (source: Stores.Store), EXTENSIBLE;
 175         BEGIN
 176                 WITH source: Attributes DO
 177                         ASSERT(~a.init, 20); ASSERT(source.init, 21);
 178                         a.init := TRUE;
 179                         a.first := source.first; a.left := source.left; a.right := source.right;
 180                         a.lead := source.lead; a.asc := source.asc; a.dsc := source.dsc; a.grid := source.grid;
 181                         a.opts := source.opts;
 182                         CopyTabs(source.tabs, a.tabs)
 183                 END
 184         END CopyFrom;
 185
 186         PROCEDURE (a: Attributes) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
 187         (** pre: a.init **)
 188                 VAR i: INTEGER; typedTabs: BOOLEAN;
 189         BEGIN
 190                 ASSERT(a.init, 20);
 191                 a.Externalize^(wr);
 192                 i := 0; WHILE (i < a.tabs.len) & (a.tabs.tab[i].type = {}) DO INC(i) END;
 193                 typedTabs := i < a.tabs.len;
 194                 IF typedTabs THEN
 195                         wr.WriteVersion(maxAttrVersion)
 196                 ELSE
 197                         wr.WriteVersion(1)      (* versions before 2 had only leftTabs *)
 198                 END;
 199                 wr.WriteInt(a.first); wr.WriteInt(a.left); wr.WriteInt(a.right);
 200                 wr.WriteInt(a.lead); wr.WriteInt(a.asc); wr.WriteInt(a.dsc); wr.WriteInt(a.grid);
 201                 wr.WriteSet(a.opts);
 202                 wr.WriteXInt(a.tabs.len);
 203                 i := 0; WHILE i < a.tabs.len DO wr.WriteInt(a.tabs.tab[i].stop); INC(i) END;
 204                 IF typedTabs THEN
 205                         i := 0; WHILE i < a.tabs.len DO wr.WriteSet(a.tabs.tab[i].type); INC(i) END
 206                 END
 207         END Externalize;
 208
 209         PROCEDURE (a: Attributes) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
 210         (** pre: ~a.init **)
 211         (** post: a.init **)
 212                 VAR thisVersion, i, n, trash: INTEGER; trashSet: SET;
 213         BEGIN
 214                 ASSERT(~a.init, 20); a.init := TRUE;
 215                 a.Internalize^(rd);
 216                 IF rd.cancelled THEN RETURN END;
 217                 rd.ReadVersion(minVersion, maxAttrVersion, thisVersion);
 218                 IF rd.cancelled THEN RETURN END;
 219                 rd.ReadInt(a.first); rd.ReadInt(a.left); rd.ReadInt(a.right);
 220                 rd.ReadInt(a.lead); rd.ReadInt(a.asc); rd.ReadInt(a.dsc); rd.ReadInt(a.grid);
 221                 rd.ReadSet(a.opts);
 222                 rd.ReadXInt(n); a.tabs.len := MIN(n, maxTabs);
 223                 i := 0; WHILE i < a.tabs.len DO rd.ReadInt(a.tabs.tab[i].stop); INC(i) END;
 224                 WHILE i < n DO rd.ReadInt(trash); INC(i) END;
 225                 IF thisVersion = 0 THEN (* convert from v0 rightFixed to v1 ~rightFixed default *)
 226                         INCL(a.opts, rightFixed)
 227                 END;
 228                 IF thisVersion >= 2 THEN
 229                         i := 0; WHILE i < a.tabs.len DO rd.ReadSet(a.tabs.tab[i].type); INC(i) END;
 230                         WHILE i < n DO rd.ReadSet(trashSet); INC(i) END
 231                 ELSE
 232                         i := 0; WHILE i < a.tabs.len DO a.tabs.tab[i].type := {}; INC(i) END
 233                 END
 234         END Internalize;
 235
 236         PROCEDURE Set (p: Prop; opt: INTEGER; VAR x: INTEGER; min, max, new: INTEGER);
 237         BEGIN
 238                 IF opt IN p.valid THEN x := MAX(min, MIN(max, new)) END
 239         END Set;
 240
 241         PROCEDURE ModifyFromProp (a: Attributes; p: Properties.Property);
 242                 CONST maxW = 10000*mm; maxH = 32767 * point;
 243                 VAR i: INTEGER; type, mask: SET;
 244         BEGIN
 245                 WHILE p # NIL DO
 246                         WITH p: Prop DO
 247                                 Set(p, first, a.first, 0, maxW, p.first);
 248                                 Set(p, left, a.left, 0, maxW, p.left);
 249                                 Set(p, right, a.right, MAX(a.left, a.first), maxW, p.right);
 250                                 Set(p, lead, a.lead, 0, maxH, p.lead);
 251                                 Set(p, asc, a.asc, 0, maxH, p.asc);
 252                                 Set(p, dsc, a.dsc, 0, maxH - a.asc, p.dsc);
 253                                 Set(p, grid, a.grid, 1, maxH, p.grid);
 254                                 IF opts IN p.valid THEN
 255                                         a.opts := a.opts * (-p.opts.mask) + p.opts.val * p.opts.mask
 256                                 END;
 257                                 IF (tabs IN p.valid) & (p.tabs.len >= 0) THEN
 258                                         IF (p.tabs.len > 0) & (p.tabs.tab[0].stop >= 0) THEN
 259                                                 i := 0; a.tabs.len := MIN(p.tabs.len, maxTabs);
 260                                                 REPEAT
 261                                                         a.tabs.tab[i].stop := p.tabs.tab[i].stop;
 262                                                         type := p.tabs.tab[i].type; mask := tabOptions;
 263                                                         IF type * {centerTab, rightTab} = {centerTab, rightTab} THEN
 264                                                                 mask := mask - {centerTab, rightTab}
 265                                                         END;
 266                                                         a.tabs.tab[i].type := a.tabs.tab[i].type * (-mask) + type * mask;
 267                                                         INC(i)
 268                                                 UNTIL (i = a.tabs.len) OR (p.tabs.tab[i].stop < p.tabs.tab[i - 1].stop);
 269                                                 a.tabs.len := i
 270                                         ELSE a.tabs.len := 0
 271                                         END
 272                                 END
 273                         ELSE
 274                         END;
 275                         p := p.next
 276                 END
 277         END ModifyFromProp;
 278
 279         PROCEDURE (a: Attributes) ModifyFromProp- (p: Properties.Property), NEW, EXTENSIBLE;
 280         BEGIN
 281                 ModifyFromProp(a, p)
 282         END ModifyFromProp;
 283
 284         PROCEDURE (a: Attributes) InitFromProp* (p: Properties.Property), NEW, EXTENSIBLE;
 285         (** pre: ~a.init **)
 286         (** post: (a.init, p # NIL & x IN p.valid) => x set in a, else x defaults in a **)
 287         BEGIN
 288                 ASSERT(~a.init, 20);
 289                 a.init := TRUE;
 290                 a.first := def.first; a.left := def.left; a.right := def.right;
 291                 a.lead := def.lead; a.asc := def.asc; a.dsc := def.dsc; a.grid := def.grid;
 292                 a.opts := def.opts;
 293                 CopyTabs(def.tabs, a.tabs);
 294                 ModifyFromProp(a, p)
 295         END InitFromProp;
 296
 297         PROCEDURE (a: Attributes) Equals* (b: Attributes): BOOLEAN, NEW, EXTENSIBLE;
 298         (** pre: a.init, b.init **)
 299                 VAR i: INTEGER;
 300         BEGIN
 301                 ASSERT(a.init, 20); ASSERT(b.init, 21);
 302                 IF a # b THEN
 303                         i := 0;
 304                         WHILE (i < a.tabs.len)
 305                          & (a.tabs.tab[i].stop = b.tabs.tab[i].stop)
 306                          & (a.tabs.tab[i].type = b.tabs.tab[i].type) DO
 307                                 INC(i)
 308                         END;
 309                         RETURN (Services.SameType(a, b))
 310                                 & (a.first = b.first) & (a.left = b.left) & (a.right = b.right)
 311                                 & (a.lead = b.lead) & (a.asc = b.asc) & (a.dsc = b.dsc) & (a.grid = b.grid)
 312                                 & (a.opts = b.opts) & (a.tabs.len = b.tabs.len) & (i = a.tabs.len)
 313                 ELSE RETURN TRUE
 314                 END
 315         END Equals;
 316
 317         PROCEDURE (a: Attributes) Prop* (): Properties.Property, NEW, EXTENSIBLE;
 318         (** pre: a.init **)
 319         (** post: x attr in a => x IN p.valid, m set to value of attr in a **)
 320                 VAR p: Prop;
 321         BEGIN
 322                 ASSERT(a.init, 20);
 323                 NEW(p);
 324                 p.known := {first .. tabs}; p.valid := p.known;
 325                 p.first := a.first; p.left := a.left; p.right := a.right;
 326                 p.lead := a.lead; p.asc := a.asc; p.dsc := a.dsc; p.grid := a.grid;
 327                 p.opts.val := a.opts; p.opts.mask := options;
 328                 CopyTabs(a.tabs, p.tabs);
 329                 RETURN p
 330         END Prop;
 331
 332
 333         PROCEDURE ReadAttr* (VAR rd: Stores.Reader; OUT a: Attributes);
 334                 VAR st: Stores.Store; alien: AlienAttributes;
 335         BEGIN
 336                 rd.ReadStore(st);
 337                 ASSERT(st # NIL, 100);
 338                 IF st IS Stores.Alien THEN
 339                         NEW(alien); alien.store := st(Stores.Alien); Stores.Join(alien, alien.store);
 340                         alien.InitFromProp(NIL); a := alien
 341                 ELSE a := st(Attributes)
 342                 END
 343         END ReadAttr;
 344
 345         PROCEDURE WriteAttr* (VAR wr: Stores.Writer; a: Attributes);
 346         BEGIN
 347                 ASSERT(a # NIL, 20); ASSERT(a.init, 21);
 348                 WITH a: AlienAttributes DO wr.WriteStore(a.store) ELSE wr.WriteStore(a) END
 349         END WriteAttr;
 350
 351         PROCEDURE ModifiedAttr* (a: Attributes; p: Properties.Property): Attributes;
 352         (** pre: a.init **)
 353         (** post: x IN p.valid => x in new attr set to value in p, else set to value in a **)
 354                 VAR h: Attributes;
 355         BEGIN
 356                 ASSERT(a.init, 20);
 357                 h := Stores.CopyOf(a)(Attributes); h.ModifyFromProp(p);
 358                 RETURN h
 359         END ModifiedAttr;
 360
 361
 362         (** AlienAttributes **)
 363
 364         PROCEDURE (a: AlienAttributes) Externalize- (VAR wr: Stores.Writer);
 365         BEGIN
 366                 HALT(100)
 367         END Externalize;
 368
 369         PROCEDURE (a: AlienAttributes) Internalize- (VAR rd: Stores.Reader);
 370         BEGIN
 371                 HALT(100)
 372         END Internalize;
 373
 374         PROCEDURE (a: AlienAttributes) InitFromProp* (p: Properties.Property);
 375         BEGIN
 376                 a.InitFromProp^(NIL)
 377         END InitFromProp;
 378
 379         PROCEDURE (a: AlienAttributes) ModifyFromProp- (p: Properties.Property);
 380         BEGIN
 381                 (* a.InitFromProp^(NIL) *)
 382                 a.InitFromProp(NIL)
 383         END ModifyFromProp;
 384
 385
 386         (** Style **)
 387
 388 (*
 389         PROCEDURE (s: Style) PropagateDomain-, EXTENSIBLE;
 390                 VAR dom: Stores.Domain;
 391         BEGIN
 392                 ASSERT(s.attr # NIL, 20);
 393                 dom := s.attr.Domain();
 394                 IF (dom # NIL) & (dom # s.Domain()) THEN s.attr := Stores.CopyOf(s.attr)(Attributes) END;
 395                 Stores.InitDomain(s.attr, s.Domain())
 396         END PropagateDomain;
 397 *)
 398
 399         PROCEDURE (s: Style) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
 400         BEGIN
 401                 s.Externalize^(wr);
 402                 wr.WriteVersion(maxStyleVersion);
 403                 WriteAttr(wr, s.attr)
 404         END Externalize;
 405
 406         PROCEDURE (s: Style) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
 407                 VAR thisVersion: INTEGER;
 408         BEGIN
 409                 s.Internalize^(rd);
 410                 IF rd.cancelled THEN RETURN END;
 411                 rd.ReadVersion(minVersion, maxStyleVersion, thisVersion);
 412                 IF rd.cancelled THEN RETURN END;
 413                 ReadAttr(rd, s.attr); Stores.Join(s, s.attr)
 414         END Internalize;
 415
 416         PROCEDURE (s: Style) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;
 417         (** pre: attr.init **)
 418         (** post: s.attr = attr OR s.attr.Equals(attr) **)
 419         BEGIN
 420                 ASSERT(attr.init, 20);
 421                 DoSetAttrOp(s, attr)
 422         END SetAttr;
 423
 424         PROCEDURE (s: Style) CopyFrom- (source: Stores.Store), EXTENSIBLE;
 425         BEGIN
 426                 WITH source: Style DO
 427                         ASSERT(source.attr # NIL, 21);
 428                         s.SetAttr(Stores.CopyOf(source.attr)(Attributes))
 429                                 (* bkwd-comp hack to avoid link *)
 430                                 (* copy would not be necessary if Attributes were immutable (and assigned to an Immutable Domain) *)
 431                 END
 432         END CopyFrom;
 433
 434 (*
 435         PROCEDURE (s: Style) InitFrom- (source: Models.Model), EXTENSIBLE;
 436         BEGIN
 437                 WITH source: Style DO
 438                         ASSERT(source.attr # NIL, 21);
 439                         s.SetAttr(Stores.CopyOf(source.attr)(Attributes))
 440                                 (* bkwd-comp hack to avoid link *)
 441                 END
 442         END InitFrom;
 443 *)
 444
 445         (** Directory **)
 446
 447         PROCEDURE (d: Directory) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;
 448         (** pre: attr.init **)
 449         (** post: d.attr = ModifiedAttr(attr, p)
 450                 [ p.valid = {opts, tabs}, p.tabs.len = 0, p.opts.mask = {noBreakInside.. parJoin}, p.opts.val = {} ]
 451         **)
 452                 VAR p: Prop;
 453         BEGIN
 454                 ASSERT(attr.init, 20);
 455                 IF attr.tabs.len > 0 THEN
 456                         NEW(p);
 457                         p.valid := {opts, tabs};
 458                         p.opts.mask := {noBreakInside, pageBreak, parJoin}; p.opts.val := {};
 459                         p.tabs.len := 0;
 460                         attr := ModifiedAttr(attr, p)
 461                 END;
 462                 d.attr := attr
 463         END SetAttr;
 464
 465         PROCEDURE (d: Directory) NewStyle* (attr: Attributes): Style, NEW, ABSTRACT;
 466         PROCEDURE (d: Directory) New* (style: Style): Ruler, NEW, ABSTRACT;
 467
 468         PROCEDURE (d: Directory) NewFromProp* (p: Prop): Ruler, NEW, EXTENSIBLE;
 469         BEGIN
 470                 RETURN d.New(d.NewStyle(ModifiedAttr(d.attr, p)))
 471         END NewFromProp;
 472
 473
 474         PROCEDURE Deposit*;
 475         BEGIN
 476                 Views.Deposit(dir.New(NIL))
 477         END Deposit;
 478
 479
 480         (** Ruler **)
 481
 482         PROCEDURE (r: Ruler) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;
 483         BEGIN
 484                 ASSERT(r.style # NIL, 20);
 485                 r.Externalize^(wr);
 486                 wr.WriteVersion(maxRulerVersion); wr.WriteStore(r.style)
 487         END Externalize;
 488
 489         PROCEDURE (r: Ruler) InitStyle* (s: Style), NEW;
 490         (** pre: r.style = NIL, s # NIL, style.attr # NIL **)
 491         (** post: r.style = s **)
 492         BEGIN
 493                 ASSERT((r.style = NIL) OR (r.style = s), 20);
 494                 ASSERT(s # NIL, 21); ASSERT(s.attr # NIL, 22);
 495                 r.style := s; Stores.Join(r, s)
 496         END InitStyle;
 497
 498
 499         PROCEDURE (r: Ruler) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;
 500                 VAR st: Stores.Store; thisVersion: INTEGER;
 501         BEGIN
 502                 r.Internalize^(rd);
 503                 IF rd.cancelled THEN RETURN END;
 504                 rd.ReadVersion(minVersion, maxRulerVersion, thisVersion);
 505                 IF rd.cancelled THEN RETURN END;
 506                 rd.ReadStore(st);
 507                 IF st IS Stores.Alien THEN rd.TurnIntoAlien(Stores.alienComponent); RETURN END;
 508                 r.InitStyle(st(Style))
 509         END Internalize;
 510
 511 (*
 512         PROCEDURE (r: Ruler) InitModel* (m: Models.Model), EXTENSIBLE;
 513         (** pre: r.style = NIL, m # NIL, style.attr # NIL, m IS Style **)
 514         (** post: r.style = m **)
 515         BEGIN
 516                 WITH m: Style DO
 517                         ASSERT((r.style = NIL) OR (r.style = m), 20);
 518                         ASSERT(m # NIL, 21); ASSERT(m.attr # NIL, 22);
 519                         r.style := m
 520                 ELSE HALT(23)
 521                 END
 522         END InitModel;
 523 *)
 524
 525 (*
 526         PROCEDURE (r: Ruler) PropagateDomain-, EXTENSIBLE;
 527         BEGIN
 528                 ASSERT(r.style # NIL, 20);
 529                 Stores.InitDomain(r.style, r.Domain())
 530         END PropagateDomain;
 531 *)
 532
 533         PROCEDURE CopyOf* (r: Ruler; shallow: BOOLEAN): Ruler;
 534                 VAR v: Views.View;
 535         BEGIN
 536                 ASSERT(r # NIL, 20);
 537                 v := Views.CopyOf(r, shallow); RETURN v(Ruler)
 538         END CopyOf;
 539
 540
 541         (** Prop **)
 542
 543         PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
 544                 VAR valid: SET;  i: INTEGER; c, m: SET; eq: BOOLEAN;
 545         BEGIN
 546                 WITH q: Prop DO
 547                         valid := p.valid * q.valid; equal := TRUE;
 548                         i := 0;
 549                         WHILE (i < p.tabs.len)
 550                         & (p.tabs.tab[i].stop = q.tabs.tab[i].stop)
 551                         & (p.tabs.tab[i].type = q.tabs.tab[i].type)
 552                         DO
 553                                 INC(i)
 554                         END;
 555                         IF p.first # q.first THEN EXCL(valid, first) END;
 556                         IF p.left # q.left THEN EXCL(valid, left) END;
 557                         IF p.right # q.right THEN EXCL(valid, right) END;
 558                         IF p.lead # q.lead THEN EXCL(valid, lead) END;
 559                         IF p.asc # q.asc THEN EXCL(valid, asc) END;
 560                         IF p.dsc # q.dsc THEN EXCL(valid, dsc) END;
 561                         IF p.grid # q.grid THEN EXCL(valid, grid) END;
 562                         Properties.IntersectSelections(p.opts.val, p.opts.mask, q.opts.val, q.opts.mask, c, m, eq);
 563                         IF m = {} THEN EXCL(valid, opts)
 564                         ELSIF (opts IN valid) & ~eq THEN p.opts.mask := m; equal := FALSE
 565                         END;
 566                         IF (p.tabs.len # q.tabs.len) OR (q.tabs.len # i) THEN EXCL(valid, tabs) END;
 567                         IF p.valid # valid THEN p.valid := valid; equal := FALSE END
 568                 END
 569         END IntersectWith;
 570
 571
 572         (** ruler construction **)
 573
 574 (*property-based facade procedures *)
 575
 576         PROCEDURE SetFirst* (r: Ruler; x: INTEGER);
 577         BEGIN
 578                 ASSERT(r.style # NIL, 20);
 579                 prop.valid := {first}; prop.first := x;
 580                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 581         END SetFirst;
 582
 583         PROCEDURE SetLeft* (r: Ruler; x: INTEGER);
 584         BEGIN
 585                 ASSERT(r.style # NIL, 20);
 586                 prop.valid := {left}; prop.left := x;
 587                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 588         END SetLeft;
 589
 590         PROCEDURE SetRight* (r: Ruler; x: INTEGER);
 591         BEGIN
 592                 ASSERT(r.style # NIL, 20);
 593                 prop.valid := {right}; prop.right := x;
 594                 prop.opts.mask := {rightFixed}; prop.opts.val := {};
 595                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 596         END SetRight;
 597
 598         PROCEDURE SetFixedRight* (r: Ruler; x: INTEGER);
 599         BEGIN
 600                 ASSERT(r.style # NIL, 20);
 601                 prop.valid := {right, opts}; prop.right := x;
 602                 prop.opts.mask := {rightFixed}; prop.opts.val := {rightFixed};
 603                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 604         END SetFixedRight;
 605
 606
 607         PROCEDURE SetLead* (r: Ruler; h: INTEGER);
 608         BEGIN
 609                 ASSERT(r.style # NIL, 20);
 610                 prop.valid := {lead}; prop.lead := h;
 611                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 612         END SetLead;
 613
 614         PROCEDURE SetAsc* (r: Ruler; h: INTEGER);
 615         BEGIN
 616                 ASSERT(r.style # NIL, 20);
 617                 prop.valid := {asc}; prop.asc := h;
 618                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 619         END SetAsc;
 620
 621         PROCEDURE SetDsc* (r: Ruler; h: INTEGER);
 622         BEGIN
 623                 ASSERT(r.style # NIL, 20);
 624                 prop.valid := {dsc}; prop.dsc := h;
 625                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 626         END SetDsc;
 627
 628         PROCEDURE SetGrid* (r: Ruler; h: INTEGER);
 629         BEGIN
 630                 ASSERT(r.style # NIL, 20);
 631                 prop.valid := {grid}; prop.grid := h;
 632                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 633         END SetGrid;
 634
 635
 636         PROCEDURE SetLeftFlush* (r: Ruler);
 637         BEGIN
 638                 ASSERT(r.style # NIL, 20);
 639                 prop.valid := {opts};
 640                 prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {leftAdjust};
 641                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 642         END SetLeftFlush;
 643
 644         PROCEDURE SetRightFlush* (r: Ruler);
 645         BEGIN
 646                 ASSERT(r.style # NIL, 20);
 647                 prop.valid := {opts};
 648                 prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {rightAdjust};
 649                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 650         END SetRightFlush;
 651
 652         PROCEDURE SetCentered* (r: Ruler);
 653         BEGIN
 654                 ASSERT(r.style # NIL, 20);
 655                 prop.valid := {opts};
 656                 prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {};
 657                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 658         END SetCentered;
 659
 660         PROCEDURE SetJustified* (r: Ruler);
 661         BEGIN
 662                 ASSERT(r.style # NIL, 20);
 663                 prop.valid := {opts};
 664                 prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {leftAdjust, rightAdjust};
 665                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 666         END SetJustified;
 667
 668
 669         PROCEDURE SetNoBreakInside* (r: Ruler);
 670         BEGIN
 671                 ASSERT(r.style # NIL, 20);
 672                 prop.valid := {opts};
 673                 prop.opts.mask := {noBreakInside}; prop.opts.val := {noBreakInside};
 674                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 675         END SetNoBreakInside;
 676
 677         PROCEDURE SetPageBreak* (r: Ruler);
 678         BEGIN
 679                 ASSERT(r.style # NIL, 20);
 680                 prop.valid := {opts};
 681                 prop.opts.mask := {pageBreak}; prop.opts.val := {pageBreak};
 682                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 683         END SetPageBreak;
 684
 685         PROCEDURE SetParJoin* (r: Ruler);
 686         BEGIN
 687                 ASSERT(r.style # NIL, 20);
 688                 prop.valid := {opts};
 689                 prop.opts.mask := {parJoin}; prop.opts.val := {parJoin};
 690                 r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
 691         END SetParJoin;
 692
 693
 694         PROCEDURE AddTab* (r: Ruler; x: INTEGER);
 695                 VAR ra: Attributes; i: INTEGER;
 696         BEGIN
 697                 ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i < maxTabs, 21);
 698                 ASSERT((i = 0) OR (ra.tabs.tab[i - 1].stop < x), 22);
 699                 prop.valid := {tabs};
 700                 CopyTabs(ra.tabs, prop.tabs);
 701                 prop.tabs.tab[i].stop := x; prop.tabs.tab[i].type := {}; INC(prop.tabs.len);
 702                 r.style.SetAttr(ModifiedAttr(ra, prop))
 703         END AddTab;
 704
 705         PROCEDURE MakeCenterTab* (r: Ruler);
 706                 VAR ra: Attributes; i: INTEGER;
 707         BEGIN
 708                 ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
 709                 prop.valid := {tabs};
 710                 CopyTabs(ra.tabs, prop.tabs);
 711                 prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type + {centerTab} - {rightTab};
 712                 r.style.SetAttr(ModifiedAttr(ra, prop))
 713         END MakeCenterTab;
 714
 715         PROCEDURE MakeRightTab* (r: Ruler);
 716                 VAR ra: Attributes; i: INTEGER;
 717         BEGIN
 718                 ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
 719                 prop.valid := {tabs};
 720                 CopyTabs(ra.tabs, prop.tabs);
 721                 prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type - {centerTab} + {rightTab};
 722                 r.style.SetAttr(ModifiedAttr(ra, prop))
 723         END MakeRightTab;
 724
 725         PROCEDURE MakeBarTab* (r: Ruler);
 726                 VAR ra: Attributes; i: INTEGER;
 727         BEGIN
 728                 ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
 729                 prop.valid := {tabs};
 730                 CopyTabs(ra.tabs, prop.tabs);
 731                 prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type + {barTab};
 732                 r.style.SetAttr(ModifiedAttr(ra, prop))
 733         END MakeBarTab;
 734
 735
 736         (* SetAttrOp *)
 737
 738         PROCEDURE (op: SetAttrOp) Do;
 739                 VAR s: Style; attr: Attributes; upd: UpdateMsg;
 740         BEGIN
 741                 s := op.style;
 742                 attr := s.attr; s.attr := op.attr; op.attr := attr;
 743                 (*Stores.InitDomain(s.attr, s.Domain());*) (* Stores.Join(s, s.attr); *)
 744                 ASSERT((s.attr=NIL) OR Stores.Joined(s, s.attr), 100);
 745                 upd.style := s; upd.oldAttr := attr; Models.Domaincast(s.Domain(), upd)
 746         END Do;
 747
 748         PROCEDURE DoSetAttrOp (s: Style; attr: Attributes);
 749                 VAR op: SetAttrOp;
 750         BEGIN
 751                 IF (s.attr # attr) OR ~s.attr.Equals(attr) THEN
 752                         (* IF attr.Domain() # s.Domain() THEN attr := Stores.CopyOf(attr)(Attributes) END; *)
 753                         IF ~Stores.Joined(s, attr) THEN
 754                                 IF ~Stores.Unattached(attr) THEN attr := Stores.CopyOf(attr)(Attributes) END;
 755                                 Stores.Join(s, attr)
 756                         END;
 757                         NEW(op); op.style := s; op.attr := attr;
 758                         Models.Do(s, rulerChangeKey, op)
 759                 END
 760         END DoSetAttrOp;
 761
 762
 763         (* grid definitions *)
 764
 765         PROCEDURE MarginGrid (x: INTEGER): INTEGER;
 766         BEGIN
 767                 RETURN (x + marginGrid DIV 2) DIV marginGrid * marginGrid
 768         END MarginGrid;
 769
 770         PROCEDURE TabGrid (x: INTEGER): INTEGER;
 771         BEGIN
 772                 RETURN (x + tabGrid DIV 2) DIV tabGrid * tabGrid
 773         END TabGrid;
 774
 775
 776         (* nice graphical primitives *)
 777
 778         PROCEDURE DrawCenteredInt (f: Views.Frame; x, y, n: INTEGER);
 779                 VAR sw: INTEGER; s: ARRAY 32 OF CHAR;
 780         BEGIN
 781                 Strings.IntToString(n, s); sw := font.StringWidth(s);
 782                 f.DrawString(x - sw DIV 2, y, Ports.defaultColor, s, font)
 783         END DrawCenteredInt;
 784
 785         PROCEDURE DrawNiceRect (f: Views.Frame; l, t, r, b: INTEGER);
 786                 VAR u: INTEGER;
 787         BEGIN
 788                 u := f.dot;
 789                 f.DrawRect(l, t, r - u, b - u, 0, Ports.defaultColor);
 790                 f.DrawLine(l + u, b - u, r - u, b - u, u, Ports.grey25);
 791                 f.DrawLine(r - u, t + u, r - u, b - u, u, Ports.grey25)
 792         END DrawNiceRect;
 793
 794         PROCEDURE DrawScale (f: Views.Frame; l, t, r, b, clipL, clipR: INTEGER);
 795                 VAR u, h, x, px, sw: INTEGER; i, n, d1, d2: INTEGER; s: ARRAY 32 OF CHAR;
 796         BEGIN
 797                 f.DrawRect(l, t, r, b, Ports.fill, Ports.grey12);
 798                 u := f.dot;
 799                 IF Dialog.metricSystem THEN d1 := 2; d2 := 10 ELSE d1 := 2; d2 := 16 END;
 800                 DEC(b, point);
 801                 sw := 2*u + font.StringWidth("8888888888");
 802                 x := l + tabGrid; i := 0; n := 0;
 803                 WHILE x <= r DO
 804                         INC(i); px := TabGrid(x);
 805                         IF i = d2 THEN
 806                                 h := 6*point; i := 0; INC(n);
 807                                 IF (px >= clipL - sw) & (px < clipR) THEN
 808                                         Strings.IntToString(n, s);
 809                                         f.DrawString(px - 2*u - font.StringWidth(s), b - 3*point, Ports.defaultColor, s, font)
 810                                 END
 811                         ELSIF i MOD d1 = 0 THEN
 812                                 h := 2*point
 813                         ELSE
 814                                 h := 0
 815                         END;
 816                         IF (px >= clipL) & (px < clipR) & (h > 0) THEN
 817                                 f.DrawLine(px, b, px, b - h, 0, Ports.defaultColor)
 818                         END;
 819                         INC(x, tabGrid)
 820                 END
 821         END DrawScale;
 822
 823         PROCEDURE InvertTabMark (f: Views.Frame; l, t, r, b: INTEGER; type: SET; show: BOOLEAN);
 824                 VAR u, u2, u3, yc, i, ih: INTEGER;
 825         BEGIN
 826                 u := f.dot; u2 := 2*u; u3 := 3*u;
 827                 IF ~ODD((r - l) DIV u) THEN DEC(r, u) END;
 828                 yc := l + (r - l) DIV u DIV 2 * u;
 829                 IF barTab IN type THEN
 830                         f.MarkRect(yc, b - u3, yc + u, b - u2, Ports.fill, Ports.invert, show);
 831                         f.MarkRect(yc, b - u, yc + u, b, Ports.fill, Ports.invert, show)
 832                 END;
 833                 IF centerTab IN type THEN
 834                         f.MarkRect(l + u, b - u2, r - u, b - u, Ports.fill, Ports.invert, show)
 835                 ELSIF rightTab IN type THEN
 836                         f.MarkRect(l, b - u2, yc + u, b - u, Ports.fill, Ports.invert, show)
 837                 ELSE
 838                         f.MarkRect(yc, b - u2, r, b - u, Ports.fill, Ports.invert, show)
 839                 END;
 840                 DEC(b, u3); INC(l, u2); DEC(r, u2);
 841                 ih := (r - l) DIV 2;
 842                 i := b - t; t := b - u;
 843                 WHILE (i > 0) & (r > l) DO
 844                         DEC(i, u);
 845                         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
 846                         IF i <= ih THEN INC(l, u); DEC(r, u) END;
 847                         DEC(t, u); DEC(b, u)
 848                 END
 849         END InvertTabMark;
 850
 851         PROCEDURE InvertFirstMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);
 852                 VAR u, i, ih: INTEGER;
 853         BEGIN
 854                 u := f.dot;
 855                 i := b - t; t := b - u;
 856                 ih := r - l;
 857                 WHILE (i > 0) & (r > l) DO
 858                         DEC(i, u);
 859                         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
 860                         IF i <= ih THEN DEC(r, u) END;
 861                         DEC(t, u); DEC(b, u)
 862                 END
 863         END InvertFirstMark;
 864
 865         PROCEDURE InvertLeftMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);
 866                 VAR u, i, ih: INTEGER;
 867         BEGIN
 868                 u := f.dot;
 869                 i := b - t; b := t + u;
 870                 ih := r - l;
 871                 WHILE (i > 0) & (r > l) DO
 872                         DEC(i, u);
 873                         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
 874                         IF i <= ih THEN DEC(r, u) END;
 875                         INC(t, u); INC(b, u)
 876                 END
 877         END InvertLeftMark;
 878
 879         PROCEDURE InvertRightMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);
 880                 VAR u, i, ih: INTEGER;
 881         BEGIN
 882                 u := f.dot;
 883                 IF ~ODD((b - t) DIV u) THEN INC(t, u) END;
 884                 ih := r - l; l := r - u;
 885                 i := b - t; b := t + u;
 886                 WHILE (i > 0) & (i > ih) DO
 887                         DEC(i, u);
 888                         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
 889                         DEC(l, u);
 890                         INC(t, u); INC(b, u)
 891                 END;
 892                 WHILE (i > 0) & (r > l) DO
 893                         DEC(i, u);
 894                         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
 895                         INC(l, u);
 896                         INC(t, u); INC(b, u)
 897                 END
 898         END InvertRightMark;
 899
 900
 901         (* marks *)
 902
 903         PROCEDURE SetMark (VAR m: Mark; r: StdRuler; px, py: INTEGER; kind, index: INTEGER);
 904         BEGIN
 905                 m.ruler := r; m.kind := kind;
 906                 m.px := px; m.py := py;
 907                 CASE kind OF
 908                   first:
 909                         m.l := px; m.r := m.l + 4*point;
 910                         m.b := py - 7*point; m.t := m.b - 4*point
 911                 | left:
 912                         m.l := px; m.r := m.l + 4*point;
 913                         m.b := py - 2*point; m.t := m.b - 4*point
 914                 | right:
 915                         m.r := px; m.l := m.r - 4*point;
 916                         m.b := py - 3*point; m.t := m.b - 7*point
 917                 | tabs:
 918                         m.l := px - 4*point; m.r := m.l + 9*point;
 919                         m.b := py - 5*point; m.t := m.b - 6*point;
 920                         m.type := r.style.attr.tabs.tab[index].type
 921                 | firstIcon .. lastIcon:
 922                         m.l := px; m.r := px + iconWidth;
 923                         m.t := py; m.b := py + iconHeight
 924                 ELSE HALT(100)
 925                 END
 926         END SetMark;
 927
 928         PROCEDURE Try (VAR m: Mark; r: StdRuler; px, py, x, y: INTEGER; kind, index: INTEGER);
 929         BEGIN
 930                 IF m.kind = invalid THEN
 931                         SetMark(m, r, px, py, kind, index);
 932                         IF (m.l - point <= x) & (x < m.r + point) & (m.t - point <= y) & (y < m.b + point) THEN
 933                                 m.px0 := m.px; m.py0 := m.py; m.x := x; m.y := y;
 934                                 IF kind = tabs THEN
 935                                         m.index := index; CopyTabs(r.style.attr.tabs, m.tabs)
 936                                 END
 937                         ELSE
 938                                 m.kind := invalid
 939                         END
 940                 END
 941         END Try;
 942
 943         PROCEDURE InvertMark (VAR m: Mark; f: Views.Frame; show: BOOLEAN);
 944         (* pre: kind # invalid *)
 945         BEGIN
 946                 CASE m.kind OF
 947                   first: InvertFirstMark(f, m.l, m.t, m.r, m.b, show)
 948                 | left: InvertLeftMark(f, m.l, m.t, m.r, m.b, show)
 949                 | right: InvertRightMark(f, m.l, m.t, m.r, m.b, show)
 950                 | tabs: InvertTabMark(f, m.l, m.t, m.r, m.b, m.type, show)
 951                 END
 952         END InvertMark;
 953
 954         PROCEDURE HiliteMark (VAR m: Mark; f: Views.Frame; show: BOOLEAN);
 955         BEGIN
 956                 f.MarkRect(m.l, m.t, m.r - point, m.b - point, Ports.fill, Ports.hilite, show)
 957         END HiliteMark;
 958
 959         PROCEDURE HiliteThisMark (r: StdRuler; f: Views.Frame; kind: INTEGER; show: BOOLEAN);
 960                 VAR m: Mark; px,  w, h: INTEGER;
 961         BEGIN
 962                 IF (kind # invalid) & (kind IN validIcons) THEN
 963                         px := iconGap + (kind - firstIcon) * (iconWidth + iconGap);
 964                         r.context.GetSize(w, h);
 965                         SetMark(m, r, px, h - iconPin, kind, -1);
 966                         HiliteMark(m, f, show)
 967                 END
 968         END HiliteThisMark;
 969
 970         PROCEDURE DrawMark (VAR m: Mark; f: Views.Frame);
 971         (* pre: kind # invalid *)
 972                 VAR a: Attributes; l, t, r, b, y, d, e, asc, dsc, fw: INTEGER; i: INTEGER;
 973                         w: ARRAY 4 OF INTEGER;
 974         BEGIN
 975                 a := m.ruler.style.attr;
 976                 l := m.l + 2 * point; t := m.t + 2 * point; r := m.r - 4 * point; b := m.b - 3 * point;
 977                 font.GetBounds(asc, dsc, fw);
 978                 y := (m.t + m.b + asc) DIV 2;
 979                 w[0] := (r - l) DIV 2; w[1] := r - l; w[2] := (r - l) DIV 3; w[3] := (r - l) * 2 DIV 3;
 980                 CASE m.kind OF
 981                   rightToggle:
 982                         IF rightFixed IN a.opts THEN
 983                                 d := 0; y := (t + b) DIV 2 - point; e := (l + r) DIV 2 + point;
 984                                 WHILE t < y DO
 985                                         f.DrawLine(e - d, t, e, t, point, Ports.defaultColor); INC(d, point); INC(t, point)
 986                                 END;
 987                                 WHILE t < b DO
 988                                         f.DrawLine(e - d, t, e, t, point, Ports.defaultColor); DEC(d, point); INC(t, point)
 989                                 END
 990                         ELSE
 991                                 DEC(b, point);
 992                                 f.DrawLine(l, t, r, t, point, Ports.defaultColor);
 993                                 f.DrawLine(l, b, r, b, point, Ports.defaultColor);
 994                                 f.DrawLine(l, t, l, b, point, Ports.defaultColor);
 995                                 f.DrawLine(r, t, r, b, point, Ports.defaultColor)
 996                         END
 997                 | gridDec:
 998                         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
 999                 | gridVal:
1000                         DrawCenteredInt(f, (l + r) DIV 2, y, a.grid DIV point)
1001                 | gridInc:
1002                         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 3 * point) END
1003                 | leftFlush:
1004                         i := 0;
1005                         WHILE t < b DO
1006                                 d := w[i]; i := (i + 1) MOD LEN(w);
1007                                 f.DrawLine(l, t, l + d, t, point, Ports.defaultColor); INC(t, 2 * point)
1008                         END
1009                 | centered:
1010                         i := 0;
1011                         WHILE t < b DO
1012                                 d := (r - l - w[i]) DIV 2; i := (i + 1) MOD LEN(w);
1013                                 f.DrawLine(l + d, t, r - d, t, point, Ports.defaultColor); INC(t, 2 * point)
1014                         END
1015                 | rightFlush:
1016                         i := 0;
1017                         WHILE t < b DO
1018                                 d := w[i]; i := (i + 1) MOD LEN(w);
1019                                 f.DrawLine(r - d, t, r, t, point, Ports.defaultColor); INC(t, 2 * point)
1020                         END
1021                 | justified:
1022                         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
1023                 | leadDec:
1024                         f.DrawLine(l, t, l, t + point, point, Ports.defaultColor); INC(t, 2 * point);
1025                         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
1026                 | leadVal:
1027                         DrawCenteredInt(f, (l + r) DIV 2, y, m.ruler.style.attr.lead DIV point)
1028                 | leadInc:
1029                         f.DrawLine(l, t, l, t + 3 * point, point, Ports.defaultColor); INC(t, 4 * point);
1030                         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
1031                 | pageBrk:
1032                         DEC(b, point);
1033                         IF pageBreak IN a.opts THEN
1034                                 y := (t + b) DIV 2 - point;
1035                                 f.DrawLine(l, t, l, y, point, Ports.defaultColor);
1036                                 f.DrawLine(r, t, r, y, point, Ports.defaultColor);
1037                                 f.DrawLine(l, y, r, y, point, Ports.defaultColor);
1038                                 INC(y, 2 * point);
1039                                 f.DrawLine(l, y, r, y, point, Ports.defaultColor);
1040                                 f.DrawLine(l, y, l, b, point, Ports.defaultColor);
1041                                 f.DrawLine(r, y, r, b, point, Ports.defaultColor)
1042                         ELSE
1043                                 f.DrawLine(l, t, l, b, point, Ports.defaultColor);
1044                                 f.DrawLine(r, t, r, b, point, Ports.defaultColor)
1045                         END
1046                 ELSE
1047                         HALT(100)
1048                 END;
1049                 IF ~(m.kind IN {gridVal, leadVal}) THEN
1050                         DrawNiceRect(f, m.l, m.t, m.r, m.b)
1051                 END
1052         END DrawMark;
1053
1054         PROCEDURE GetMark (VAR m: Mark; r: StdRuler; f: Views.Frame;
1055                 x, y: INTEGER; canCreate: BOOLEAN
1056         );
1057         (* pre: ~canCreate OR (f # NIL) *)
1058                 VAR a: Attributes; px,  w, h: INTEGER; i: INTEGER;
1059         BEGIN
1060                 m.kind := invalid; m.dirty := FALSE;
1061                 a := r.style.attr;
1062                 r.context.GetSize(w, h);
1063
1064                 (* first try scale *)
1065                 Try(m, r, a.first, h, x, y, first, 0);
1066                 Try(m, r, a.left, h, x, y, left, 0);
1067                 IF rightFixed IN a.opts THEN
1068                         Try(m, r, a.right, h, x, y, right, 0)
1069                 END;
1070                 i := 0;
1071                 WHILE (m.kind = invalid) & (i < a.tabs.len) DO
1072                         Try(m, r, a.tabs.tab[i].stop, h, x, y, tabs, i);
1073                         INC(i)
1074                 END;
1075                 IF (m.kind = invalid) & (y >= h - tabBarHeight) & (a.tabs.len < maxTabs) THEN
1076                         i := 0; px := TabGrid(x);
1077                         WHILE (i < a.tabs.len) & (a.tabs.tab[i].stop < px) DO INC(i) END;
1078                         IF (i = 0) OR (px - a.tabs.tab[i - 1].stop >= minTabWidth) THEN
1079                                 IF (i = a.tabs.len) OR (a.tabs.tab[i].stop - px >= minTabWidth) THEN
1080                                         IF canCreate THEN       (* set new tab stop, initially at end of list *)
1081                                                 m.kind := tabs; m.index := a.tabs.len; m.dirty := TRUE;
1082                                                 CopyTabs(a.tabs, m.tabs); m.tabs.len := a.tabs.len + 1;
1083                                                 m.tabs.tab[a.tabs.len].stop := px; m.tabs.tab[a.tabs.len].type := {};
1084                                                 a.tabs.tab[a.tabs.len].stop := px; a.tabs.tab[a.tabs.len].type := {};
1085                                                 SetMark(m, r, px, h, tabs, m.index); InvertMark(m, f, Ports.show);
1086                                                 m.px0 := m.px; m.py0 := m.py; m.x := x; m.y := y
1087                                         END
1088                                 END
1089                         END
1090                 END;
1091
1092                 (* next try icon bar *)
1093                 px := iconGap; i := firstIcon;
1094                 WHILE i <= lastIcon DO
1095                         IF i IN validIcons THEN
1096                                 Try(m, r, px, h - iconPin, x, y, i, 0)
1097                         END;
1098                         INC(px, iconWidth + iconGap); INC(i)
1099                 END
1100         END GetMark;
1101
1102         PROCEDURE SelectMark (r: StdRuler; f: Views.Frame; IN m: Mark);
1103         BEGIN
1104                 r.sel := m.kind; r.px := m.px; r.py := m.py
1105         END SelectMark;
1106
1107         PROCEDURE DeselectMark (r: StdRuler; f: Views.Frame);
1108         BEGIN
1109                 HiliteThisMark(r, f, r.sel, Ports.hide); r.sel := invalid
1110         END DeselectMark;
1111
1112
1113         (* mark interaction *)
1114
1115         PROCEDURE Mode (r: StdRuler): INTEGER;
1116                 VAR a: Attributes; i: INTEGER;
1117         BEGIN
1118                 a := r.style.attr;
1119                 IF a.opts * adjMask = {leftAdjust} THEN
1120                         i := leftFlush
1121                 ELSIF a.opts * adjMask = {} THEN
1122                         i := centered
1123                 ELSIF a.opts * adjMask = {rightAdjust} THEN
1124                         i := rightFlush
1125                 ELSE (* a.opts * adjMask = adjMask *)
1126                         i := justified
1127                 END;
1128                 RETURN i
1129         END Mode;
1130
1131         PROCEDURE GrabMark (VAR m: Mark; r: StdRuler; f: Views.Frame; x, y: INTEGER);
1132         BEGIN
1133                 GetMark(m, r, f, x, y, TRUE);
1134                 DeselectMark(r, f);
1135                 IF m.kind = Mode(r) THEN m.kind := invalid END
1136         END GrabMark;
1137
1138         PROCEDURE TrackMark (VAR m: Mark; f: Views.Frame; x, y: INTEGER; modifiers: SET);
1139                 VAR px, py,  w, h: INTEGER;
1140         BEGIN
1141                 IF m.kind # invalid THEN
1142                         px := m.px + x - m.x; py := m.py + y - m.y;
1143                         IF m.kind = tabs THEN
1144                                 px := TabGrid(px)
1145                         ELSIF m.kind IN validIcons THEN
1146                                 IF (m.l <= x) & (x < m.r) THEN px := 1 ELSE px := 0 END
1147                         ELSE
1148                                 px := MarginGrid(px)
1149                         END;
1150                         IF m.kind IN {right, tabs} THEN
1151                                 m.ruler.context.GetSize(w, h);
1152                                 IF (0 <= y) & (y < h + scaleHeight) OR (Controllers.extend IN modifiers) THEN
1153                                         py := h
1154                                 ELSE
1155                                         py := -1        (* moved mark out of ruler: delete tab stop or fixed right margin *)
1156                                 END
1157                         ELSIF m.kind IN validIcons THEN
1158                                 IF (m.t <= y) & (y < m.b) THEN py := 1 ELSE py := 0 END
1159                         ELSE
1160                                 py := MarginGrid(py)
1161                         END;
1162                         IF (m.kind IN {right, tabs}) & ((m.px # px) OR (m.py # py)) THEN
1163                                 INC(m.x, px - m.px); INC(m.y, py - m.py);
1164                                 InvertMark(m, f, Ports.hide); SetMark(m, m.ruler, px, py, m.kind, m.index);
1165                                 InvertMark(m, f, Ports.show);
1166                                 m.dirty := TRUE
1167                         ELSIF (m.kind IN {first, left}) & (m.px # px) THEN
1168                                 INC(m.x, px - m.px);
1169                                 InvertMark(m, f, Ports.hide); SetMark(m, m.ruler, px, m.py, m.kind, m.index);
1170                                 InvertMark(m, f, Ports.show)
1171                         ELSIF (m.kind IN validIcons) & (m.px * m.py # px * py) THEN
1172                                 HiliteMark(m, f, Ports.show);
1173                                 IF m.kind IN modeIcons THEN HiliteThisMark(m.ruler, f, Mode(m.ruler), Ports.hide) END;
1174                                 m.px := px; m.py := py
1175                         END
1176                 END
1177         END TrackMark;
1178
1179         PROCEDURE ShiftMarks (a: Attributes; p: Prop; mask: SET; x0, dx: INTEGER);
1180                 VAR new: SET; i, j, t0, t1: INTEGER; tab0, tab1: TabArray;
1181         BEGIN
1182                 new := mask - p.valid;
1183                 IF first IN new THEN p.first := a.first END;
1184                 IF tabs IN new THEN CopyTabs(a.tabs, p.tabs) END;
1185                 p.valid := p.valid + mask;
1186                 IF first IN mask THEN INC(p.first, dx) END;
1187                 IF tabs IN mask THEN
1188                         i := 0;
1189                         WHILE (i < p.tabs.len) & (p.tabs.tab[i].stop < x0) DO tab0.tab[i] := p.tabs.tab[i]; INC(i) END;
1190                         t0 := i;
1191                         t1 := 0;
1192                         WHILE i < p.tabs.len DO
1193                                 tab1.tab[t1].stop := p.tabs.tab[i].stop + dx;
1194                                 tab1.tab[t1].type := p.tabs.tab[i].type;
1195                                 INC(t1); INC(i)
1196                         END;
1197                         i := 0; j := 0; p.tabs.len := 0;
1198                         WHILE i < t0 DO (* merge sort *)
1199                                 WHILE (j < t1) & (tab1.tab[j].stop < tab0.tab[i].stop) DO
1200                                         p.tabs.tab[p.tabs.len] := tab1.tab[j]; INC(p.tabs.len); INC(j)
1201                                 END;
1202                                 IF (j < t1) & (tab1.tab[j].stop = tab0.tab[i].stop) THEN INC(j) END;
1203                                 p.tabs.tab[p.tabs.len] := tab0.tab[i]; INC(p.tabs.len); INC(i)
1204                         END;
1205                         WHILE j < t1 DO
1206                                 p.tabs.tab[p.tabs.len] := tab1.tab[j]; INC(p.tabs.len); INC(j)
1207                         END
1208                 END
1209         END ShiftMarks;
1210
1211         PROCEDURE ShiftDependingMarks (VAR m: Mark; p: Prop);
1212                 VAR a: Attributes; dx: INTEGER;
1213         BEGIN
1214                 a := m.ruler.style.attr; dx := m.px - m.px0;
1215                 CASE m.kind OF
1216                   first: ShiftMarks(a, p, {tabs}, 0, dx)
1217                 | left: ShiftMarks(a, p, {first, tabs}, 0, dx)
1218                 | tabs: ShiftMarks(a, p, {tabs}, m.px0, dx)
1219                 ELSE
1220                 END
1221         END ShiftDependingMarks;
1222
1223         PROCEDURE AdjustMarks (VAR m: Mark; f: Views.Frame; modifiers: SET);
1224                 VAR r: StdRuler; a: Attributes; p: Prop;
1225                         g: INTEGER; i, j: INTEGER; shift: BOOLEAN; type: SET;
1226         BEGIN
1227                 r := m.ruler;
1228                 IF  (m.kind # invalid) & (m.kind IN validIcons)
1229                                 & (m.px = 1) & (m.py = 1)
1230                 OR (m.kind # invalid) & ~(m.kind IN validIcons)
1231                                 & ((m.px # m.px0) OR (m.py # m.py0)
1232                                         OR (m.kind = tabs) (*(m.tabs.len # r.style.attr.tabs.len)*) )
1233                 THEN
1234                         a := r.style.attr; NEW(p);
1235                         p.valid := {};
1236                         shift := (Controllers.modify IN modifiers) & (m.tabs.len = r.style.attr.tabs.len);
1237                         CASE m.kind OF
1238                           first:
1239                                 p.valid := {first}; p.first := m.px
1240                         | left:
1241                                 p.valid := {left}; p.left := m.px
1242                         | right:
1243                                 IF m.py >= 0 THEN
1244                                         p.valid := {right}; p.right := m.px
1245                                 ELSE
1246                                         p.valid := {opts}; p.opts.val := {}; p.opts.mask := {rightFixed}
1247                                 END
1248                         | tabs:
1249                                 IF ~m.dirty THEN
1250                                         p.valid := {tabs}; CopyTabs(m.tabs, p.tabs);
1251                                         i := m.index; type := m.tabs.tab[i].type;
1252                                         IF shift THEN
1253                                                 type := type * {barTab};
1254                                                 IF type = {} THEN type := {barTab}
1255                                                 ELSE type := {}
1256                                                 END;
1257                                                 p.tabs.tab[i].type := p.tabs.tab[i].type - {barTab} + type
1258                                         ELSE
1259                                                 type := type * {centerTab, rightTab};
1260                                                 IF type = {} THEN type := {centerTab}
1261                                                 ELSIF type = {centerTab} THEN type := {rightTab}
1262                                                 ELSE type := {}
1263                                                 END;
1264                                                 p.tabs.tab[i].type := p.tabs.tab[i].type - {centerTab, rightTab} + type
1265                                         END
1266                                 ELSIF ~shift THEN
1267                                         p.valid := {tabs}; p.tabs.len := m.tabs.len - 1;
1268                                         i := 0;
1269                                         WHILE i < m.index DO p.tabs.tab[i] := m.tabs.tab[i]; INC(i) END;
1270                                         INC(i);
1271                                         WHILE i < m.tabs.len DO p.tabs.tab[i - 1] := m.tabs.tab[i]; INC(i) END;
1272                                         i := 0;
1273                                         WHILE (i < p.tabs.len) & (p.tabs.tab[i].stop < m.px) DO INC(i) END;
1274                                         IF (m.px >= MIN(a.first, a.left)) & (m.px <= f.r) & (m.py >= 0)
1275                                          & ((i = 0) OR (m.px - p.tabs.tab[i - 1].stop >= minTabWidth))
1276                                          & ((i = p.tabs.len) OR (p.tabs.tab[i].stop - m.px >= minTabWidth)) THEN
1277                                                 j := p.tabs.len;
1278                                                 WHILE j > i DO p.tabs.tab[j] := p.tabs.tab[j - 1]; DEC(j) END;
1279                                                 p.tabs.tab[i].stop := m.px; p.tabs.tab[i].type := m.tabs.tab[m.index].type;
1280                                                 INC(p.tabs.len)
1281                                         END;
1282                                         i := 0;
1283                                         WHILE (i < p.tabs.len)
1284                                          & (p.tabs.tab[i].stop = a.tabs.tab[i].stop)
1285                                          & (p.tabs.tab[i].type = a.tabs.tab[i].type) DO
1286                                                 INC(i)
1287                                         END;
1288                                         IF (i = p.tabs.len) & (p.tabs.len = a.tabs.len) THEN RETURN END (* did not change *)
1289                                 END
1290                         | rightToggle:
1291                                 p.valid := {right, opts};
1292                                 IF ~(rightFixed IN a.opts) THEN
1293                                         p.right := f.r DIV marginGrid * marginGrid
1294                                 END;
1295                                 p.opts.val := a.opts / {rightFixed}; p.opts.mask := {rightFixed}
1296                         | gridDec:
1297                                 p.valid := {asc, grid}; g := a.grid - point;
1298                                 IF g = 0 THEN p.grid := 1; p.asc := 0 ELSE p.grid := g; p.asc := g - a.dsc END
1299                         | gridVal:
1300                                 SelectMark(r, f, m); RETURN
1301                         | gridInc:
1302                                 p.valid := {asc, grid}; g := a.grid + point; DEC(g, g MOD point);
1303                                 p.grid := g; p.asc := g - a.dsc
1304                         | leftFlush:
1305                                 p.valid := {opts}; p.opts.val := {leftAdjust}; p.opts.mask := adjMask
1306                         | centered:
1307                                 p.valid := {opts}; p.opts.val := {}; p.opts.mask := adjMask
1308                         | rightFlush:
1309                                 p.valid := {opts}; p.opts.val := {rightAdjust}; p.opts.mask := adjMask
1310                         | justified:
1311                                 p.valid := {opts}; p.opts.val := adjMask; p.opts.mask := adjMask
1312                         | leadDec:
1313                                 p.valid := {lead}; p.lead := a.lead - point
1314                         | leadVal:
1315                                 SelectMark(r, f, m); RETURN
1316                         | leadInc:
1317                                 p.valid := {lead}; p.lead := a.lead + point
1318                         | pageBrk:
1319                                 p.valid := {opts}; p.opts.val := a.opts / {pageBreak}; p.opts.mask := {pageBreak}
1320                         ELSE HALT(100)
1321                         END;
1322                         IF shift THEN ShiftDependingMarks(m, p) END;
1323                         IF m.kind IN validIcons - modeIcons THEN HiliteMark(m, f, Ports.hide) END;
1324
1325                         r.style.SetAttr(ModifiedAttr(a, p))
1326                 END
1327         END AdjustMarks;
1328
1329
1330         (* primitivies for standard ruler *)
1331
1332         PROCEDURE Track (r: StdRuler; f: Views.Frame; IN msg: Controllers.TrackMsg);
1333                 VAR m: Mark; x, y, res: INTEGER; modifiers: SET; isDown: BOOLEAN;
1334                         cmd: ARRAY 128 OF CHAR;
1335         BEGIN
1336                 GrabMark(m, r, f, msg.x, msg.y);
1337                 REPEAT
1338                         f.Input(x, y, modifiers, isDown); TrackMark(m, f, x, y, modifiers)
1339                 UNTIL ~isDown;
1340                 AdjustMarks(m, f, modifiers);
1341                 IF Controllers.doubleClick IN msg.modifiers THEN
1342                         CASE m.kind OF
1343                         | invalid:
1344                                 Dialog.MapString("#Text:OpenRulerDialog", cmd); Dialog.Call(cmd, "", res)
1345                         | gridVal, leadVal:
1346                                 Dialog.MapString("#Text:OpenSizeDialog", cmd); Dialog.Call(cmd, "", res)
1347                         ELSE
1348                         END
1349                 END
1350         END Track;
1351
1352         PROCEDURE Edit (r: StdRuler; f: Views.Frame; VAR msg: Controllers.EditMsg);
1353                 VAR v: Views.View;
1354         BEGIN
1355                 CASE msg.op OF
1356                   Controllers.copy:
1357                         msg.view := Views.CopyOf(r, Views.deep);
1358                         msg.isSingle := TRUE
1359                 | Controllers.paste:
1360                         v := msg.view;
1361                         WITH v: Ruler DO r.style.SetAttr(v.style.attr) ELSE END
1362                 ELSE
1363                 END
1364         END Edit;
1365
1366         PROCEDURE PollOps (r: StdRuler; f: Views.Frame; VAR msg: Controllers.PollOpsMsg);
1367         BEGIN
1368                 msg.type := "TextRulers.Ruler";
1369                 msg.pasteType := "TextRulers.Ruler";
1370                 msg.selectable := FALSE;
1371                 msg.valid := {Controllers.copy, Controllers.paste}
1372         END PollOps;
1373
1374         PROCEDURE SetProp (r: StdRuler; VAR msg: Properties.SetMsg; VAR requestFocus: BOOLEAN);
1375                 VAR a1: Attributes; px, py, g: INTEGER; sel: INTEGER;
1376                         p: Properties.Property; sp: Properties.StdProp; rp: Prop;
1377         BEGIN
1378                 p := msg.prop; sel := r.sel; px := r.px; py := r.py;
1379                 IF sel # invalid THEN
1380                         WHILE (p # NIL) & ~(p IS Properties.StdProp) DO p := p.next END;
1381                         IF p # NIL THEN
1382                                 sp := p(Properties.StdProp);
1383                                 IF (r.sel = leadVal) & (Properties.size IN sp.valid) THEN
1384                                         NEW(rp); rp.valid := {lead};
1385                                         rp.lead := sp.size
1386                                 ELSIF (r.sel = gridVal) & (Properties.size IN sp.valid) THEN
1387                                         g := sp.size; DEC(g, g MOD point);
1388                                         NEW(rp); rp.valid := {asc, grid};
1389                                         IF g = 0 THEN rp.asc := 0; rp.grid := 1
1390                                         ELSE rp.asc := g - r.style.attr.dsc; rp.grid := g
1391                                         END
1392                                 ELSE
1393                                         rp := NIL
1394                                 END
1395                         END;
1396                         p := rp
1397                 END;
1398                 a1 := ModifiedAttr(r.style.attr, p);
1399                 IF ~a1.Equals(r.style.attr) THEN
1400                         r.style.SetAttr(a1);
1401                         IF requestFocus & (r.sel = invalid) THEN        (* restore mark selection *)
1402                                 r.sel := sel; r.px := px; r.py := py
1403                         END
1404                 ELSE requestFocus := FALSE
1405                 END
1406         END SetProp;
1407
1408         PROCEDURE PollProp (r: StdRuler; VAR msg: Properties.PollMsg);
1409                 VAR p: Properties.StdProp;
1410         BEGIN
1411                 CASE r.sel OF
1412                   invalid:
1413                         msg.prop := r.style.attr.Prop()
1414                 | leadVal:
1415                         NEW(p); p.known := {Properties.size}; p.valid := p.known;
1416                         p.size := r.style.attr.lead;
1417                         msg.prop := p
1418                 | gridVal:
1419                         NEW(p); p.known := {Properties.size}; p.valid := p.known;
1420                         p.size := r.style.attr.grid;
1421                         msg.prop := p
1422                 ELSE HALT(100)
1423                 END
1424         END PollProp;
1425
1426
1427         (* StdStyle *)
1428
1429         PROCEDURE (r: StdStyle) Internalize (VAR rd: Stores.Reader);
1430                 VAR thisVersion: INTEGER;
1431         BEGIN
1432                 r.Internalize^(rd);
1433                 IF rd.cancelled THEN RETURN END;
1434                 rd.ReadVersion(minVersion, maxStdStyleVersion, thisVersion)
1435         END Internalize;
1436
1437         PROCEDURE (r: StdStyle) Externalize (VAR wr: Stores.Writer);
1438         BEGIN
1439                 r.Externalize^(wr);
1440                 wr.WriteVersion(maxStdStyleVersion)
1441         END Externalize;
1442 (*
1443         PROCEDURE (r: StdStyle) CopyFrom (source: Stores.Store);
1444         BEGIN
1445                 r.SetAttr(source(StdStyle).attr)
1446         END CopyFrom;
1447 *)
1448
1449         (* StdRuler *)
1450
1451         PROCEDURE (r: StdRuler) Internalize (VAR rd: Stores.Reader);
1452                 VAR thisVersion: INTEGER;
1453         BEGIN
1454                 r.Internalize^(rd);
1455                 IF rd.cancelled THEN RETURN END;
1456                 rd.ReadVersion(minVersion, maxStdRulerVersion, thisVersion);
1457                 IF rd.cancelled THEN RETURN END;
1458                 r.sel := invalid
1459         END Internalize;
1460
1461         PROCEDURE (r: StdRuler) Externalize (VAR wr: Stores.Writer);
1462         BEGIN
1463                 r.Externalize^(wr);
1464                 wr.WriteVersion(maxStdRulerVersion)
1465         END Externalize;
1466
1467         PROCEDURE (r: StdRuler) ThisModel (): Models.Model;
1468         BEGIN
1469                 RETURN r.style
1470         END ThisModel;
1471
1472         PROCEDURE (r: StdRuler) CopyFromModelView (source: Views.View; model: Models.Model);
1473         BEGIN
1474                 r.sel := invalid; r.InitStyle(model(Style))
1475         END CopyFromModelView;
1476
1477         PROCEDURE (ruler: StdRuler) Restore (f: Views.Frame; l, t, r, b: INTEGER);
1478                 VAR a: Attributes; m: Mark; u, scale, tabBar,  px,  w, h: INTEGER; i: INTEGER;
1479         BEGIN
1480                 u := f.dot; a := ruler.style.attr;
1481                 ruler.context.GetSize(w, h);
1482                 tabBar := h - tabBarHeight; scale := tabBar - scaleHeight;
1483                 w := MIN(f.r + 10 * mm, 10000 * mm);    (* high-level clipping *)
1484                 f.DrawLine(0, scale - u, w - u, scale - u, u, Ports.grey25);
1485                 f.DrawLine(0, tabBar - u, w - u, tabBar - u, u, Ports.grey50);
1486                 DrawScale(f, 0, scale, w, tabBar, l, r);
1487                 DrawNiceRect(f, 0, h - rulerHeight, w, h);
1488                 SetMark(m, ruler, a.first, h, first, -1); InvertMark(m, f, Ports.show);
1489                 SetMark(m, ruler, a.left, h, left, -1); InvertMark(m, f, Ports.show);
1490                 IF rightFixed IN a.opts THEN
1491                         SetMark(m, ruler, a.right, h, right, -1); InvertMark(m, f, Ports.show)
1492                 END;
1493                 i := 0;
1494                 WHILE i < a.tabs.len DO
1495                         SetMark(m, ruler, a.tabs.tab[i].stop, h, tabs, i); InvertMark(m, f, Ports.show); INC(i)
1496                 END;
1497                 px := iconGap; i := firstIcon;
1498                 WHILE i <= lastIcon DO
1499                         IF i IN validIcons THEN
1500                                 SetMark(m, ruler, px, h - iconPin, i, -1); DrawMark(m, f)
1501                         END;
1502                         INC(px, iconWidth + iconGap); INC(i)
1503                 END;
1504                 HiliteThisMark(ruler, f, Mode(ruler), Ports.show)
1505         END Restore;
1506
1507         PROCEDURE (ruler: StdRuler) RestoreMarks (f: Views.Frame; l, t, r, b: INTEGER);
1508         BEGIN
1509                 HiliteThisMark(ruler, f, ruler.sel, Ports.show)
1510         END RestoreMarks;
1511
1512         PROCEDURE (r: StdRuler) GetBackground (VAR color: Ports.Color);
1513         BEGIN
1514                 color := Ports.background
1515         END GetBackground;
1516
1517         PROCEDURE (r: StdRuler) Neutralize;
1518                 VAR msg: NeutralizeMsg;
1519         BEGIN
1520                 Views.Broadcast(r, msg)
1521         END Neutralize;
1522
1523         PROCEDURE (r: StdRuler) HandleModelMsg (VAR msg: Models.Message);
1524         BEGIN
1525                 WITH msg: UpdateMsg DO
1526                         Views.Update(r, Views.keepFrames)
1527                 ELSE
1528                 END
1529         END HandleModelMsg;
1530
1531         PROCEDURE (r: StdRuler) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
1532         BEGIN
1533                 WITH msg: NeutralizeMsg DO
1534                         DeselectMark(r, f)
1535                 ELSE
1536                 END
1537         END HandleViewMsg;
1538
1539         PROCEDURE (r: StdRuler) HandleCtrlMsg (f: Views.Frame;
1540                 VAR msg: Controllers.Message; VAR focus: Views.View
1541         );
1542                 VAR requestFocus: BOOLEAN;
1543         BEGIN
1544                 WITH msg: Controllers.TrackMsg DO
1545                         Track(r, f, msg)
1546                 | msg: Controllers.EditMsg DO
1547                         Edit(r, f, msg)
1548                 | msg: Controllers.MarkMsg DO
1549                         r.RestoreMarks(f, f.l, f.t, f.r, f.b)
1550                 | msg: Controllers.SelectMsg DO
1551                         IF ~msg.set THEN DeselectMark(r, f) END
1552                 | msg: Controllers.PollOpsMsg DO
1553                         PollOps(r, f, msg)
1554                 | msg: Properties.CollectMsg DO
1555                         PollProp(r, msg.poll)
1556                 | msg: Properties.EmitMsg DO
1557                         requestFocus := f.front;
1558                         SetProp(r, msg.set, requestFocus);
1559                         msg.requestFocus := requestFocus
1560                 ELSE
1561                 END
1562         END HandleCtrlMsg;
1563
1564         PROCEDURE (r: StdRuler) HandlePropMsg (VAR msg: Properties.Message);
1565                 VAR m: Mark; requestFocus: BOOLEAN; w, h: INTEGER;
1566         BEGIN
1567                 WITH msg: Properties.SizePref DO
1568                         msg.w := 10000 * Ports.mm; msg.h := rulerHeight
1569                 | msg: Properties.ResizePref DO
1570                         msg.fixed := TRUE
1571                 | msg: Properties.FocusPref DO
1572                         IF msg.atLocation THEN
1573                                 r.context.GetSize(w, h);
1574                                 GetMark(m, r, NIL, msg.x, msg.y, FALSE);
1575                                 msg.hotFocus := (m.kind # invalid) & ~(m.kind IN fieldIcons) OR (msg.y >= h - tabBarHeight);
1576                                 msg.setFocus := ~msg.hotFocus
1577                         END
1578                 | msg: TextModels.Pref DO
1579                         msg.opts := {TextModels.maskChar, TextModels.hideable};
1580                         msg.mask := TextModels.para
1581                 | msg: Properties.SetMsg DO
1582                         requestFocus := FALSE;
1583                         SetProp(r, msg, requestFocus)
1584                 | msg: Properties.PollMsg DO
1585                         PollProp(r, msg)
1586                 ELSE
1587                 END
1588         END HandlePropMsg;
1589
1590
1591         (* StdDirectory *)
1592
1593         PROCEDURE (d: StdDirectory) NewStyle (attr: Attributes): Style;
1594                 VAR s: StdStyle;
1595         BEGIN
1596                 IF attr = NIL THEN attr := d.attr END;
1597                 NEW(s); s.SetAttr(attr); RETURN s
1598         END NewStyle;
1599
1600         PROCEDURE (d: StdDirectory) New (style: Style): Ruler;
1601                 VAR r: StdRuler;
1602         BEGIN
1603                 IF style = NIL THEN style := d.NewStyle(NIL) END;
1604                 NEW(r); r.InitStyle(style); r.sel := invalid; RETURN r
1605         END New;
1606
1607
1608         (** miscellaneous **)
1609
1610         PROCEDURE GetValidRuler* (text: TextModels.Model; pos, hint: INTEGER;
1611                 VAR ruler: Ruler; VAR rpos: INTEGER
1612         );
1613                 (** pre: (hint < 0   OR   (ruler, rpos) is first ruler before hint  &  0 <= pos <= t.Length() **)
1614                 (** post: hint < rpos <= pos & rpos = Pos(ruler) & (no ruler in (rpos, pos])
1615                                 OR   ((ruler, rpos) unmodified)
1616                 **)
1617                 VAR view: Views.View;
1618         BEGIN
1619                 IF pos < text.Length() THEN INC(pos) END;       (* let a ruler dominate its own position *)
1620                 IF pos < hint THEN hint := -1 END;
1621                 globRd := text.NewReader(globRd); globRd.SetPos(pos);
1622                 REPEAT
1623                         globRd.ReadPrevView(view)
1624                 UNTIL globRd.eot OR (view IS Ruler) OR (globRd.Pos() < hint);
1625                 IF (view # NIL) & (view IS Ruler) THEN
1626                         ruler := view(Ruler); rpos := globRd.Pos()
1627                 END
1628         END GetValidRuler;
1629
1630         PROCEDURE SetDir* (d: Directory);
1631         (** pre: d # NIL, d.attr # NIL **)
1632         (** post: dir = d **)
1633         BEGIN
1634                 ASSERT(d # NIL, 20); ASSERT(d.attr.init, 21); dir := d
1635         END SetDir;
1636
1637
1638         PROCEDURE Init;
1639                 VAR d: StdDirectory; fnt: Fonts.Font; asc, dsc, w: INTEGER;
1640         BEGIN
1641                 IF Dialog.metricSystem THEN
1642                         marginGrid := 1*mm; minTabWidth := 1*mm; tabGrid := 1*mm
1643                 ELSE
1644                         marginGrid := inch16; minTabWidth := inch16; tabGrid := inch16
1645                 END;
1646
1647                 fnt := Fonts.dir.Default();
1648                 font := Fonts.dir.This(fnt.typeface, 7*point, {}, Fonts.normal);        (* font for ruler scales *)
1649                 NEW(prop);
1650                 prop.valid := {first .. tabs};
1651                 prop.first := 0; prop.left := 0;
1652                 IF Dialog.metricSystem THEN
1653                         prop.right := 165*mm
1654                 ELSE
1655                         prop.right := 104*inch16
1656                 END;
1657                 fnt.GetBounds(asc, dsc, w);
1658                 prop.lead := 0; prop.asc := asc; prop.dsc := dsc; prop.grid := 1;
1659                 prop.opts.val := {leftAdjust}; prop.opts.mask := options;
1660                 prop.tabs.len := 0;
1661
1662                 NEW(def); def.InitFromProp(prop);
1663                 NEW(d); d.attr := def; dir := d; stdDir := d
1664         END Init;
1665
1666         PROCEDURE Cleaner;
1667         BEGIN
1668                 globRd := NIL
1669         END Cleaner;
1670
1671 BEGIN
1672         Init;
1673         Kernel.InstallCleaner(Cleaner)
1674 CLOSE
1675         Kernel.RemoveCleaner(Cleaner)
1676 END TextRulers.