MODULE TextRulers;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   (* re-check alien attributes: consider projection semantics *)

   IMPORT

      Kernel, Strings, Services, Fonts, Ports, Stores,
      Models, Views, Controllers, Properties, Dialog,
      TextModels;
   CONST

      (** Attributes.valid, Prop.known/valid **)   (* Mark.kind *)
      first* = 0; left* = 1; right* = 2; lead* = 3; asc* = 4; dsc* = 5; grid* = 6;
      opts* = 7; tabs* = 8;
      (* additional values for icons held by Mark.kind *)
      invalid = -1;
      firstIcon = 10; lastIcon = 25;
      rightToggle = 10;
      gridDec = 12; gridVal = 13; gridInc = 14;
      leftFlush = 16; centered = 17; rightFlush = 18; justified = 19;
      leadDec = 21; leadVal = 22; leadInc = 23;
      pageBrk = 25;
      modeIcons = {leftFlush .. justified};

      validIcons = {rightToggle, gridDec .. gridInc, leftFlush .. justified, leadDec .. leadInc, pageBrk};
      fieldIcons = {gridVal, leadVal};
      (** Attributes.opts **)

      leftAdjust* = 0; rightAdjust* = 1;
            (** both: fully justified; none: centered **)
      noBreakInside* = 2; pageBreak* = 3; parJoin* = 4;
            (** pageBreak of this ruler overrides parJoin request of previous ruler **)
      rightFixed* = 5;   (** has fixed right border **)
      options = {leftAdjust .. rightFixed};   (* options mask *)

      adjMask = {leftAdjust, rightAdjust};
      (** Attributes.tabType[i] **)

      maxTabs* = 32;
      centerTab* = 0; rightTab* = 1;
         (** both: (reserved); none: leftTab **)
      barTab* = 2;
      tabOptions = {centerTab .. barTab};   (* mask for presently valid options *)

      mm = Ports.mm; inch16 = Ports.inch DIV 16; point = Ports.point;

      tabBarHeight = 11 * point; scaleHeight = 10 * point; iconBarHeight = 14 * point;
      rulerHeight = tabBarHeight + scaleHeight + iconBarHeight;
      iconHeight = 10 * point; iconWidth = 12 * point; iconGap = 2 * point;
      iconPin = rulerHeight - (iconBarHeight - iconHeight) DIV 2;
      rulerChangeKey = "#Text:RulerChange";

      minVersion = 0;

      maxAttrVersion = 2; maxStyleVersion = 0; maxStdStyleVersion = 0;
      maxRulerVersion = 0; maxStdRulerVersion = 0;
   TYPE


      Tab* = RECORD
         stop*: INTEGER;
         type*: SET
      END;
      TabArray* = RECORD   (* should be POINTER TO ARRAY OF Tab -- but cannot protect *)

         len*: INTEGER;
         tab*: ARRAY maxTabs OF Tab
      END;
      Attributes* = POINTER TO EXTENSIBLE RECORD (Stores.Store)

         init-: BOOLEAN;   (* immutable once init holds *)
         first-, left-, right-, lead-, asc-, dsc-, grid-: INTEGER;
         opts-: SET;
         tabs-: TabArray
      END;
      AlienAttributes* = POINTER TO RECORD (Attributes)

         store-: Stores.Alien
      END;
      Style* = POINTER TO ABSTRACT RECORD (Models.Model)

         attr-: Attributes
      END;
      Ruler* = POINTER TO ABSTRACT RECORD (Views.View)

         style-: Style
      END;
      Prop* = POINTER TO RECORD (Properties.Property)


         first*, left*, right*, lead*, asc*, dsc*, grid*: INTEGER;
         opts*: RECORD val*, mask*: SET END;
         tabs*: TabArray
      END;
      UpdateMsg* = RECORD (Models.UpdateMsg)


         (** domaincast upon style update **)
         style*: Style;
         oldAttr*: Attributes
      END;
      Directory* = POINTER TO ABSTRACT RECORD


         attr-: Attributes
      END;
      StdStyle = POINTER TO RECORD (Style) END;


      StdRuler = POINTER TO RECORD (Ruler)

         sel: INTEGER;   (* sel # invalid => sel = kind of selected mark *)
         px, py: INTEGER   (* sel # invalid => px, py of selected mark *)
      END;
      StdDirectory = POINTER TO RECORD (Directory) END;

      Mark = RECORD

         ruler: StdRuler;
         l, r, t, b: INTEGER;
         px, py, px0, py0, x, y: INTEGER;
         kind, index: INTEGER;
         type: SET;   (* valid if kind = tabs *)
         tabs: TabArray;   (* if valid: tabs[index].type = type *)
         dirty: BOOLEAN
      END;
      SetAttrOp = POINTER TO RECORD (Stores.Operation)

         style: Style;
         attr: Attributes
      END;
      NeutralizeMsg = RECORD (Views.Message) END;

   VAR


      dir-, stdDir-: Directory;
      def: Attributes;

      prop: Prop;   (* recycled *)
      globRd: TextModels.Reader;   (* cache for temp reader; beware of reentrance *)
      font: Fonts.Font;
      marginGrid, minTabWidth, tabGrid: INTEGER;

   PROCEDURE ^ DoSetAttrOp (s: Style; attr: Attributes);


   PROCEDURE CopyTabs (IN src: TabArray; OUT dst: TabArray);

   (* a TabArray is a 256 byte structure - copying of used parts is much faster than ":= all" *)
      VAR i, n: INTEGER;
   BEGIN
      n := src.len; dst.len := n;
      i := 0; WHILE i < n DO dst.tab[i] := src.tab[i]; INC(i) END
   END CopyTabs;
   (** Attributes **)


   PROCEDURE (a: Attributes) CopyFrom- (source: Stores.Store), EXTENSIBLE;

   BEGIN
      WITH source: Attributes DO
         ASSERT(~a.init, 20); ASSERT(source.init, 21);
         a.init := TRUE;
         a.first := source.first; a.left := source.left; a.right := source.right;
         a.lead := source.lead; a.asc := source.asc; a.dsc := source.dsc; a.grid := source.grid;
         a.opts := source.opts;
         CopyTabs(source.tabs, a.tabs)
      END
   END CopyFrom;
   PROCEDURE (a: Attributes) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;

   (** pre: a.init **)
      VAR i: INTEGER; typedTabs: BOOLEAN;
   BEGIN
      ASSERT(a.init, 20);
      a.Externalize^(wr);
      i := 0; WHILE (i < a.tabs.len) & (a.tabs.tab[i].type = {}) DO INC(i) END;
      typedTabs := i < a.tabs.len;
      IF typedTabs THEN
         wr.WriteVersion(maxAttrVersion)
      ELSE
         wr.WriteVersion(1)   (* versions before 2 had only leftTabs *)
      END;
      wr.WriteInt(a.first); wr.WriteInt(a.left); wr.WriteInt(a.right);
      wr.WriteInt(a.lead); wr.WriteInt(a.asc); wr.WriteInt(a.dsc); wr.WriteInt(a.grid);
      wr.WriteSet(a.opts);
      wr.WriteXInt(a.tabs.len);
      i := 0; WHILE i < a.tabs.len DO wr.WriteInt(a.tabs.tab[i].stop); INC(i) END;
      IF typedTabs THEN
         i := 0; WHILE i < a.tabs.len DO wr.WriteSet(a.tabs.tab[i].type); INC(i) END
      END
   END Externalize;
   PROCEDURE (a: Attributes) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;

   (** pre: ~a.init **)
   (** post: a.init **)
      VAR thisVersion, i, n, trash: INTEGER; trashSet: SET;
   BEGIN
      ASSERT(~a.init, 20); a.init := TRUE;
      a.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxAttrVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      rd.ReadInt(a.first); rd.ReadInt(a.left); rd.ReadInt(a.right);
      rd.ReadInt(a.lead); rd.ReadInt(a.asc); rd.ReadInt(a.dsc); rd.ReadInt(a.grid);
      rd.ReadSet(a.opts);
      rd.ReadXInt(n); a.tabs.len := MIN(n, maxTabs);
      i := 0; WHILE i < a.tabs.len DO rd.ReadInt(a.tabs.tab[i].stop); INC(i) END;
      WHILE i < n DO rd.ReadInt(trash); INC(i) END;
      IF thisVersion = 0 THEN   (* convert from v0 rightFixed to v1 ~rightFixed default *)
         INCL(a.opts, rightFixed)
      END;
      IF thisVersion >= 2 THEN
         i := 0; WHILE i < a.tabs.len DO rd.ReadSet(a.tabs.tab[i].type); INC(i) END;
         WHILE i < n DO rd.ReadSet(trashSet); INC(i) END
      ELSE
         i := 0; WHILE i < a.tabs.len DO a.tabs.tab[i].type := {}; INC(i) END
      END
   END Internalize;
   PROCEDURE Set (p: Prop; opt: INTEGER; VAR x: INTEGER; min, max, new: INTEGER);

   BEGIN
      IF opt IN p.valid THEN x := MAX(min, MIN(max, new)) END
   END Set;
   PROCEDURE ModifyFromProp (a: Attributes; p: Properties.Property);

      CONST maxW = 10000*mm; maxH = 32767 * point;
      VAR i: INTEGER; type, mask: SET;
   BEGIN
      WHILE p # NIL DO
         WITH p: Prop DO
            Set(p, first, a.first, 0, maxW, p.first);
            Set(p, left, a.left, 0, maxW, p.left);
            Set(p, right, a.right, MAX(a.left, a.first), maxW, p.right);
            Set(p, lead, a.lead, 0, maxH, p.lead);
            Set(p, asc, a.asc, 0, maxH, p.asc);
            Set(p, dsc, a.dsc, 0, maxH - a.asc, p.dsc);
            Set(p, grid, a.grid, 1, maxH, p.grid);
            IF opts IN p.valid THEN
               a.opts := a.opts * (-p.opts.mask) + p.opts.val * p.opts.mask
            END;
            IF (tabs IN p.valid) & (p.tabs.len >= 0) THEN
               IF (p.tabs.len > 0) & (p.tabs.tab[0].stop >= 0) THEN
                  i := 0; a.tabs.len := MIN(p.tabs.len, maxTabs);
                  REPEAT
                     a.tabs.tab[i].stop := p.tabs.tab[i].stop;
                     type := p.tabs.tab[i].type; mask := tabOptions;
                     IF type * {centerTab, rightTab} = {centerTab, rightTab} THEN
                        mask := mask - {centerTab, rightTab}
                     END;
                     a.tabs.tab[i].type := a.tabs.tab[i].type * (-mask) + type * mask;
                     INC(i)
                  UNTIL (i = a.tabs.len) OR (p.tabs.tab[i].stop < p.tabs.tab[i - 1].stop);
                  a.tabs.len := i
               ELSE a.tabs.len := 0
               END
            END
         ELSE
         END;
         p := p.next
      END
   END ModifyFromProp;
   PROCEDURE (a: Attributes) ModifyFromProp- (p: Properties.Property), NEW, EXTENSIBLE;

   BEGIN
      ModifyFromProp(a, p)
   END ModifyFromProp;
   PROCEDURE (a: Attributes) InitFromProp* (p: Properties.Property), NEW, EXTENSIBLE;

   (** pre: ~a.init **)
   (** post: (a.init, p # NIL & x IN p.valid) => x set in a, else x defaults in a **)
   BEGIN
      ASSERT(~a.init, 20);
      a.init := TRUE;
      a.first := def.first; a.left := def.left; a.right := def.right;
      a.lead := def.lead; a.asc := def.asc; a.dsc := def.dsc; a.grid := def.grid;
      a.opts := def.opts;
      CopyTabs(def.tabs, a.tabs);
      ModifyFromProp(a, p)
   END InitFromProp;
   PROCEDURE (a: Attributes) Equals* (b: Attributes): BOOLEAN, NEW, EXTENSIBLE;

   (** pre: a.init, b.init **)
      VAR i: INTEGER;
   BEGIN
      ASSERT(a.init, 20); ASSERT(b.init, 21);
      IF a # b THEN
         i := 0;
         WHILE (i < a.tabs.len)
          & (a.tabs.tab[i].stop = b.tabs.tab[i].stop)
          & (a.tabs.tab[i].type = b.tabs.tab[i].type) DO
            INC(i)
         END;
         RETURN (Services.SameType(a, b))
            & (a.first = b.first) & (a.left = b.left) & (a.right = b.right)
            & (a.lead = b.lead) & (a.asc = b.asc) & (a.dsc = b.dsc) & (a.grid = b.grid)
            & (a.opts = b.opts) & (a.tabs.len = b.tabs.len) & (i = a.tabs.len)
      ELSE RETURN TRUE
      END
   END Equals;
   PROCEDURE (a: Attributes) Prop* (): Properties.Property, NEW, EXTENSIBLE;

   (** pre: a.init **)
   (** post: x attr in a => x IN p.valid, m set to value of attr in a **)
      VAR p: Prop;
   BEGIN
      ASSERT(a.init, 20);
      NEW(p);
      p.known := {first .. tabs}; p.valid := p.known;
      p.first := a.first; p.left := a.left; p.right := a.right;
      p.lead := a.lead; p.asc := a.asc; p.dsc := a.dsc; p.grid := a.grid;
      p.opts.val := a.opts; p.opts.mask := options;
      CopyTabs(a.tabs, p.tabs);
      RETURN p
   END Prop;
   PROCEDURE ReadAttr* (VAR rd: Stores.Reader; OUT a: Attributes);


      VAR st: Stores.Store; alien: AlienAttributes;
   BEGIN
      rd.ReadStore(st);
      ASSERT(st # NIL, 100);
      IF st IS Stores.Alien THEN
         NEW(alien); alien.store := st(Stores.Alien); Stores.Join(alien, alien.store);
         alien.InitFromProp(NIL); a := alien
      ELSE a := st(Attributes)
      END
   END ReadAttr;
   PROCEDURE WriteAttr* (VAR wr: Stores.Writer; a: Attributes);

   BEGIN
      ASSERT(a # NIL, 20); ASSERT(a.init, 21);
      WITH a: AlienAttributes DO wr.WriteStore(a.store) ELSE wr.WriteStore(a) END
   END WriteAttr;
   PROCEDURE ModifiedAttr* (a: Attributes; p: Properties.Property): Attributes;

   (** pre: a.init **)
   (** post: x IN p.valid => x in new attr set to value in p, else set to value in a **)
      VAR h: Attributes;
   BEGIN
      ASSERT(a.init, 20);
      h := Stores.CopyOf(a)(Attributes); h.ModifyFromProp(p);
      RETURN h
   END ModifiedAttr;
   (** AlienAttributes **)


   PROCEDURE (a: AlienAttributes) Externalize- (VAR wr: Stores.Writer);

   BEGIN
      HALT(100)
   END Externalize;
   PROCEDURE (a: AlienAttributes) Internalize- (VAR rd: Stores.Reader);

   BEGIN
      HALT(100)
   END Internalize;
   PROCEDURE (a: AlienAttributes) InitFromProp* (p: Properties.Property);

   BEGIN
      a.InitFromProp^(NIL)
   END InitFromProp;
   PROCEDURE (a: AlienAttributes) ModifyFromProp- (p: Properties.Property);

   BEGIN
      (* a.InitFromProp^(NIL) *)
      a.InitFromProp(NIL)
   END ModifyFromProp;
   (** Style **)


(*

   PROCEDURE (s: Style) PropagateDomain-, EXTENSIBLE;
      VAR dom: Stores.Domain;
   BEGIN
      ASSERT(s.attr # NIL, 20);
      dom := s.attr.Domain();
      IF (dom # NIL) & (dom # s.Domain()) THEN s.attr := Stores.CopyOf(s.attr)(Attributes) END;
      Stores.InitDomain(s.attr, s.Domain())
   END PropagateDomain;
*)
   PROCEDURE (s: Style) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;

   BEGIN
      s.Externalize^(wr);
      wr.WriteVersion(maxStyleVersion);
      WriteAttr(wr, s.attr)
   END Externalize;
   PROCEDURE (s: Style) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;

      VAR thisVersion: INTEGER;
   BEGIN
      s.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxStyleVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      ReadAttr(rd, s.attr); Stores.Join(s, s.attr)
   END Internalize;
   PROCEDURE (s: Style) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;

   (** pre: attr.init **)
   (** post: s.attr = attr OR s.attr.Equals(attr) **)
   BEGIN
      ASSERT(attr.init, 20);
      DoSetAttrOp(s, attr)
   END SetAttr;
   PROCEDURE (s: Style) CopyFrom- (source: Stores.Store), EXTENSIBLE;

   BEGIN
      WITH source: Style DO
         ASSERT(source.attr # NIL, 21);
         s.SetAttr(Stores.CopyOf(source.attr)(Attributes))
            (* bkwd-comp hack to avoid link *)
            (* copy would not be necessary if Attributes were immutable (and assigned to an Immutable Domain) *)
      END
   END CopyFrom;
   
(*
   PROCEDURE (s: Style) InitFrom- (source: Models.Model), EXTENSIBLE;
   BEGIN
      WITH source: Style DO
         ASSERT(source.attr # NIL, 21);
         s.SetAttr(Stores.CopyOf(source.attr)(Attributes))
            (* bkwd-comp hack to avoid link *)
      END
   END InitFrom;
*)
   (** Directory **)

   PROCEDURE (d: Directory) SetAttr* (attr: Attributes), NEW, EXTENSIBLE;

   (** pre: attr.init **)
   (** post: d.attr = ModifiedAttr(attr, p)
      [ p.valid = {opts, tabs}, p.tabs.len = 0, p.opts.mask = {noBreakInside.. parJoin}, p.opts.val = {} ]
   **)
      VAR p: Prop;
   BEGIN
      ASSERT(attr.init, 20);
      IF attr.tabs.len > 0 THEN
         NEW(p);
         p.valid := {opts, tabs};
         p.opts.mask := {noBreakInside, pageBreak, parJoin}; p.opts.val := {};
         p.tabs.len := 0;
         attr := ModifiedAttr(attr, p)
      END;
      d.attr := attr
   END SetAttr;
   PROCEDURE (d: Directory) NewStyle* (attr: Attributes): Style, NEW, ABSTRACT;

   PROCEDURE (d: Directory) New* (style: Style): Ruler, NEW, ABSTRACT;
   PROCEDURE (d: Directory) NewFromProp* (p: Prop): Ruler, NEW, EXTENSIBLE;

   BEGIN
      RETURN d.New(d.NewStyle(ModifiedAttr(d.attr, p)))
   END NewFromProp;
   PROCEDURE Deposit*;


   BEGIN
      Views.Deposit(dir.New(NIL))
   END Deposit;
   (** Ruler **)


   PROCEDURE (r: Ruler) Externalize- (VAR wr: Stores.Writer), EXTENSIBLE;

   BEGIN
      ASSERT(r.style # NIL, 20);
      r.Externalize^(wr);
      wr.WriteVersion(maxRulerVersion); wr.WriteStore(r.style)
   END Externalize;
   
   PROCEDURE (r: Ruler) InitStyle* (s: Style), NEW;
   (** pre: r.style = NIL, s # NIL, style.attr # NIL **)
   (** post: r.style = s **)
   BEGIN
      ASSERT((r.style = NIL) OR (r.style = s), 20);
      ASSERT(s # NIL, 21); ASSERT(s.attr # NIL, 22);
      r.style := s; Stores.Join(r, s)
   END InitStyle;
   
   PROCEDURE (r: Ruler) Internalize- (VAR rd: Stores.Reader), EXTENSIBLE;

      VAR st: Stores.Store; thisVersion: INTEGER;
   BEGIN
      r.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxRulerVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      rd.ReadStore(st);
      IF st IS Stores.Alien THEN rd.TurnIntoAlien(Stores.alienComponent); RETURN END;
      r.InitStyle(st(Style))
   END Internalize;
(*

   PROCEDURE (r: Ruler) InitModel* (m: Models.Model), EXTENSIBLE;
   (** pre: r.style = NIL, m # NIL, style.attr # NIL, m IS Style **)
   (** post: r.style = m **)
   BEGIN
      WITH m: Style DO
         ASSERT((r.style = NIL) OR (r.style = m), 20);
         ASSERT(m # NIL, 21); ASSERT(m.attr # NIL, 22);
         r.style := m
      ELSE HALT(23)
      END
   END InitModel;
*)
(*

   PROCEDURE (r: Ruler) PropagateDomain-, EXTENSIBLE;
   BEGIN
      ASSERT(r.style # NIL, 20);
      Stores.InitDomain(r.style, r.Domain())
   END PropagateDomain;
*)
   PROCEDURE CopyOf* (r: Ruler; shallow: BOOLEAN): Ruler;

      VAR v: Views.View;
   BEGIN
      ASSERT(r # NIL, 20);
      v := Views.CopyOf(r, shallow); RETURN v(Ruler)
   END CopyOf;
   (** Prop **)


   PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);

      VAR valid: SET;i: INTEGER; c, m: SET; eq: BOOLEAN;
   BEGIN
      WITH q: Prop DO
         valid := p.valid * q.valid; equal := TRUE;
         i := 0;
         WHILE (i < p.tabs.len)
         & (p.tabs.tab[i].stop = q.tabs.tab[i].stop)
         & (p.tabs.tab[i].type = q.tabs.tab[i].type)
         DO
            INC(i)
         END;
         IF p.first # q.first THEN EXCL(valid, first) END;
         IF p.left # q.left THEN EXCL(valid, left) END;
         IF p.right # q.right THEN EXCL(valid, right) END;
         IF p.lead # q.lead THEN EXCL(valid, lead) END;
         IF p.asc # q.asc THEN EXCL(valid, asc) END;
         IF p.dsc # q.dsc THEN EXCL(valid, dsc) END;
         IF p.grid # q.grid THEN EXCL(valid, grid) END;
         Properties.IntersectSelections(p.opts.val, p.opts.mask, q.opts.val, q.opts.mask, c, m, eq);
         IF m = {} THEN EXCL(valid, opts)
         ELSIF (opts IN valid) & ~eq THEN p.opts.mask := m; equal := FALSE
         END;
         IF (p.tabs.len # q.tabs.len) OR (q.tabs.len # i) THEN EXCL(valid, tabs) END;
         IF p.valid # valid THEN p.valid := valid; equal := FALSE END
      END
   END IntersectWith;
   (** ruler construction **)


(*property-based facade procedures *)

   PROCEDURE SetFirst* (r: Ruler; x: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {first}; prop.first := x;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetFirst;
   PROCEDURE SetLeft* (r: Ruler; x: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {left}; prop.left := x;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetLeft;
   PROCEDURE SetRight* (r: Ruler; x: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {right}; prop.right := x;
      prop.opts.mask := {rightFixed}; prop.opts.val := {};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetRight;
   PROCEDURE SetFixedRight* (r: Ruler; x: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {right, opts}; prop.right := x;
      prop.opts.mask := {rightFixed}; prop.opts.val := {rightFixed};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetFixedRight;
   PROCEDURE SetLead* (r: Ruler; h: INTEGER);


   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {lead}; prop.lead := h;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetLead;
   PROCEDURE SetAsc* (r: Ruler; h: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {asc}; prop.asc := h;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetAsc;
   PROCEDURE SetDsc* (r: Ruler; h: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {dsc}; prop.dsc := h;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetDsc;
   PROCEDURE SetGrid* (r: Ruler; h: INTEGER);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {grid}; prop.grid := h;
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetGrid;
   PROCEDURE SetLeftFlush* (r: Ruler);


   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {leftAdjust};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetLeftFlush;
   PROCEDURE SetRightFlush* (r: Ruler);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {rightAdjust};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetRightFlush;
   PROCEDURE SetCentered* (r: Ruler);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetCentered;
   PROCEDURE SetJustified* (r: Ruler);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {leftAdjust, rightAdjust}; prop.opts.val := {leftAdjust, rightAdjust};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetJustified;
   PROCEDURE SetNoBreakInside* (r: Ruler);


   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {noBreakInside}; prop.opts.val := {noBreakInside};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetNoBreakInside;
   PROCEDURE SetPageBreak* (r: Ruler);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {pageBreak}; prop.opts.val := {pageBreak};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetPageBreak;
   PROCEDURE SetParJoin* (r: Ruler);

   BEGIN
      ASSERT(r.style # NIL, 20);
      prop.valid := {opts};
      prop.opts.mask := {parJoin}; prop.opts.val := {parJoin};
      r.style.SetAttr(ModifiedAttr(r.style.attr, prop))
   END SetParJoin;
   PROCEDURE AddTab* (r: Ruler; x: INTEGER);


      VAR ra: Attributes; i: INTEGER;
   BEGIN
      ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i < maxTabs, 21);
      ASSERT((i = 0) OR (ra.tabs.tab[i - 1].stop < x), 22);
      prop.valid := {tabs};
      CopyTabs(ra.tabs, prop.tabs);
      prop.tabs.tab[i].stop := x; prop.tabs.tab[i].type := {}; INC(prop.tabs.len);
      r.style.SetAttr(ModifiedAttr(ra, prop))
   END AddTab;
   PROCEDURE MakeCenterTab* (r: Ruler);

      VAR ra: Attributes; i: INTEGER;
   BEGIN
      ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
      prop.valid := {tabs};
      CopyTabs(ra.tabs, prop.tabs);
      prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type + {centerTab} - {rightTab};
      r.style.SetAttr(ModifiedAttr(ra, prop))
   END MakeCenterTab;
   PROCEDURE MakeRightTab* (r: Ruler);

      VAR ra: Attributes; i: INTEGER;
   BEGIN
      ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
      prop.valid := {tabs};
      CopyTabs(ra.tabs, prop.tabs);
      prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type - {centerTab} + {rightTab};
      r.style.SetAttr(ModifiedAttr(ra, prop))
   END MakeRightTab;
   PROCEDURE MakeBarTab* (r: Ruler);

      VAR ra: Attributes; i: INTEGER;
   BEGIN
      ASSERT(r.style # NIL, 20); ra := r.style.attr; i := ra.tabs.len; ASSERT(i > 0, 21);
      prop.valid := {tabs};
      CopyTabs(ra.tabs, prop.tabs);
      prop.tabs.tab[i - 1].type := prop.tabs.tab[i - 1].type + {barTab};
      r.style.SetAttr(ModifiedAttr(ra, prop))
   END MakeBarTab;
   (* SetAttrOp *)


   PROCEDURE (op: SetAttrOp) Do;

      VAR s: Style; attr: Attributes; upd: UpdateMsg;
   BEGIN
      s := op.style;
      attr := s.attr; s.attr := op.attr; op.attr := attr;
      (*Stores.InitDomain(s.attr, s.Domain());*) (* Stores.Join(s, s.attr); *)
      ASSERT((s.attr=NIL) OR Stores.Joined(s, s.attr), 100);
      upd.style := s; upd.oldAttr := attr; Models.Domaincast(s.Domain(), upd)
   END Do;
   PROCEDURE DoSetAttrOp (s: Style; attr: Attributes);

      VAR op: SetAttrOp;
   BEGIN
      IF (s.attr # attr) OR ~s.attr.Equals(attr) THEN
         (* IF attr.Domain() # s.Domain() THEN attr := Stores.CopyOf(attr)(Attributes) END; *)
         IF ~Stores.Joined(s, attr) THEN
            IF ~Stores.Unattached(attr) THEN attr := Stores.CopyOf(attr)(Attributes) END;
            Stores.Join(s, attr)
         END;
         NEW(op); op.style := s; op.attr := attr;
         Models.Do(s, rulerChangeKey, op)
      END
   END DoSetAttrOp;
   (* grid definitions *)


   PROCEDURE MarginGrid (x: INTEGER): INTEGER;

   BEGIN
      RETURN (x + marginGrid DIV 2) DIV marginGrid * marginGrid
   END MarginGrid;
   PROCEDURE TabGrid (x: INTEGER): INTEGER;

   BEGIN
      RETURN (x + tabGrid DIV 2) DIV tabGrid * tabGrid
   END TabGrid;
   (* nice graphical primitives *)


   PROCEDURE DrawCenteredInt (f: Views.Frame; x, y, n: INTEGER);

      VAR sw: INTEGER; s: ARRAY 32 OF CHAR;
   BEGIN
      Strings.IntToString(n, s); sw := font.StringWidth(s);
      f.DrawString(x - sw DIV 2, y, Ports.defaultColor, s, font)
   END DrawCenteredInt;
   PROCEDURE DrawNiceRect (f: Views.Frame; l, t, r, b: INTEGER);

      VAR u: INTEGER;
   BEGIN
      u := f.dot;
      f.DrawRect(l, t, r - u, b - u, 0, Ports.defaultColor);
      f.DrawLine(l + u, b - u, r - u, b - u, u, Ports.grey25);
      f.DrawLine(r - u, t + u, r - u, b - u, u, Ports.grey25)
   END DrawNiceRect;
   PROCEDURE DrawScale (f: Views.Frame; l, t, r, b, clipL, clipR: INTEGER);

      VAR u, h, x, px, sw: INTEGER; i, n, d1, d2: INTEGER; s: ARRAY 32 OF CHAR;
   BEGIN
      f.DrawRect(l, t, r, b, Ports.fill, Ports.grey12);
      u := f.dot;
      IF Dialog.metricSystem THEN d1 := 2; d2 := 10 ELSE d1 := 2; d2 := 16 END;
      DEC(b, point);
      sw := 2*u + font.StringWidth("8888888888");
      x := l + tabGrid; i := 0; n := 0;
      WHILE x <= r DO
         INC(i); px := TabGrid(x);
         IF i = d2 THEN
            h := 6*point; i := 0; INC(n);
            IF (px >= clipL - sw) & (px < clipR) THEN
               Strings.IntToString(n, s);
               f.DrawString(px - 2*u - font.StringWidth(s), b - 3*point, Ports.defaultColor, s, font)
            END
         ELSIF i MOD d1 = 0 THEN
            h := 2*point
         ELSE
            h := 0
         END;
         IF (px >= clipL) & (px < clipR) & (h > 0) THEN
            f.DrawLine(px, b, px, b - h, 0, Ports.defaultColor)
         END;
         INC(x, tabGrid)
      END
   END DrawScale;
   PROCEDURE InvertTabMark (f: Views.Frame; l, t, r, b: INTEGER; type: SET; show: BOOLEAN);

      VAR u, u2, u3, yc, i, ih: INTEGER;
   BEGIN
      u := f.dot; u2 := 2*u; u3 := 3*u;
      IF ~ODD((r - l) DIV u) THEN DEC(r, u) END;
      yc := l + (r - l) DIV u DIV 2 * u;
      IF barTab IN type THEN
         f.MarkRect(yc, b - u3, yc + u, b - u2, Ports.fill, Ports.invert, show);
         f.MarkRect(yc, b - u, yc + u, b, Ports.fill, Ports.invert, show)
      END;
      IF centerTab IN type THEN
         f.MarkRect(l + u, b - u2, r - u, b - u, Ports.fill, Ports.invert, show)
      ELSIF rightTab IN type THEN
         f.MarkRect(l, b - u2, yc + u, b - u, Ports.fill, Ports.invert, show)
      ELSE
         f.MarkRect(yc, b - u2, r, b - u, Ports.fill, Ports.invert, show)
      END;
      DEC(b, u3); INC(l, u2); DEC(r, u2);
      ih := (r - l) DIV 2;
      i := b - t; t := b - u;
      WHILE (i > 0) & (r > l) DO
         DEC(i, u);
         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
         IF i <= ih THEN INC(l, u); DEC(r, u) END;
         DEC(t, u); DEC(b, u)
      END
   END InvertTabMark;
   PROCEDURE InvertFirstMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);

      VAR u, i, ih: INTEGER;
   BEGIN
      u := f.dot;
      i := b - t; t := b - u;
      ih := r - l;
      WHILE (i > 0) & (r > l) DO
         DEC(i, u);
         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
         IF i <= ih THEN DEC(r, u) END;
         DEC(t, u); DEC(b, u)
      END
   END InvertFirstMark;
   PROCEDURE InvertLeftMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);

      VAR u, i, ih: INTEGER;
   BEGIN
      u := f.dot;
      i := b - t; b := t + u;
      ih := r - l;
      WHILE (i > 0) & (r > l) DO
         DEC(i, u);
         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
         IF i <= ih THEN DEC(r, u) END;
         INC(t, u); INC(b, u)
      END
   END InvertLeftMark;
   PROCEDURE InvertRightMark (f: Views.Frame; l, t, r, b: INTEGER; show: BOOLEAN);

      VAR u, i, ih: INTEGER;
   BEGIN
      u := f.dot;
      IF ~ODD((b - t) DIV u) THEN INC(t, u) END;
      ih := r - l; l := r - u;
      i := b - t; b := t + u;
      WHILE (i > 0) & (i > ih) DO
         DEC(i, u);
         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
         DEC(l, u);
         INC(t, u); INC(b, u)
      END;
      WHILE (i > 0) & (r > l) DO
         DEC(i, u);
         f.MarkRect(l, t, r, b, Ports.fill, Ports.invert, show);
         INC(l, u);
         INC(t, u); INC(b, u)
      END
   END InvertRightMark;
   (* marks *)


   PROCEDURE SetMark (VAR m: Mark; r: StdRuler; px, py: INTEGER; kind, index: INTEGER);

   BEGIN
      m.ruler := r; m.kind := kind;
      m.px := px; m.py := py;
      CASE kind OF
      first:
         m.l := px; m.r := m.l + 4*point;
         m.b := py - 7*point; m.t := m.b - 4*point
      | left:
         m.l := px; m.r := m.l + 4*point;
         m.b := py - 2*point; m.t := m.b - 4*point
      | right:
         m.r := px; m.l := m.r - 4*point;
         m.b := py - 3*point; m.t := m.b - 7*point
      | tabs:
         m.l := px - 4*point; m.r := m.l + 9*point;
         m.b := py - 5*point; m.t := m.b - 6*point;
         m.type := r.style.attr.tabs.tab[index].type
      | firstIcon .. lastIcon:
         m.l := px; m.r := px + iconWidth;
         m.t := py; m.b := py + iconHeight
      ELSE HALT(100)
      END
   END SetMark;
   PROCEDURE Try (VAR m: Mark; r: StdRuler; px, py, x, y: INTEGER; kind, index: INTEGER);

   BEGIN
      IF m.kind = invalid THEN
         SetMark(m, r, px, py, kind, index);
         IF (m.l - point <= x) & (x < m.r + point) & (m.t - point <= y) & (y < m.b + point) THEN
            m.px0 := m.px; m.py0 := m.py; m.x := x; m.y := y;
            IF kind = tabs THEN
               m.index := index; CopyTabs(r.style.attr.tabs, m.tabs)
            END
         ELSE
            m.kind := invalid
         END
      END
   END Try;
   PROCEDURE InvertMark (VAR m: Mark; f: Views.Frame; show: BOOLEAN);

   (* pre: kind # invalid *)
   BEGIN
      CASE m.kind OF
      first: InvertFirstMark(f, m.l, m.t, m.r, m.b, show)
      | left: InvertLeftMark(f, m.l, m.t, m.r, m.b, show)
      | right: InvertRightMark(f, m.l, m.t, m.r, m.b, show)
      | tabs: InvertTabMark(f, m.l, m.t, m.r, m.b, m.type, show)
      END
   END InvertMark;
   PROCEDURE HiliteMark (VAR m: Mark; f: Views.Frame; show: BOOLEAN);

   BEGIN
      f.MarkRect(m.l, m.t, m.r - point, m.b - point, Ports.fill, Ports.hilite, show)
   END HiliteMark;
   PROCEDURE HiliteThisMark (r: StdRuler; f: Views.Frame; kind: INTEGER; show: BOOLEAN);

      VAR m: Mark; px,w, h: INTEGER;
   BEGIN
      IF (kind # invalid) & (kind IN validIcons) THEN
         px := iconGap + (kind - firstIcon) * (iconWidth + iconGap);
         r.context.GetSize(w, h);
         SetMark(m, r, px, h - iconPin, kind, -1);
         HiliteMark(m, f, show)
      END
   END HiliteThisMark;
   PROCEDURE DrawMark (VAR m: Mark; f: Views.Frame);

   (* pre: kind # invalid *)
      VAR a: Attributes; l, t, r, b, y, d, e, asc, dsc, fw: INTEGER; i: INTEGER;
         w: ARRAY 4 OF INTEGER;
   BEGIN
      a := m.ruler.style.attr;
      l := m.l + 2 * point; t := m.t + 2 * point; r := m.r - 4 * point; b := m.b - 3 * point;
      font.GetBounds(asc, dsc, fw);
      y := (m.t + m.b + asc) DIV 2;
      w[0] := (r - l) DIV 2; w[1] := r - l; w[2] := (r - l) DIV 3; w[3] := (r - l) * 2 DIV 3;
      CASE m.kind OF
      rightToggle:
         IF rightFixed IN a.opts THEN
            d := 0; y := (t + b) DIV 2 - point; e := (l + r) DIV 2 + point;
            WHILE t < y DO
               f.DrawLine(e - d, t, e, t, point, Ports.defaultColor); INC(d, point); INC(t, point)
            END;
            WHILE t < b DO
               f.DrawLine(e - d, t, e, t, point, Ports.defaultColor); DEC(d, point); INC(t, point)
            END
         ELSE
            DEC(b, point);
            f.DrawLine(l, t, r, t, point, Ports.defaultColor);
            f.DrawLine(l, b, r, b, point, Ports.defaultColor);
            f.DrawLine(l, t, l, b, point, Ports.defaultColor);
            f.DrawLine(r, t, r, b, point, Ports.defaultColor)
         END
      | gridDec:
         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
      | gridVal:
         DrawCenteredInt(f, (l + r) DIV 2, y, a.grid DIV point)
      | gridInc:
         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 3 * point) END
      | leftFlush:
         i := 0;
         WHILE t < b DO
            d := w[i]; i := (i + 1) MOD LEN(w);
            f.DrawLine(l, t, l + d, t, point, Ports.defaultColor); INC(t, 2 * point)
         END
      | centered:
         i := 0;
         WHILE t < b DO
            d := (r - l - w[i]) DIV 2; i := (i + 1) MOD LEN(w);
            f.DrawLine(l + d, t, r - d, t, point, Ports.defaultColor); INC(t, 2 * point)
         END
      | rightFlush:
         i := 0;
         WHILE t < b DO
            d := w[i]; i := (i + 1) MOD LEN(w);
            f.DrawLine(r - d, t, r, t, point, Ports.defaultColor); INC(t, 2 * point)
         END
      | justified:
         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
      | leadDec:
         f.DrawLine(l, t, l, t + point, point, Ports.defaultColor); INC(t, 2 * point);
         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
      | leadVal:
         DrawCenteredInt(f, (l + r) DIV 2, y, m.ruler.style.attr.lead DIV point)
      | leadInc:
         f.DrawLine(l, t, l, t + 3 * point, point, Ports.defaultColor); INC(t, 4 * point);
         WHILE t < b DO f.DrawLine(l, t, r, t, point, Ports.defaultColor); INC(t, 2 * point) END
      | pageBrk:
         DEC(b, point);
         IF pageBreak IN a.opts THEN
            y := (t + b) DIV 2 - point;
            f.DrawLine(l, t, l, y, point, Ports.defaultColor);
            f.DrawLine(r, t, r, y, point, Ports.defaultColor);
            f.DrawLine(l, y, r, y, point, Ports.defaultColor);
            INC(y, 2 * point);
            f.DrawLine(l, y, r, y, point, Ports.defaultColor);
            f.DrawLine(l, y, l, b, point, Ports.defaultColor);
            f.DrawLine(r, y, r, b, point, Ports.defaultColor)
         ELSE
            f.DrawLine(l, t, l, b, point, Ports.defaultColor);
            f.DrawLine(r, t, r, b, point, Ports.defaultColor)
         END
      ELSE
         HALT(100)
      END;
      IF ~(m.kind IN {gridVal, leadVal}) THEN
         DrawNiceRect(f, m.l, m.t, m.r, m.b)
      END
   END DrawMark;
   PROCEDURE GetMark (VAR m: Mark; r: StdRuler; f: Views.Frame;

      x, y: INTEGER; canCreate: BOOLEAN
   );
   (* pre: ~canCreate OR (f # NIL) *)
      VAR a: Attributes; px,w, h: INTEGER; i: INTEGER;
   BEGIN
      m.kind := invalid; m.dirty := FALSE;
      a := r.style.attr;
      r.context.GetSize(w, h);
      (* first try scale *)

      Try(m, r, a.first, h, x, y, first, 0);
      Try(m, r, a.left, h, x, y, left, 0);
      IF rightFixed IN a.opts THEN
         Try(m, r, a.right, h, x, y, right, 0)
      END;
      i := 0;
      WHILE (m.kind = invalid) & (i < a.tabs.len) DO
         Try(m, r, a.tabs.tab[i].stop, h, x, y, tabs, i);
         INC(i)
      END;
      IF (m.kind = invalid) & (y >= h - tabBarHeight) & (a.tabs.len < maxTabs) THEN
         i := 0; px := TabGrid(x);
         WHILE (i < a.tabs.len) & (a.tabs.tab[i].stop < px) DO INC(i) END;
         IF (i = 0) OR (px - a.tabs.tab[i - 1].stop >= minTabWidth) THEN
            IF (i = a.tabs.len) OR (a.tabs.tab[i].stop - px >= minTabWidth) THEN
               IF canCreate THEN   (* set new tab stop, initially at end of list *)
                  m.kind := tabs; m.index := a.tabs.len; m.dirty := TRUE;
                  CopyTabs(a.tabs, m.tabs); m.tabs.len := a.tabs.len + 1;
                  m.tabs.tab[a.tabs.len].stop := px; m.tabs.tab[a.tabs.len].type := {};
                  a.tabs.tab[a.tabs.len].stop := px; a.tabs.tab[a.tabs.len].type := {};
                  SetMark(m, r, px, h, tabs, m.index); InvertMark(m, f, Ports.show);
                  m.px0 := m.px; m.py0 := m.py; m.x := x; m.y := y
               END
            END
         END
      END;
      (* next try icon bar *)

      px := iconGap; i := firstIcon;
      WHILE i <= lastIcon DO
         IF i IN validIcons THEN
            Try(m, r, px, h - iconPin, x, y, i, 0)
         END;
         INC(px, iconWidth + iconGap); INC(i)
      END
   END GetMark;
   PROCEDURE SelectMark (r: StdRuler; f: Views.Frame; IN m: Mark);

   BEGIN
      r.sel := m.kind; r.px := m.px; r.py := m.py
   END SelectMark;
   PROCEDURE DeselectMark (r: StdRuler; f: Views.Frame);

   BEGIN
      HiliteThisMark(r, f, r.sel, Ports.hide); r.sel := invalid
   END DeselectMark;
   (* mark interaction *)


   PROCEDURE Mode (r: StdRuler): INTEGER;

      VAR a: Attributes; i: INTEGER;
   BEGIN
      a := r.style.attr;
      IF a.opts * adjMask = {leftAdjust} THEN
         i := leftFlush
      ELSIF a.opts * adjMask = {} THEN
         i := centered
      ELSIF a.opts * adjMask = {rightAdjust} THEN
         i := rightFlush
      ELSE (* a.opts * adjMask = adjMask *)
         i := justified
      END;
      RETURN i
   END Mode;
   PROCEDURE GrabMark (VAR m: Mark; r: StdRuler; f: Views.Frame; x, y: INTEGER);

   BEGIN
      GetMark(m, r, f, x, y, TRUE);
      DeselectMark(r, f);
      IF m.kind = Mode(r) THEN m.kind := invalid END
   END GrabMark;
   PROCEDURE TrackMark (VAR m: Mark; f: Views.Frame; x, y: INTEGER; modifiers: SET);

      VAR px, py,w, h: INTEGER;
   BEGIN
      IF m.kind # invalid THEN
         px := m.px + x - m.x; py := m.py + y - m.y;
         IF m.kind = tabs THEN
            px := TabGrid(px)
         ELSIF m.kind IN validIcons THEN
            IF (m.l <= x) & (x < m.r) THEN px := 1 ELSE px := 0 END
         ELSE
            px := MarginGrid(px)
         END;
         IF m.kind IN {right, tabs} THEN
            m.ruler.context.GetSize(w, h);
            IF (0 <= y) & (y < h + scaleHeight) OR (Controllers.extend IN modifiers) THEN
               py := h
            ELSE
               py := -1   (* moved mark out of ruler: delete tab stop or fixed right margin *)
            END
         ELSIF m.kind IN validIcons THEN
            IF (m.t <= y) & (y < m.b) THEN py := 1 ELSE py := 0 END
         ELSE
            py := MarginGrid(py)
         END;
         IF (m.kind IN {right, tabs}) & ((m.px # px) OR (m.py # py)) THEN
            INC(m.x, px - m.px); INC(m.y, py - m.py);
            InvertMark(m, f, Ports.hide); SetMark(m, m.ruler, px, py, m.kind, m.index);
            InvertMark(m, f, Ports.show);
            m.dirty := TRUE
         ELSIF (m.kind IN {first, left}) & (m.px # px) THEN
            INC(m.x, px - m.px);
            InvertMark(m, f, Ports.hide); SetMark(m, m.ruler, px, m.py, m.kind, m.index);
            InvertMark(m, f, Ports.show)
         ELSIF (m.kind IN validIcons) & (m.px * m.py # px * py) THEN
            HiliteMark(m, f, Ports.show);
            IF m.kind IN modeIcons THEN HiliteThisMark(m.ruler, f, Mode(m.ruler), Ports.hide) END;
            m.px := px; m.py := py
         END
      END
   END TrackMark;
   PROCEDURE ShiftMarks (a: Attributes; p: Prop; mask: SET; x0, dx: INTEGER);

      VAR new: SET; i, j, t0, t1: INTEGER; tab0, tab1: TabArray;
   BEGIN
      new := mask - p.valid;
      IF first IN new THEN p.first := a.first END;
      IF tabs IN new THEN CopyTabs(a.tabs, p.tabs) END;
      p.valid := p.valid + mask;
      IF first IN mask THEN INC(p.first, dx) END;
      IF tabs IN mask THEN
         i := 0;
         WHILE (i < p.tabs.len) & (p.tabs.tab[i].stop < x0) DO tab0.tab[i] := p.tabs.tab[i]; INC(i) END;
         t0 := i;
         t1 := 0;
         WHILE i < p.tabs.len DO
            tab1.tab[t1].stop := p.tabs.tab[i].stop + dx;
            tab1.tab[t1].type := p.tabs.tab[i].type;
            INC(t1); INC(i)
         END;
         i := 0; j := 0; p.tabs.len := 0;
         WHILE i < t0 DO   (* merge sort *)
            WHILE (j < t1) & (tab1.tab[j].stop < tab0.tab[i].stop) DO
               p.tabs.tab[p.tabs.len] := tab1.tab[j]; INC(p.tabs.len); INC(j)
            END;
            IF (j < t1) & (tab1.tab[j].stop = tab0.tab[i].stop) THEN INC(j) END;
            p.tabs.tab[p.tabs.len] := tab0.tab[i]; INC(p.tabs.len); INC(i)
         END;
         WHILE j < t1 DO
            p.tabs.tab[p.tabs.len] := tab1.tab[j]; INC(p.tabs.len); INC(j)
         END
      END
   END ShiftMarks;
   PROCEDURE ShiftDependingMarks (VAR m: Mark; p: Prop);

      VAR a: Attributes; dx: INTEGER;
   BEGIN
      a := m.ruler.style.attr; dx := m.px - m.px0;
      CASE m.kind OF
      first: ShiftMarks(a, p, {tabs}, 0, dx)
      | left: ShiftMarks(a, p, {first, tabs}, 0, dx)
      | tabs: ShiftMarks(a, p, {tabs}, m.px0, dx)
      ELSE
      END
   END ShiftDependingMarks;
   PROCEDURE AdjustMarks (VAR m: Mark; f: Views.Frame; modifiers: SET);

      VAR r: StdRuler; a: Attributes; p: Prop;
         g: INTEGER; i, j: INTEGER; shift: BOOLEAN; type: SET;
   BEGIN
      r := m.ruler;
      IF(m.kind # invalid) & (m.kind IN validIcons)
            & (m.px = 1) & (m.py = 1)
      OR (m.kind # invalid) & ~(m.kind IN validIcons)
            & ((m.px # m.px0) OR (m.py # m.py0)
               OR (m.kind = tabs) (*(m.tabs.len # r.style.attr.tabs.len)*) )
      THEN
         a := r.style.attr; NEW(p);
         p.valid := {};
         shift := (Controllers.modify IN modifiers) & (m.tabs.len = r.style.attr.tabs.len);
         CASE m.kind OF
         first:
            p.valid := {first}; p.first := m.px
         | left:
            p.valid := {left}; p.left := m.px
         | right:
            IF m.py >= 0 THEN
               p.valid := {right}; p.right := m.px
            ELSE
               p.valid := {opts}; p.opts.val := {}; p.opts.mask := {rightFixed}
            END
         | tabs:
            IF ~m.dirty THEN
               p.valid := {tabs}; CopyTabs(m.tabs, p.tabs);
               i := m.index; type := m.tabs.tab[i].type;
               IF shift THEN
                  type := type * {barTab};
                  IF type = {} THEN type := {barTab}
                  ELSE type := {}
                  END;
                  p.tabs.tab[i].type := p.tabs.tab[i].type - {barTab} + type
               ELSE
                  type := type * {centerTab, rightTab};
                  IF type = {} THEN type := {centerTab}
                  ELSIF type = {centerTab} THEN type := {rightTab}
                  ELSE type := {}
                  END;
                  p.tabs.tab[i].type := p.tabs.tab[i].type - {centerTab, rightTab} + type
               END
            ELSIF ~shift THEN
               p.valid := {tabs}; p.tabs.len := m.tabs.len - 1;
               i := 0;
               WHILE i < m.index DO p.tabs.tab[i] := m.tabs.tab[i]; INC(i) END;
               INC(i);
               WHILE i < m.tabs.len DO p.tabs.tab[i - 1] := m.tabs.tab[i]; INC(i) END;
               i := 0;
               WHILE (i < p.tabs.len) & (p.tabs.tab[i].stop < m.px) DO INC(i) END;
               IF (m.px >= MIN(a.first, a.left)) & (m.px <= f.r) & (m.py >= 0)
                & ((i = 0) OR (m.px - p.tabs.tab[i - 1].stop >= minTabWidth))
                & ((i = p.tabs.len) OR (p.tabs.tab[i].stop - m.px >= minTabWidth)) THEN
                  j := p.tabs.len;
                  WHILE j > i DO p.tabs.tab[j] := p.tabs.tab[j - 1]; DEC(j) END;
                  p.tabs.tab[i].stop := m.px; p.tabs.tab[i].type := m.tabs.tab[m.index].type;
                  INC(p.tabs.len)
               END;
               i := 0;
               WHILE (i < p.tabs.len)
                & (p.tabs.tab[i].stop = a.tabs.tab[i].stop)
                & (p.tabs.tab[i].type = a.tabs.tab[i].type) DO
                  INC(i)
               END;
               IF (i = p.tabs.len) & (p.tabs.len = a.tabs.len) THEN RETURN END   (* did not change *)
            END
         | rightToggle:
            p.valid := {right, opts};
            IF ~(rightFixed IN a.opts) THEN
               p.right := f.r DIV marginGrid * marginGrid
            END;
            p.opts.val := a.opts / {rightFixed}; p.opts.mask := {rightFixed}
         | gridDec:
            p.valid := {asc, grid}; g := a.grid - point;
            IF g = 0 THEN p.grid := 1; p.asc := 0 ELSE p.grid := g; p.asc := g - a.dsc END
         | gridVal:
            SelectMark(r, f, m); RETURN
         | gridInc:
            p.valid := {asc, grid}; g := a.grid + point; DEC(g, g MOD point);
            p.grid := g; p.asc := g - a.dsc
         | leftFlush:
            p.valid := {opts}; p.opts.val := {leftAdjust}; p.opts.mask := adjMask
         | centered:
            p.valid := {opts}; p.opts.val := {}; p.opts.mask := adjMask
         | rightFlush:
            p.valid := {opts}; p.opts.val := {rightAdjust}; p.opts.mask := adjMask
         | justified:
            p.valid := {opts}; p.opts.val := adjMask; p.opts.mask := adjMask
         | leadDec:
            p.valid := {lead}; p.lead := a.lead - point
         | leadVal:
            SelectMark(r, f, m); RETURN
         | leadInc:
            p.valid := {lead}; p.lead := a.lead + point
         | pageBrk:
            p.valid := {opts}; p.opts.val := a.opts / {pageBreak}; p.opts.mask := {pageBreak}
         ELSE HALT(100)
         END;
         IF shift THEN ShiftDependingMarks(m, p) END;
         IF m.kind IN validIcons - modeIcons THEN HiliteMark(m, f, Ports.hide) END;
         r.style.SetAttr(ModifiedAttr(a, p))

      END
   END AdjustMarks;
   (* primitivies for standard ruler *)


   PROCEDURE Track (r: StdRuler; f: Views.Frame; IN msg: Controllers.TrackMsg);

      VAR m: Mark; x, y, res: INTEGER; modifiers: SET; isDown: BOOLEAN;
         cmd: ARRAY 128 OF CHAR;
   BEGIN
      GrabMark(m, r, f, msg.x, msg.y);
      REPEAT
         f.Input(x, y, modifiers, isDown); TrackMark(m, f, x, y, modifiers)
      UNTIL ~isDown;
      AdjustMarks(m, f, modifiers);
      IF Controllers.doubleClick IN msg.modifiers THEN
         CASE m.kind OF
         | invalid:
            Dialog.MapString("#Text:OpenRulerDialog", cmd); Dialog.Call(cmd, "", res)
         | gridVal, leadVal:
            Dialog.MapString("#Text:OpenSizeDialog", cmd); Dialog.Call(cmd, "", res)
         ELSE
         END
      END
   END Track;
   PROCEDURE Edit (r: StdRuler; f: Views.Frame; VAR msg: Controllers.EditMsg);

      VAR v: Views.View;
   BEGIN
      CASE msg.op OF
      Controllers.copy:
         msg.view := Views.CopyOf(r, Views.deep);
         msg.isSingle := TRUE
      | Controllers.paste:
         v := msg.view;
         WITH v: Ruler DO r.style.SetAttr(v.style.attr) ELSE END
      ELSE
      END
   END Edit;
   PROCEDURE PollOps (r: StdRuler; f: Views.Frame; VAR msg: Controllers.PollOpsMsg);

   BEGIN
      msg.type := "TextRulers.Ruler";
      msg.pasteType := "TextRulers.Ruler";
      msg.selectable := FALSE;
      msg.valid := {Controllers.copy, Controllers.paste}
   END PollOps;
   PROCEDURE SetProp (r: StdRuler; VAR msg: Properties.SetMsg; VAR requestFocus: BOOLEAN);

      VAR a1: Attributes; px, py, g: INTEGER; sel: INTEGER;
         p: Properties.Property; sp: Properties.StdProp; rp: Prop;
   BEGIN
      p := msg.prop; sel := r.sel; px := r.px; py := r.py;
      IF sel # invalid THEN
         WHILE (p # NIL) & ~(p IS Properties.StdProp) DO p := p.next END;
         IF p # NIL THEN
            sp := p(Properties.StdProp);
            IF (r.sel = leadVal) & (Properties.size IN sp.valid) THEN
               NEW(rp); rp.valid := {lead};
               rp.lead := sp.size
            ELSIF (r.sel = gridVal) & (Properties.size IN sp.valid) THEN
               g := sp.size; DEC(g, g MOD point);
               NEW(rp); rp.valid := {asc, grid};
               IF g = 0 THEN rp.asc := 0; rp.grid := 1
               ELSE rp.asc := g - r.style.attr.dsc; rp.grid := g
               END
            ELSE
               rp := NIL
            END
         END;
         p := rp
      END;
      a1 := ModifiedAttr(r.style.attr, p);
      IF ~a1.Equals(r.style.attr) THEN
         r.style.SetAttr(a1);
         IF requestFocus & (r.sel = invalid) THEN   (* restore mark selection *)
            r.sel := sel; r.px := px; r.py := py
         END
      ELSE requestFocus := FALSE
      END
   END SetProp;
   PROCEDURE PollProp (r: StdRuler; VAR msg: Properties.PollMsg);

      VAR p: Properties.StdProp;
   BEGIN
      CASE r.sel OF
      invalid:
         msg.prop := r.style.attr.Prop()
      | leadVal:
         NEW(p); p.known := {Properties.size}; p.valid := p.known;
         p.size := r.style.attr.lead;
         msg.prop := p
      | gridVal:
         NEW(p); p.known := {Properties.size}; p.valid := p.known;
         p.size := r.style.attr.grid;
         msg.prop := p
      ELSE HALT(100)
      END
   END PollProp;
   (* StdStyle *)


   PROCEDURE (r: StdStyle) Internalize (VAR rd: Stores.Reader);

      VAR thisVersion: INTEGER;
   BEGIN
      r.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxStdStyleVersion, thisVersion)
   END Internalize;
   PROCEDURE (r: StdStyle) Externalize (VAR wr: Stores.Writer);

   BEGIN
      r.Externalize^(wr);
      wr.WriteVersion(maxStdStyleVersion)
   END Externalize;
(*   
   PROCEDURE (r: StdStyle) CopyFrom (source: Stores.Store);
   BEGIN
      r.SetAttr(source(StdStyle).attr)
   END CopyFrom;
*)
   (* StdRuler *)

   PROCEDURE (r: StdRuler) Internalize (VAR rd: Stores.Reader);

      VAR thisVersion: INTEGER;
   BEGIN
      r.Internalize^(rd);
      IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(minVersion, maxStdRulerVersion, thisVersion);
      IF rd.cancelled THEN RETURN END;
      r.sel := invalid
   END Internalize;
   PROCEDURE (r: StdRuler) Externalize (VAR wr: Stores.Writer);

   BEGIN
      r.Externalize^(wr);
      wr.WriteVersion(maxStdRulerVersion)
   END Externalize;
   PROCEDURE (r: StdRuler) ThisModel (): Models.Model;

   BEGIN
      RETURN r.style
   END ThisModel;
   PROCEDURE (r: StdRuler) CopyFromModelView (source: Views.View; model: Models.Model);

   BEGIN
      r.sel := invalid; r.InitStyle(model(Style))
   END CopyFromModelView;
   PROCEDURE (ruler: StdRuler) Restore (f: Views.Frame; l, t, r, b: INTEGER);

      VAR a: Attributes; m: Mark; u, scale, tabBar,px,w, h: INTEGER; i: INTEGER;
   BEGIN
      u := f.dot; a := ruler.style.attr;
      ruler.context.GetSize(w, h);
      tabBar := h - tabBarHeight; scale := tabBar - scaleHeight;
      w := MIN(f.r + 10 * mm, 10000 * mm);   (* high-level clipping *)
      f.DrawLine(0, scale - u, w - u, scale - u, u, Ports.grey25);
      f.DrawLine(0, tabBar - u, w - u, tabBar - u, u, Ports.grey50);
      DrawScale(f, 0, scale, w, tabBar, l, r);
      DrawNiceRect(f, 0, h - rulerHeight, w, h);
      SetMark(m, ruler, a.first, h, first, -1); InvertMark(m, f, Ports.show);
      SetMark(m, ruler, a.left, h, left, -1); InvertMark(m, f, Ports.show);
      IF rightFixed IN a.opts THEN
         SetMark(m, ruler, a.right, h, right, -1); InvertMark(m, f, Ports.show)
      END;
      i := 0;
      WHILE i < a.tabs.len DO
         SetMark(m, ruler, a.tabs.tab[i].stop, h, tabs, i); InvertMark(m, f, Ports.show); INC(i)
      END;
      px := iconGap; i := firstIcon;
      WHILE i <= lastIcon DO
         IF i IN validIcons THEN
            SetMark(m, ruler, px, h - iconPin, i, -1); DrawMark(m, f)
         END;
         INC(px, iconWidth + iconGap); INC(i)
      END;
      HiliteThisMark(ruler, f, Mode(ruler), Ports.show)
   END Restore;
   PROCEDURE (ruler: StdRuler) RestoreMarks (f: Views.Frame; l, t, r, b: INTEGER);

   BEGIN
      HiliteThisMark(ruler, f, ruler.sel, Ports.show)
   END RestoreMarks;
   PROCEDURE (r: StdRuler) GetBackground (VAR color: Ports.Color);

   BEGIN
      color := Ports.background
   END GetBackground;
   PROCEDURE (r: StdRuler) Neutralize;

      VAR msg: NeutralizeMsg;
   BEGIN
      Views.Broadcast(r, msg)
   END Neutralize;
   PROCEDURE (r: StdRuler) HandleModelMsg (VAR msg: Models.Message);

   BEGIN
      WITH msg: UpdateMsg DO
         Views.Update(r, Views.keepFrames)
      ELSE
      END
   END HandleModelMsg;
   PROCEDURE (r: StdRuler) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);

   BEGIN
      WITH msg: NeutralizeMsg DO
         DeselectMark(r, f)
      ELSE
      END
   END HandleViewMsg;
   PROCEDURE (r: StdRuler) HandleCtrlMsg (f: Views.Frame;

      VAR msg: Controllers.Message; VAR focus: Views.View
   );
      VAR requestFocus: BOOLEAN;
   BEGIN
      WITH msg: Controllers.TrackMsg DO
         Track(r, f, msg)
      | msg: Controllers.EditMsg DO
         Edit(r, f, msg)
      | msg: Controllers.MarkMsg DO
         r.RestoreMarks(f, f.l, f.t, f.r, f.b)
      | msg: Controllers.SelectMsg DO
         IF ~msg.set THEN DeselectMark(r, f) END
      | msg: Controllers.PollOpsMsg DO
         PollOps(r, f, msg)
      | msg: Properties.CollectMsg DO
         PollProp(r, msg.poll)
      | msg: Properties.EmitMsg DO
         requestFocus := f.front;
         SetProp(r, msg.set, requestFocus);
         msg.requestFocus := requestFocus
      ELSE
      END
   END HandleCtrlMsg;
   PROCEDURE (r: StdRuler) HandlePropMsg (VAR msg: Properties.Message);

      VAR m: Mark; requestFocus: BOOLEAN; w, h: INTEGER;
   BEGIN
      WITH msg: Properties.SizePref DO
         msg.w := 10000 * Ports.mm; msg.h := rulerHeight
      | msg: Properties.ResizePref DO
         msg.fixed := TRUE
      | msg: Properties.FocusPref DO
         IF msg.atLocation THEN
            r.context.GetSize(w, h);
            GetMark(m, r, NIL, msg.x, msg.y, FALSE);
            msg.hotFocus := (m.kind # invalid) & ~(m.kind IN fieldIcons) OR (msg.y >= h - tabBarHeight);
            msg.setFocus := ~msg.hotFocus
         END
      | msg: TextModels.Pref DO
         msg.opts := {TextModels.maskChar, TextModels.hideable};
         msg.mask := TextModels.para
      | msg: Properties.SetMsg DO
         requestFocus := FALSE;
         SetProp(r, msg, requestFocus)
      | msg: Properties.PollMsg DO
         PollProp(r, msg)
      ELSE
      END
   END HandlePropMsg;
   (* StdDirectory *)


   PROCEDURE (d: StdDirectory) NewStyle (attr: Attributes): Style;

      VAR s: StdStyle;
   BEGIN
      IF attr = NIL THEN attr := d.attr END;
      NEW(s); s.SetAttr(attr); RETURN s
   END NewStyle;
   PROCEDURE (d: StdDirectory) New (style: Style): Ruler;

      VAR r: StdRuler;
   BEGIN
      IF style = NIL THEN style := d.NewStyle(NIL) END;
      NEW(r); r.InitStyle(style); r.sel := invalid; RETURN r
   END New;
   (** miscellaneous **)


   PROCEDURE GetValidRuler* (text: TextModels.Model; pos, hint: INTEGER;

      VAR ruler: Ruler; VAR rpos: INTEGER
   );
      (** pre: (hint < 0OR(ruler, rpos) is first ruler before hint&0 <= pos <= t.Length() **)
      (** post: hint < rpos <= pos & rpos = Pos(ruler) & (no ruler in (rpos, pos])
            OR((ruler, rpos) unmodified)
      **)
      VAR view: Views.View;
   BEGIN
      IF pos < text.Length() THEN INC(pos) END;   (* let a ruler dominate its own position *)
      IF pos < hint THEN hint := -1 END;
      globRd := text.NewReader(globRd); globRd.SetPos(pos);
      REPEAT
         globRd.ReadPrevView(view)
      UNTIL globRd.eot OR (view IS Ruler) OR (globRd.Pos() < hint);
      IF (view # NIL) & (view IS Ruler) THEN
         ruler := view(Ruler); rpos := globRd.Pos()
      END
   END GetValidRuler;
   PROCEDURE SetDir* (d: Directory);

   (** pre: d # NIL, d.attr # NIL **)
   (** post: dir = d **)
   BEGIN
      ASSERT(d # NIL, 20); ASSERT(d.attr.init, 21); dir := d
   END SetDir;
   PROCEDURE Init;


      VAR d: StdDirectory; fnt: Fonts.Font; asc, dsc, w: INTEGER;
   BEGIN
      IF Dialog.metricSystem THEN
         marginGrid := 1*mm; minTabWidth := 1*mm; tabGrid := 1*mm
      ELSE
         marginGrid := inch16; minTabWidth := inch16; tabGrid := inch16
      END;
      fnt := Fonts.dir.Default();

      font := Fonts.dir.This(fnt.typeface, 7*point, {}, Fonts.normal);   (* font for ruler scales *)
      NEW(prop);
      prop.valid := {first .. tabs};
      prop.first := 0; prop.left := 0;
      IF Dialog.metricSystem THEN
         prop.right := 165*mm
      ELSE
         prop.right := 104*inch16
      END;
      fnt.GetBounds(asc, dsc, w);
      prop.lead := 0; prop.asc := asc; prop.dsc := dsc; prop.grid := 1;
      prop.opts.val := {leftAdjust}; prop.opts.mask := options;
      prop.tabs.len := 0;
      NEW(def); def.InitFromProp(prop);

      NEW(d); d.attr := def; dir := d; stdDir := d
   END Init;
   PROCEDURE Cleaner;

   BEGIN
      globRd := NIL
   END Cleaner;
BEGIN

   Init;
   Kernel.InstallCleaner(Cleaner)
CLOSE
   Kernel.RemoveCleaner(Cleaner)
END TextRulers.