new/Std/Mod/Headers.txt

   1 MODULE StdHeaders;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Headers.odc *)
   4         (* DO NOT EDIT *)
   5
   6 (* headers / footers support the following macros:
   7
   8                         &p - replaced by current page number as arabic numeral
   9                         &r - replaced by current page number as roman numeral
  10                         &R - replaced by current page number as capital roman numeral
  11                         &a - replaced by current page number as alphanumeric character
  12                         &A - replaced by current page number as capital alphanumeric character
  13                         &d - replaced by printing date
  14                         &t - replaced by printing time
  15                         &&- replaced by & character
  16                         &; - specifies split point
  17                         &f - filename with path/title
  18
  19 *)
  20
  21         IMPORT
  22                 Stores, Ports, Models, Views, Properties, Printing, TextModels, Fonts, Dialog,
  23                 TextViews, Dates, Windows, Controllers, Containers;
  24
  25         CONST
  26                 minVersion = 0; maxVersion = 2;
  27                 mm = Ports.mm; point = Ports.point;
  28                 maxWidth = 10000 * mm;
  29                 alternate* = 0; number* = 1; head* = 2; foot* = 3; showFoot* = 4;
  30
  31         TYPE
  32                 Banner* = RECORD
  33                         left*, right*: ARRAY 128 OF CHAR;
  34                         gap*: INTEGER
  35                 END;
  36
  37                 NumberInfo* = RECORD
  38                         new*: BOOLEAN;
  39                         first*: INTEGER
  40                 END;
  41
  42                 View = POINTER TO RECORD (Views.View)
  43                         alternate: BOOLEAN;     (* alternate left/right *)
  44                         number: NumberInfo;     (* new page number *)
  45                         head, foot: Banner;
  46                         font: Fonts.Font;
  47                         showFoot: BOOLEAN;
  48                 END;
  49
  50                 Prop* = POINTER TO RECORD (Properties.Property)
  51                         alternate*, showFoot*: BOOLEAN;
  52                         number*: NumberInfo;
  53                         head*, foot*: Banner
  54                 END;
  55
  56                 ChangeFontOp = POINTER TO RECORD (Stores.Operation)
  57                         header: View;
  58                         font: Fonts.Font
  59                 END;
  60
  61                 ChangeAttrOp = POINTER TO RECORD (Stores.Operation)
  62                         header: View;
  63                         alternate, showFoot: BOOLEAN;
  64                         number: NumberInfo;
  65                         head, foot: Banner
  66                 END;
  67
  68         VAR
  69                 dialog*: RECORD
  70                         view: View;
  71                         alternate*, showFoot*: BOOLEAN;
  72                         number*: NumberInfo;
  73                         head*, foot*: Banner;
  74                 END;
  75
  76         PROCEDURE (p: Prop) IntersectWith* (q: Properties.Property; OUT equal: BOOLEAN);
  77                 VAR valid: SET;
  78                 PROCEDURE Equal(IN b1, b2: Banner): BOOLEAN;
  79                 BEGIN
  80                         RETURN (b1.left = b2.left) & (b1.right = b2.right) & (b1.gap = b2.gap)
  81                 END Equal;
  82         BEGIN
  83                 WITH q: Prop DO
  84                         valid := p.valid * q.valid; equal := TRUE;
  85                         IF p.alternate # q.alternate THEN EXCL(valid, alternate) END;
  86                         IF p.showFoot # q.showFoot THEN EXCL(valid, showFoot) END;
  87                         IF (p.number.new # q.number.new) OR (p.number.first # q.number.first) THEN EXCL(valid, number) END;
  88                         IF ~Equal(p.head, q.head) THEN EXCL(valid, head) END;
  89                         IF ~Equal(p.foot, q.foot) THEN EXCL(valid, foot) END;
  90                         IF p.valid # valid THEN p.valid := valid; equal := FALSE END
  91                 END
  92         END IntersectWith;
  93
  94         (* SetAttrOp *)
  95
  96         PROCEDURE (op: ChangeFontOp) Do;
  97                 VAR v: View; font: Fonts.Font; asc, dsc, w: INTEGER; c: Models.Context;
  98         BEGIN
  99                 v := op.header;
 100                 font := op.font; op.font := v.font; v.font := font;
 101                 font.GetBounds(asc, dsc, w);
 102                 c := v.context;
 103                 c.SetSize(maxWidth, asc + dsc + 2*point);
 104                 Views.Update(v, Views.keepFrames)
 105         END Do;
 106
 107         PROCEDURE DoChangeFontOp (v: View; font: Fonts.Font);
 108                 VAR op: ChangeFontOp;
 109         BEGIN
 110                 IF v.font # font THEN
 111                         NEW(op); op.header := v; op.font := font;
 112                         Views.Do(v,   "#System:SetProp", op)
 113                 END
 114         END DoChangeFontOp;
 115
 116         PROCEDURE (op: ChangeAttrOp) Do;
 117                 VAR v: View; alternate, showFoot: BOOLEAN; number: NumberInfo; head, foot: Banner;
 118         BEGIN
 119                 v := op.header;
 120                 alternate := op.alternate; showFoot := op.showFoot; number := op.number; head := op.head; foot := op.foot;
 121                 op.alternate := v.alternate; op.showFoot := v.showFoot; op.number := v.number; op.head := v.head;
 122                 op.foot := v.foot;
 123                 v.alternate := alternate; v.showFoot := showFoot; v.number := number; v.head := head; v.foot := foot;
 124                 Views.Update(v, Views.keepFrames)
 125         END Do;
 126
 127         PROCEDURE DoChangeAttrOp (v: View; alternate, showFoot: BOOLEAN; number: NumberInfo;
 128                                                                                                         head, foot: Banner);
 129                 VAR op: ChangeAttrOp;
 130         BEGIN
 131                 NEW(op); op.header := v; op.alternate := alternate; op.showFoot := showFoot;
 132                 op.number := number; op.head := head; op.foot := foot;
 133                 Views.Do(v,   "#Std:HeaderChange", op)
 134         END DoChangeAttrOp;
 135
 136         PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
 137         BEGIN
 138                 WITH source: View DO
 139                         v.alternate := source.alternate;
 140                         v.number.new := source.number.new; v.number.first := source.number.first;
 141                         v.head := source.head;
 142                         v.foot := source.foot;
 143                         v.font := source.font;
 144                         v.showFoot := source.showFoot
 145                 END
 146         END CopyFromSimpleView;
 147
 148         PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
 149         BEGIN
 150                 v.Externalize^(wr);
 151                 wr.WriteVersion(maxVersion);
 152                 wr.WriteString(v.head.left);
 153                 wr.WriteString(v.head.right);
 154                 wr.WriteInt(v.head.gap);
 155                 wr.WriteString(v.foot.left);
 156                 wr.WriteString(v.foot.right);
 157                 wr.WriteInt(v.foot.gap);
 158                 wr.WriteString(v.font.typeface);
 159                 wr.WriteInt(v.font.size);
 160                 wr.WriteSet(v.font.style);
 161                 wr.WriteInt(v.font.weight);
 162                 wr.WriteBool(v.alternate);
 163                 wr.WriteBool(v.number.new);
 164                 wr.WriteInt(v.number.first);
 165                 wr.WriteBool(v.showFoot);
 166         END Externalize;
 167
 168         PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
 169                 VAR version: INTEGER; typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
 170
 171         BEGIN
 172                 v.Internalize^(rd);
 173                 IF ~rd.cancelled THEN
 174                         rd.ReadVersion(minVersion, maxVersion, version);
 175                         IF ~rd.cancelled THEN
 176                                 IF version = 0 THEN
 177                                         rd.ReadXString(v.head.left);
 178                                         rd.ReadXString(v.head.right);
 179                                         v.head.gap := 5*mm;
 180                                         rd.ReadXString(v.foot.left);
 181                                         rd.ReadXString(v.foot.right);
 182                                         v.foot.gap := 5*mm;
 183                                         rd.ReadXString(typeface);
 184                                         rd.ReadXInt(size);
 185                                         v.font := Fonts.dir.This(typeface, size * point, {}, Fonts.normal);
 186                                         rd.ReadXInt(v.number.first);
 187                                         rd.ReadBool(v.number.new);
 188                                         rd.ReadBool(v.alternate)
 189                                 ELSE
 190                                         rd.ReadString(v.head.left);
 191                                         rd.ReadString(v.head.right);
 192                                         rd.ReadInt(v.head.gap);
 193                                         rd.ReadString(v.foot.left);
 194                                         rd.ReadString(v.foot.right);
 195                                         rd.ReadInt(v.foot.gap);
 196                                         rd.ReadString(typeface);
 197                                         rd.ReadInt(size);
 198                                         rd.ReadSet(style);
 199                                         rd.ReadInt(weight);
 200                                         v.font := Fonts.dir.This(typeface, size, style, weight);
 201                                         rd.ReadBool(v.alternate);
 202                                         rd.ReadBool(v.number.new);
 203                                         rd.ReadInt(v.number.first);
 204                                         IF version = 2 THEN rd.ReadBool(v.showFoot) ELSE v.showFoot := FALSE END
 205                                 END
 206                         END
 207                 END
 208         END Internalize;
 209
 210         PROCEDURE SetProp(v: View; msg: Properties.SetMsg);
 211                 VAR p: Properties.Property;
 212                         typeface: Fonts.Typeface; size: INTEGER; style: SET; weight: INTEGER;
 213                         alt, sf: BOOLEAN; num: NumberInfo; h, f: Banner;
 214         BEGIN
 215                 p := msg.prop;
 216                 WHILE p # NIL DO
 217                         WITH p: Properties.StdProp DO
 218                                 IF Properties.typeface IN p.valid THEN typeface := p.typeface
 219                                 ELSE typeface := v.font.typeface
 220                                 END;
 221                                 IF Properties.size IN p.valid THEN size := p.size
 222                                 ELSE size := v.font.size
 223                                 END;
 224                                 IF Properties.style IN p.valid THEN style := p.style.val
 225                                 ELSE style := v.font.style
 226                                 END;
 227                                 IF Properties.weight IN p.valid THEN weight := p.weight
 228                                 ELSE weight := v.font.weight
 229                                 END;
 230                                 DoChangeFontOp (v, Fonts.dir.This(typeface, size, style, weight) );
 231                         | p: Prop DO
 232                                 IF alternate IN p.valid THEN alt := p.alternate ELSE alt := v.alternate END;
 233                                 IF showFoot IN p.valid THEN sf := p.showFoot ELSE sf := v.showFoot END;
 234                                 IF number IN p.valid THEN num := p.number ELSE num := v.number END;
 235                                 IF head IN p.valid THEN h := p.head ELSE h := v.head END;
 236                                 IF foot IN p.valid THEN f := p.foot ELSE f := v.foot END;
 237                                 DoChangeAttrOp(v, alt, sf, num, h, f)
 238                         ELSE
 239                         END;
 240                         p := p.next
 241                 END
 242         END SetProp;
 243
 244         PROCEDURE PollProp(v: View; VAR msg: Properties.PollMsg);
 245                 VAR sp: Properties.StdProp; p: Prop;
 246         BEGIN
 247                 NEW(sp);
 248                 sp.known := {Properties.size, Properties.typeface, Properties.style, Properties.weight};
 249                 sp.valid := sp.known;
 250                 sp.size := v.font.size; sp.typeface := v.font.typeface;
 251                 sp.style.val := v.font.style; sp.style.mask := {Fonts.italic, Fonts.underline, Fonts.strikeout};
 252                 sp.weight := v.font.weight;
 253                 Properties.Insert(msg.prop, sp);
 254                 NEW(p);
 255                 p.known := {alternate, number, head, foot, showFoot}; p.valid := p.known;
 256                 p.head := v.head; p.foot := v.foot;
 257                 p.alternate := v.alternate;
 258                 p.showFoot := v.showFoot;
 259                 p.number := v.number;
 260                 Properties.Insert(msg.prop, p)
 261         END PollProp;
 262
 263         PROCEDURE PageMsg(v: View; msg: TextViews.PageMsg);
 264         BEGIN
 265                 IF Printing.par # NIL THEN
 266                         Dialog.MapString(v.head.left, Printing.par.header.left);
 267                         Dialog.MapString(v.head.right, Printing.par.header.right);
 268                         Dialog.MapString(v.foot.left, Printing.par.footer.left);
 269                         Dialog.MapString(v.foot.right, Printing.par.footer.right);
 270                         Printing.par.header.font := v.font;
 271                         Printing.par.footer.font := v.font;
 272                         Printing.par.page.alternate := v.alternate;
 273                         IF v.number.new THEN
 274                                 Printing.par.page.first := v.number.first - msg.current
 275                         END;
 276                         Printing.par.header.gap := 5*Ports.mm;
 277                         Printing.par.footer.gap := 5*Ports.mm
 278                 END
 279         END PageMsg;
 280
 281         PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
 282                 VAR d, w, h: INTEGER; (*line: Line; *)asc, dsc, x0, x1, y: INTEGER;
 283                         win: Windows.Window; title: Views.Title; dec: BOOLEAN;
 284                         pw, ph: INTEGER;
 285                         date: Dates.Date; time: Dates.Time; pageInfo: Printing.PageInfo; banner: Printing.Banner;
 286         BEGIN
 287                 IF Views.IsPrinterFrame(f) THEN (* am drucken *) END;
 288
 289                 v.font.GetBounds(asc, dsc, w);
 290
 291                 win := Windows.dir.First();
 292                 WHILE (win # NIL) & (win.doc.Domain() # v.Domain()) DO win := Windows.dir.Next(win) END;
 293                 IF win = NIL THEN title := "(" + Dialog.appName + ")"
 294                 ELSE win.GetTitle(title)
 295                 END;
 296                 d := f.dot;
 297                 v.context.GetSize(w, h);
 298                 win.doc.PollPage(pw, ph, l, t, r, b, dec);
 299                 w := r - l;
 300
 301                 f.DrawRect(0, 0, w, h, Ports.fill, Ports.grey25);
 302                 f.DrawRect(0, 0, w, h, 0, Ports.black);
 303
 304                 x0 := d; x1 := w-2*d; y := asc + d;
 305
 306                 Dates.GetDate(date);
 307                 Dates.GetTime(time);
 308                 pageInfo.alternate := FALSE;
 309                 pageInfo.title := title;
 310                 banner.font := v.font;
 311                 IF v.showFoot THEN
 312                         banner.gap := v.foot.gap;
 313                         Dialog.MapString(v.foot.left, banner.left); Dialog.MapString(v.foot.right, banner.right)
 314                 ELSE
 315                         banner.gap := v.head.gap;
 316                         Dialog.MapString(v.head.left, banner.left); Dialog.MapString(v.head.right, banner.right)
 317                 END;
 318                 Printing.PrintBanner(f, pageInfo, banner, date, time, x0, x1, y)
 319         END Restore;
 320
 321         PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
 322                 VAR asc, dsc, w: INTEGER;
 323         BEGIN
 324                 WITH msg: Properties.SizePref DO
 325                         msg.w := maxWidth;
 326                         IF msg.h = Views.undefined THEN
 327                                 v.font.GetBounds(asc, dsc, w);
 328                                 msg.h := asc + dsc + 2*point
 329                          END
 330                 | msg: Properties.ResizePref DO
 331                         msg.fixed := TRUE
 332                 | msg: TextModels.Pref DO
 333                         msg.opts := {TextModels.hideable}
 334                 | msg: Properties.PollMsg DO
 335                         PollProp(v, msg)
 336                 | msg: Properties.SetMsg DO
 337                         SetProp(v, msg)
 338                 | msg: TextViews.PageMsg DO
 339                         PageMsg(v, msg)
 340                 ELSE
 341                 END
 342         END HandlePropMsg;
 343
 344         PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
 345                                                                                                                                 VAR focus: Views.View);
 346         BEGIN
 347                 WITH msg: Properties.EmitMsg DO Views.HandlePropMsg(v, msg.set)
 348                 | msg: Properties.CollectMsg DO Views.HandlePropMsg(v, msg.poll)
 349                 ELSE
 350                 END
 351         END HandleCtrlMsg;
 352
 353         PROCEDURE New*(p: Prop; f: Fonts.Font): Views.View;
 354                 VAR v: View;
 355         BEGIN
 356                 NEW(v);
 357                 v.head := p.head;
 358                 v.foot := p.foot;
 359                 v.number := p.number;
 360                 v.alternate := p.alternate;
 361                 v.font := f;
 362                 v.showFoot := FALSE;
 363                 RETURN v;
 364         END New;
 365
 366         PROCEDURE Deposit*;
 367                 VAR v: View;
 368         BEGIN
 369                 NEW(v);
 370                 v.head.left := ""; v.head.right :=  "&d&;&p"; v.head.gap := 5*mm;
 371                 v.foot.left := ""; v.foot.right := ""; v.foot.gap := 5*mm;
 372                 v.font := Fonts.dir.Default();
 373                 v.number.first := 1; v.number.new := FALSE; v.alternate := FALSE; v.showFoot := FALSE;
 374                 Views.Deposit(v)
 375         END Deposit;
 376
 377         (* property dialog *)
 378
 379         PROCEDURE InitDialog*;
 380                 VAR  p: Properties.Property;
 381         BEGIN
 382                 Properties.CollectProp(p);
 383                 WHILE p # NIL DO
 384                         WITH p: Properties.StdProp DO
 385                         | p: Prop DO
 386                                 dialog.alternate := p.alternate; dialog.showFoot := p.showFoot;
 387                                 dialog.number := p.number;
 388                                 dialog.head := p.head; dialog.head.gap := dialog.head.gap DIV point;
 389                                 dialog.foot := p.foot; dialog.foot.gap := dialog.foot.gap DIV point;
 390                                 Dialog.Update(dialog)
 391                         ELSE
 392                         END;
 393                         p := p.next
 394                 END
 395         END InitDialog;
 396
 397         PROCEDURE Set*;
 398                 VAR p: Prop;
 399         BEGIN
 400                 NEW(p); p.valid := {alternate, number, head, foot, showFoot};
 401                 p.alternate := dialog.alternate; p.showFoot := dialog.showFoot;
 402                 p.number := dialog.number;
 403                 p.head := dialog.head; p.head.gap := p.head.gap * point;
 404                 p.foot := dialog.foot; p.foot.gap := p.foot.gap * point;
 405                 Properties.EmitProp(NIL, p)
 406         END Set;
 407
 408         PROCEDURE HeaderGuard* (VAR par: Dialog.Par);
 409                 VAR v: Views.View;
 410         BEGIN
 411                 v := Containers.FocusSingleton();
 412                 IF (v # NIL) & (v IS View) THEN
 413                         par.disabled := FALSE;
 414                         IF (dialog.view = NIL) OR (dialog.view # v) THEN
 415                                 dialog.view := v(View);
 416                                 InitDialog
 417                         END
 418                 ELSE
 419                         par.disabled := TRUE;
 420                         dialog.view := NIL
 421                 END
 422         END HeaderGuard;
 423
 424         PROCEDURE AlternateGuard* (VAR par: Dialog.Par);
 425         BEGIN
 426                 HeaderGuard(par);
 427                 IF ~par.disabled THEN par.disabled := ~ dialog.alternate END
 428         END AlternateGuard;
 429
 430         PROCEDURE NewNumberGuard* (VAR par: Dialog.Par);
 431         BEGIN
 432                 HeaderGuard(par);
 433                 IF ~par.disabled THEN par.disabled := ~ dialog.number.new END
 434         END NewNumberGuard;
 435
 436 END StdHeaders.