diagram.c from Thomas Rapp in Modula-2

(*##################*)
 MODULE TstDrawArea2;          (* $VER: TstDrawArea2 0.0 (31.12.2012) *)
(*##################*)
 
(* From Thomas Rapp example diagram.c *)
 
FROM SYSTEM     IMPORT ADDRESS, ADR;
FROM Assertions IMPORT Assert;
 
FROM GraphicsInterfaces IMPORT IGraphics;
 
FROM AmigaDOS      IMPORT SigBreakCtrlC;
FROM BoopsiClasses IMPORT GADisabled, GAHintInfo, GAID, GAReadOnly,
                          gpRender, gpRenderPtr;
FROM Intuition     IMPORT ScreenPtr;
FROM Rasters       IMPORT RastPortPtr;
FROM Tasks         IMPORT SignalRange, SignalSet;
FROM Utility       IMPORT HookPtr;
FROM UtilityTags   IMPORT TagItem;
FROM Views         IMPORT OBPFailIfBad, OBPPrecision, PrecisionGUI;
 
FROM DrawArea      IMPORT DisposeDrawAreaGadg, NewDrawArea, SetDrawAreaRefresh;
 
FROM SimpleGUI     IMPORT AddGadg, AsgGadgInteger, AsgGadgJustification, DebugMode, Directions, DirectionSet, 
                          DisposeWndo, EvntInfo, Gadg, GetGadgCurrentPlacement,
                          GetWndoEvnt, Ignore, Modifiers, ModifierSet, NewButton,
                          NewContainer, NewIntegerBox, NewWndo, NullGadg, 
                          NullWndo, OpenWndo, Orientations, RefreshGadg, RevealNativeScreen, 
                          TwoD, WaitWndoEvntTimed, Wndo, WndoContainer, WndoEvnts, WndoModifierSet;         
 
FROM AmigaTimer    IMPORT AbortATimer, CloseATimer, NullTimerHandle, OpenATimer, StartATimer,
                          TimerFlavors, TimerHandle, WaitATimer;
FROM Break         IMPORT TstBreak;
FROM RandomNumbers IMPORT Random;
IMPORT TagsUtils;
 
CONST NullChar = ""; PgmVersion = "$VER: TstDrawArea2 0.0 (28.12.2012)";
 
CONST StartSpeed = 500000;  (* 1/2 sec *)
 
VAR wndo         :Wndo;
    winpos       :TwoD;
    scr          :ScreenPtr;    
    ev           :EvntInfo;
    AreaGadg,
    OkGadg,
    ControlCont,
    CancelGadg,
    SpeedDisp     :Gadg;
    t             :TimerHandle;
    tsig          :SignalRange;
    ResultSignals :SignalSet;
    Speed         :CARDINAL;
    IsMoving,
    bRes,
    fin           :BOOLEAN;
 
TYPE diagram_data = RECORD
                      gad    :Gadg;
                      pens   :RECORD
                                white,
                                black,
                                grey,
                                red    :CARDINAL8;
                              END;
                      values :ARRAY[0..255] OF INTEGER8;
                    END;
     diagram_dataPtr = POINTER TO diagram_data;
 
CONST MAXDIFF = 20;
 
VAR diagram      :diagram_data;
 
(*-----------------*)
 PROCEDURE InitPgm;
(*-----------------*)
 
BEGIN
 
wndo := NullWndo();
AreaGadg := NullGadg();
t := NullTimerHandle;
fin := FALSE;
scr := NIL;
Speed := StartSpeed;   (* ~1 sec *)
IsMoving := Speed > 0;
 
END InitPgm;
 
(*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*)
 PROCEDURE draw_diagram(Hk:HookPtr; gadget:ADDRESS; message:ADDRESS):CARDINAL;
(*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*)
 
VAR mesg            :gpRenderPtr;
    LeftTopOffset, 
    WidthHeight     :TwoD;
    x0, y0,
    x1, y1,
    x, y,
    w, h            :INTEGER;
    i               :INTEGER;
    rp              :RastPortPtr;
    data            :diagram_dataPtr;
 
BEGIN
 
mesg := message;
 
data := Hk^.hData;
 
GetGadgCurrentPlacement(data^.gad, LeftTopOffset, WidthHeight);
x0 := LeftTopOffset.x;
y0 := LeftTopOffset.y;
x1 := x0 + WidthHeight.x - 1;
y1 := y0 + WidthHeight.y - 1;
 
rp := mesg^.gprRPort;
 
IGraphics^.SetAPen(IGraphics, rp, data^.pens.white);
IGraphics^.RectFill(IGraphics, rp, x0, y0, x1, y1);
 
INC(x0, 4);
INC(y0, 4);
DEC(x1, 4);
DEC(y1, 4);
w := x1 - x0 + 1;
h := y1 - y0 + 1;
 
FOR i := 0 TO 256 BY 8 DO
   x := x0 + i * w / 256;
   IF i = 0 THEN
      IGraphics^.SetAPen(IGraphics, rp, data^.pens.black);
   ELSE
      IGraphics^.SetAPen(IGraphics, rp, data^.pens.grey);
   END;
 
   IGraphics^.Move(IGraphics, rp, x, y0);
   IGraphics^.Draw(IGraphics, rp, x, y1);
END;
 
INC(x0);
 
FOR i := 0 TO 256 BY 16 DO
   y := y0 + i * h / 256;
   IF i = 128 THEN
      IGraphics^.SetAPen(IGraphics, rp, data^.pens.black);
   ELSE
      IGraphics^.SetAPen(IGraphics, rp, data^.pens.grey);
   END;
   IGraphics^.Move(IGraphics, rp, x0, y);
   IGraphics^.Draw(IGraphics, rp, x1, y);
END;
 
IGraphics^.SetAPen(IGraphics, rp,data^.pens.red);
IGraphics^.Move(IGraphics, rp, x0, (data^.values[0] + 128) * h / 256 + y0);
 
FOR i := 1 TO 255 DO
   IGraphics^.Draw(IGraphics, rp, x0 + i * w / 256, y0 + (data^.values[i] + 128) * h / 256);
END;
 
RETURN 0;
 
END draw_diagram;
 
(*------------------------------------------*)
 PROCEDURE new_value(VAR data:diagram_data);
(*------------------------------------------*)
 
VAR  d, v, i  :INTEGER;
 
BEGIN
 
d := VAL(INTEGER, Random(2*MAXDIFF+1)) - MAXDIFF;              (* [0..41] - 20 *)
 
v := data.values[255] + d;
 
IF (v < -128) OR (v > 127) THEN
   v := data.values[255] - d;
END;
 
FOR i := 0 TO 254 DO
   data.values[i] := data.values[i+1];
END;
 
data.values[255] := v;
 
END new_value; 
 
(*------------------*)
 PROCEDURE SetUpWin;
(*------------------*)
 
VAR winsiz  :TwoD;
 
BEGIN
 
winsiz.x := 700; winsiz.y := 500;
wndo := NewWndo(winsiz, Vertical, DirectionSet{}, WndoModifierSet{});
Assert(wndo # NullWndo(), "NewWndo FAIL");
 
AreaGadg := NewDrawArea(ModifierSet{Transparent, ReadOnly, Boxed});
Assert(AreaGadg # NullGadg(), "NewDrawArea FAIL");
 
ControlCont := NewContainer(Horizontal, ModifierSet{EqualSize, SizeToFitV});
 
OkGadg := NewButton("Ok", ModifierSet{SizeToFitH, FixedH});
 
SpeedDisp := NewIntegerBox(Speed, 0, 1000000, ModifierSet{ReadOnly, FixedH});
AsgGadgJustification(SpeedDisp, DirectionSet{CenterH});
 
CancelGadg := NewButton("Quit", ModifierSet{SizeToFitH, FixedH});
 
AddGadg(WndoContainer(wndo), AreaGadg);
AddGadg(WndoContainer(wndo), ControlCont);
AddGadg(ControlCont, OkGadg);
AddGadg(ControlCont, SpeedDisp);
AddGadg(ControlCont, CancelGadg);
 
END SetUpWin;
 
(*---------------------*)
 PROCEDURE SetupRefresh;
(*---------------------*)
 
VAR i      :INTEGER;
    Tags   :ARRAY[0..4] OF TagItem;
 
BEGIN
 
RevealNativeScreen(wndo, scr);
 
TagsUtils.AsgTags2(Tags, OBPPrecision, PrecisionGUI,
                         OBPFailIfBad, ORD(FALSE));
 
diagram.pens.white := IGraphics^.ObtainBestPenA(IGraphics, scr^.ViewPort.ColorMap, 0FFFFFFFFH, 0FFFFFFFFH, 0FFFFFFFFH, Tags);
diagram.pens.black := IGraphics^.ObtainBestPenA(IGraphics, scr^.ViewPort.ColorMap, 0, 0, 0, Tags);
diagram.pens.grey := IGraphics^.ObtainBestPenA(IGraphics, scr^.ViewPort.ColorMap, 0CCCCCCCCH, 0CCCCCCCCH, 0CCCCCCCCH, Tags);
diagram.pens.red := IGraphics^.ObtainBestPenA(IGraphics, scr^.ViewPort.ColorMap, 0FFFFFFFFH, 0, 0, Tags);
 
diagram.values[255] := 0;
FOR i := 0 TO 255 DO
   new_value(diagram);
END;
 
diagram.gad := AreaGadg;
 
SetDrawAreaRefresh(AreaGadg, draw_diagram, ADR(diagram));
 
END SetupRefresh;
 
(*------------------*)
 BEGIN (* program *)
(*------------------*)
 
InitPgm;
 
SetUpWin;
 
winpos.x := Ignore; winpos.y := Ignore;
OpenWndo(wndo, winpos, "Moving diagram");
 
SetupRefresh;;
 
bRes := OpenATimer(t, VBlank);
IF IsMoving THEN
   Assert(StartATimer(t, 0(* secs*), Speed(*micros*), tsig), "StartATimer FAIL");
END;
 
REPEAT
 
   IF IsMoving THEN
 
      bRes := WaitATimer(t, SignalSet{SigBreakCtrlC}, ResultSignals);
 
      IF NOT (SigBreakCtrlC IN ResultSignals) THEN
 
            bRes := StartATimer(t, 0(* secs*), Speed(*micros*), tsig); 
 
            new_value(diagram);
            IGraphics^.WaitTOF(IGraphics);  (* causes problems if in the Hook proc and update does not finish in one frame *)
            RefreshGadg(AreaGadg);      
 
      ELSE
 
         fin := TRUE;
 
      END;
 
   ELSE
 
      WaitWndoEvntTimed(wndo, 5);
 
   END;
 
   WHILE GetWndoEvnt(wndo, ev) DO
 
      CASE ev.ev OF
         CloseEv:
            fin := TRUE;
            |
         SelectEv:
            IF ev.g = OkGadg THEN
               IF NOT IsMoving THEN
                  Speed := StartSpeed;
                  bRes := StartATimer(t, 0(* secs*), Speed(*micros*), tsig);
                  IsMoving := TRUE;
               ELSE
                  IF Speed > 1000000 / 360 THEN
                     Speed := Speed / 2;
                  ELSE
                     Speed := 0;
                     IsMoving := FALSE;
                  END;
               END;
               AsgGadgInteger(SpeedDisp, Speed);
            ELSIF ev.g = CancelGadg THEN
               fin := TRUE;           
            END;
            |
         ELSE
            (*WriteString("ev.ev"); WriteCard(ORD(ev.ev), 3); WriteLn;*)
      END;
 
   END;
 
   IF TstBreak() THEN
      fin := TRUE;
   END;
 
UNTIL fin;
 
(*-----*)
 FINALLY
(*-----*)
 
IF IsMoving THEN
   bRes := AbortATimer(t);
END;
bRes := CloseATimer(t);
 
IGraphics^.ReleasePen(IGraphics, scr^.ViewPort.ColorMap,diagram.pens.red);
IGraphics^.ReleasePen(IGraphics, scr^.ViewPort.ColorMap,diagram.pens.grey);
IGraphics^.ReleasePen(IGraphics, scr^.ViewPort.ColorMap,diagram.pens.black);
IGraphics^.ReleasePen(IGraphics, scr^.ViewPort.ColorMap,diagram.pens.white);
 
DisposeWndo(wndo);
 
END TstDrawArea2.