Trurl-based/Std/Mod/Logos.txt

   1 MODULE StdLogos;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Logos.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Ports, Stores, Views, Controllers, Properties;
   7
   8         CONST
   9                 W = 4;
  10                 baseSize = 24 * Ports.point;
  11
  12                 colBase = 00202020H;
  13
  14                 changeColorKey = "#System:ChangeColor";
  15
  16                 minVersion = 0; maxVersion = 0;
  17
  18
  19         TYPE
  20                 View = POINTER TO RECORD (Views.View)
  21                         c: Ports.Color
  22                 END;
  23
  24                 ChangeSizeOp = POINTER TO RECORD (Stores.Operation)
  25                         view: View;
  26                         size: INTEGER;
  27                 END;
  28
  29                 ChangeColorOp = POINTER TO RECORD (Stores.Operation)
  30                         view: View;
  31                         color: Ports.Color
  32                 END;
  33
  34         (* curve painting *)
  35
  36         PROCEDURE Paint (f: Views.Frame; size: INTEGER; col, bgnd: Ports.Color);
  37                 VAR i, d, s, g, m, a, b, l, l0, rl, rt, rr, rb: INTEGER; c: Ports.Color;
  38         BEGIN
  39                 s := size DIV 10; d := size DIV 2; g := d DIV 8; m := size * W DIV 2;
  40                 f.DrawOval(0, s * 2, size * W, size, Ports.fill, col);
  41                 f.DrawOval(s * W, s * 11 DIV 4, (size - s) * W, size - s * 3 DIV 4, Ports.fill, bgnd);
  42                 a := m; b := m + d; c := 7 * colBase; i := 0;
  43                 WHILE i < 4 DO
  44                         f.DrawOval(a, 0, b, d, Ports.fill, c);
  45                         INC(a, g); DEC(b, g); DEC(c, colBase); INC(i)
  46                 END;
  47                 f.rider.GetRect(rl, rt, rr, rb);
  48                 l0 := rl; l := (f.gx + m + d DIV 2) DIV f.unit;
  49                 IF l < rr THEN
  50                         f.rider.SetRect(l, rt, rr, rb);
  51                         a := m; b := m + d; c := 0; i := 0;
  52                         WHILE i < 4 DO
  53                                 f.DrawOval(a, 0, b, d, Ports.fill, c);
  54                                 INC(a, g); DEC(b, g); INC(c, colBase); INC(i)
  55                         END;
  56                         f.rider.SetRect(l0, rt, rr, rb)
  57                 END
  58         END Paint;
  59
  60         (* ChangeOp *)
  61
  62         PROCEDURE (op: ChangeSizeOp) Do;
  63                 VAR v: View; size, w: INTEGER;
  64         BEGIN
  65                 v := op.view;
  66                 size := op.size; v.context.GetSize(w, op.size); v.context.SetSize(size * W, size);
  67                 Views.Update(v, Views.keepFrames)
  68         END Do;
  69
  70         PROCEDURE (op: ChangeColorOp) Do;
  71                 VAR v: View; color: Ports.Color;
  72         BEGIN
  73                 v := op.view;
  74                 color := op.color; op.color := v.c; v.c := color;
  75                 Views.Update(v, Views.keepFrames)
  76         END Do;
  77
  78         (* View *)
  79
  80         PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  81                 VAR thisVersion: INTEGER;
  82         BEGIN
  83                 v.Internalize^(rd); IF rd.cancelled THEN RETURN END;
  84                 rd.ReadVersion(minVersion, maxVersion, thisVersion); IF rd.cancelled THEN RETURN END;
  85                 rd.ReadInt(v.c)
  86         END Internalize;
  87
  88         PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  89         BEGIN
  90                 v.Externalize^(wr);
  91                 wr.WriteVersion(maxVersion);
  92                 wr.WriteInt(v.c)
  93         END Externalize;
  94
  95         PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
  96         BEGIN
  97                 WITH source: View DO v.c := source.c END
  98         END CopyFromSimpleView;
  99
 100         PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
 101                 VAR w, h: INTEGER; bgnd: Ports.Color; g: Views.Frame;
 102         BEGIN
 103                 g := f;
 104                 REPEAT
 105                         g := Views.HostOf(g);
 106                         bgnd := Views.transparent;
 107                         g.view.GetBackground(bgnd)
 108                 UNTIL bgnd # Views.transparent;
 109                 v.context.GetSize(w, h);
 110                 Paint(f, h, v.c, bgnd)
 111         END Restore;
 112
 113         PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
 114                                                                                                                                 VAR focus: Views.View);
 115         BEGIN
 116                 WITH msg: Properties.CollectMsg DO
 117                         Views.HandlePropMsg(v, msg.poll)
 118                 | msg: Properties.EmitMsg DO
 119                         Views.HandlePropMsg(v, msg.set)
 120                 ELSE    (* ignore other messages *)
 121                 END
 122         END HandleCtrlMsg;
 123
 124         PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
 125                 VAR q: Properties.Property; p: Properties.StdProp;
 126                         cop: ChangeColorOp;
 127         BEGIN
 128                 WITH msg: Properties.SizePref DO
 129                         IF (msg.w > Views.undefined) & (msg.h > Views.undefined) THEN
 130                                 (* constrain proposed size *)
 131                                 Properties.ProportionalConstraint(W, 1, msg.fixedW, msg.fixedH, msg.w, msg.h)
 132                         ELSE
 133                                 (* return default size *)
 134                                 msg.w := W * baseSize; msg.h := baseSize
 135                         END
 136                 | msg: Properties.PollMsg DO
 137                         NEW(p); p.known := {Properties.color}; p.valid := p.known;
 138                         p.color.val := v.c;
 139                         msg.prop := p
 140                 | msg: Properties.SetMsg DO
 141                         q := msg.prop;
 142                         WHILE q # NIL DO
 143                                 WITH q: Properties.StdProp DO
 144                                         IF Properties.color IN q.valid THEN
 145                                                 NEW(cop); cop.view := v; cop.color := q.color.val;
 146                                                 Views.Do(v, changeColorKey, cop)
 147                                         END;
 148                                 ELSE
 149                                 END;
 150                                 q :=q.next
 151                         END
 152                 ELSE
 153                 END
 154         END HandlePropMsg;
 155
 156         PROCEDURE Deposit*;
 157                 VAR v: View;
 158         BEGIN
 159                 NEW(v); v.c := Ports.grey50; Views.Deposit(v)
 160         END Deposit;
 161
 162 END StdLogos.