(**********************************************************************

    :Program.    IDCMPTest
    :Contents.   Test module for IDCMP [bne]
    :Author.     Nicolas Benezan [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.2d
    :Imports.    IDCMP2.0 [bne]
    :History.    V1.0a [bne] 16.Jul.1989

**********************************************************************)

MODULE IDCMPTest;

FROM Arts         IMPORT Assert, Terminate, TermProcedure;
FROM Exec         IMPORT MsgPortPtr;
FROM Graphics     IMPORT jam1, RastPortPtr, SetAPen, SetDrMd, SetRGB4,
                         ViewModeSet, ViewPortPtr, WritePixel;
FROM IDCMP        IMPORT DiscardScheduler, HandlerFlags, HandlerFlagSet,
                         IDCMPHandler, IDCMPSchedule, InitScheduler,
                         InstallIDCMPHandler, IDCMPHandlerDataPtr,
                         RemoveIDCMPHandler, ScheduleIDCMPHandlers;
FROM Intuition    IMPORT CloseScreen, CloseWindow, customScreen,
                         IDCMPFlags, IDCMPFlagSet, NewScreen, NewWindow,
                         OpenScreen, OpenWindow, ScreenPtr, stdScreenHeight,
                         WindowFlags, WindowFlagSet, WindowPtr;
FROM MathLib0     IMPORT sqrt;
FROM RandomNumber IMPORT Random, RND;
FROM SYSTEM       IMPORT ADDRESS, ADR, LONGSET;

VAR
  Screen: ScreenPtr;
  Window: WindowPtr;
  RastPort: RastPortPtr;
  Handler1, Handler2: IDCMPHandler;
  Port: MsgPortPtr;
  Schedule: IDCMPSchedule;

PROCEDURE ZeichneKugel(OffX,OffY:INTEGER;r:REAL);
  CONST
    LX=-500.0;
    LY=-300.0;
    LZ=600.0;
    BackGnd=3.5;
    Hell=13.9-BackGnd;
  VAR
    X,Y,Xgrenz:INTEGER;
    Faktor,CosPhi,RealX,RealY,Z,Xg2,Pen:REAL;
  BEGIN
    Faktor:=sqrt(LX*LX+LY*LY+LZ*LZ)*r;
    FOR Y:=TRUNC(-r) TO TRUNC(r) DO
      RealY:=REAL(Y);
      Xg2:=r*r-RealY*RealY;
      Xgrenz:=TRUNC(sqrt(Xg2));
      FOR X:=-Xgrenz TO Xgrenz DO
        RealX:=REAL(X);
        Pen:=Random();
        CosPhi:=(sqrt(Xg2-RealX*RealX)*LZ+RealX*LX+RealY*LY)/Faktor;
        IF CosPhi>0.0 THEN
          Pen:=Pen+(CosPhi*Hell);
        END;
        SetAPen(RastPort,TRUNC(Pen+BackGnd));
        IF WritePixel(RastPort,OffX+X,OffY+Y)#0 THEN END;
      END;
    END;
  END ZeichneKugel;

PROCEDURE InitDisplay;
  VAR
    MyScreen:NewScreen;
    MyWindow:NewWindow;
    ViewPort:ViewPortPtr;
    n:INTEGER;
  BEGIN
  WITH MyScreen DO
    leftEdge:=0;
    topEdge:=0;
    width:=320;
    height:=stdScreenHeight;
    depth:=4;
    detailPen:=4;
    blockPen:=12;
    viewModes:=ViewModeSet{(*Graphics.lace,Graphics.hires*)};
    type:=customScreen;
    font:=NIL;
    defaultTitle:=ADR("Demo Screen");
    gadgets:=NIL;
    customBitMap:=NIL;
  END;
  Screen:=OpenScreen(MyScreen);
  Assert(Screen#NIL,ADR("OpenScreen failed"));
  IF Screen#NIL THEN
    ViewPort:=ADR(Screen^.viewPort);
    FOR n:=0 TO 15 DO
      SetRGB4(ViewPort,n,n,n,n);
    END;
  END;
  WITH MyWindow DO
    leftEdge:=0;
    topEdge:=11;
    width:=320;
    height:=Screen^.height-11;
    detailPen:=0;
    blockPen:=15;
    idcmpFlags:=IDCMPFlagSet{lonelyMessage};
    flags:=WindowFlagSet{windowDrag, windowClose};
    firstGadget:=NIL;
    checkMark:=NIL;
    title:=ADR("Demo Window");
    bitMap:=NIL;
    minWidth:=0;
    minHeight:=0;
    maxWidth:=0;
    maxHeight:=0;
    type:=customScreen;
    screen:=Screen;
  END;
  Window:=OpenWindow(MyWindow);
  Assert(Window#NIL,ADR("OpenWindow failed"));
  IF Window#NIL THEN
    RastPort:=Window^.rPort;
    SetDrMd(RastPort,jam1);
  END;
  END InitDisplay;

PROCEDURE CloseHandler(Flags: IDCMPFlagSet;
                       DataPtr: IDCMPHandlerDataPtr): BOOLEAN;
  BEGIN
    Terminate(0);
    RETURN TRUE
  END CloseHandler;

PROCEDURE MouseHandler(Flags: IDCMPFlagSet;
                       DataPtr: IDCMPHandlerDataPtr): BOOLEAN;
  BEGIN
    WITH DataPtr^.msgPtrPtr^^ DO
      ZeichneKugel(mouseX, mouseY, 10.0);
    END;
    RETURN TRUE
  END MouseHandler;

PROCEDURE Cleanup;
  BEGIN
    IF Window#NIL THEN
      CloseWindow(Window);
    END;
    IF Screen#NIL THEN
      CloseScreen(Screen);
    END;
  END Cleanup;

BEGIN
  Screen:=NIL;
  Window:=NIL;
  TermProcedure(Cleanup);
  InitDisplay;
  IF InitScheduler(Window, Port, Schedule) AND
     InstallIDCMPHandler(Schedule,
                         MouseHandler,
                         IDCMPFlagSet{mouseButtons},
                         0,
                         HandlerFlagSet{},
                         NIL,
                         Handler1) AND
     InstallIDCMPHandler(Schedule,
                         CloseHandler,
                         IDCMPFlagSet{closeWindow},
                         0,
                         HandlerFlagSet{immediate},
                         NIL,
                         Handler2) THEN
    ScheduleIDCMPHandlers;
  END;
END IDCMPTest.