Program BOBTest;

{
    Ce programme s'appuie sur BobTest.c qu'on trouve dans
    l'ensemble original d'exemples du RKM. Le programme se
    limite à créer un BOB et à le déplacer ensuite dans la
    fenêtre tant qu'on ne la fermera pas.
}

{$I "Include:Graphics/Gfx.i"}
{$I "Include:Graphics/Rastport.i"}
{$I "Include:Graphics/View.i"}
{$I "Include:Exec/Exec.i"}
{$I "Include:Graphics/Gels.i"}
{$I "Include:Intuition/Intuition.i"}
{$I "Include:Graphics/Graphics.i"}
{$I "Include:Graphics/Pens.i"}

Const
    ScreenDepth  = 3;

    ObjectWidth  = 48; { Largeur trois mots }
    ObjectHeight = 30; { Hauteur trente lignes }

    ObjectWords  = (ObjectWidth + 15) div 16;

    Memory_Flags = MEMF_PUBLIC or MEMF_CHIP or MEMF_CLEAR;

Var
    w   : WindowPtr;
    s   : ScreenPtr;
    rp   : RastPortPtr;
    vp   : ViewPortPtr;

Const
    TestFont : TextAttr = ("topaz.font", 8, 0, 0);

    ns   : NewScreen = (
   0,0,          { position écran              }
   320, 200, ScreenDepth,
   0, 1,         { couleur texte, couleur barre        }
   0,            { mode d'affichage (était HIRES)     }
   CUSTOMSCREEN_f,      { type d'écran                 }
   @TestFont,      { fonte employée               }
   "GELS Example Program",   { titre par défaut de l'écran }
   Nil,         { pointeur sur gadgets additionnels }
   Nil
   );

    WINDOWFLAGS = GIMMEZEROZERO or WINDOWDRAG or WINDOWSIZING or
        WINDOWDEPTH or WINDOWCLOSE or ACTIVATE;

    nw   : NewWindow = (
        20, 20,                 { positions fenêtre            }
        220, 150,               { largeur, hauteur             }
        -1, -1,                 { couleur texte, couleur barre }
        CLOSEWINDOW_f,          { flags IDCMP                  }
        WINDOWFLAGS,            { flags pour la fenêtre        }
        Nil,                    { pointeur sur premier gadget utilisateur }
        Nil,                    { pointeur sur crochet utilisateur }
        "Bouncing BOB",         { titre de la fenêtre          }
        Nil,                    { pointeur sur l'écran (cf. plus loin) }
        Nil,                    { pointeur sur superbitmap     }
        30,20,-1,-1,            { fenêtre dimensionnable       }
        CUSTOMSCREEN_f          { type d'écran où se produit l'ouverture }
        );



var
    s1, s2   : VSprite;   { lutins bidon pour la liste des 'gels' }
    mygelsinfo   : GelsInfo; { gelsinfo à relier avec rastport du système }
    collisiontable   : collTable;

    v   : VSprite;
    b   : Bob;

    i   : Short;

    UsedMemory   : RememberPtr;

    BorderMask,      { Utilisé pour détecter les collisions avec le bord }
    CMask,           { Collision ou cache, masque }
    Images,          { Les données réelles de l'image }
    BackBuffer   : ^Array [0..MaxInt] of Short;

    xspeed   : Short;
    yspeed   : Short;

Function GetGfxMem(size : Integer) : Address;
var
    Result : Address;
begin
    Result := AllocRemember(UsedMemory,size,Memory_Flags);
    if Result = Nil then begin
   CloseWindow(w);
   CloseScreen(s);
   CloseLibrary(GfxBase);
   FreeRemember(UsedMemory,True);
   Writeln('Could not allocate memory');
   Exit(20);
    end;
    GetGfxMem := Result;
end;

Procedure InitializeBOB;
begin
    with MyGelsInfo do begin
   nextLine  := Nil;
   lastColor := Nil;
   collHandler := @collisiontable;
    end;

    InitGels(@s1, @s2, @MyGelsInfo);
    rp^.GelsInfo := @MyGelsInfo;

    with v do begin
   X       := 20;
   Y       := 4;
   Flags   := OVERLAY + SAVEBACK;
   Height  := ObjectHeight;
   Width   := ObjectWords;
   Depth   := ScreenDepth;

   MeMask  := 1;
   HitMask := 1;

   Images     := GetGfxMem(ObjectWords * ObjectHeight * ScreenDepth * 2);
   BackBuffer := GetGfxMem(Succ(ObjectWords) * ObjectHeight * ScreenDepth * 2);

   CMask      := GetGfxMem(ObjectWords * ObjectHeight * 2);
   BorderMask := GetGfxMem(ObjectWords * 2);

   { Mettre en place le premier plan de bits sous la forme :   1 0 1 }
   {                                                           1 0 1 }
   {                                                           1 0 1 }

   for i := 0 to Pred(ObjectHeight) do begin
       Images^[i*ObjectWords]     := $FFFF;
       Images^[i*ObjectWords + 2] := $FFFF;
   end;

   { Mettre en place le deuxième plan de bits sous la forme :   0 1 1 }
   {                                                            0 1 1 }
   {                                                            0 1 1 }

   for i := ObjectHeight to Pred(ObjectHeight * 2) do begin
       Images^[i*ObjectWords+1] := $FFFF;
       Images^[i*ObjectWords+2] := $FFFF;
   end;

   ImageData := Images;   { Pointeur VSprite sur les données de l'image }
   CollMask  := CMask;    { Pointeur sur la zone du masque de collision }
   BorderLine := BorderMask; { Pointer sur la zone du masque des bords }

   InitMasks(@v);  { Mettre en place les masques de collision et des bords }

   PlanePick := $03;     { N'utiliser que les deux premiers plans }
   PlaneOnOff := 4;      { Mettre en place le troisième plan fixe }
    end;

        { ******* maintenant initialiser les variables du Bob ******* }

    with b do begin
   Flags := 0;
   SaveBuffer := BackBuffer;  { indiquer où sauvegarder l'arrière-plan }
   ImageShadow := CMask;      { la collision et le cache sont identiques }
   Before := Nil;             { ne pas s'occuper de l'ordre du dessin }
   After := Nil; 

   BobComp := Nil;       { aucun composant pour l'animation }
   DBuffer := Nil;       { pas de double tampon }

   BobVSprite := @v;     { réunir avec VSprite }
    end;

    v.VSBob := @b;       { Réunir le VSprite avec le BOB }

    AddBob(@b, rp);      { Ajouter le BOB à la liste des GELS }
    SortGList(rp);       { Tri pour dessin }
    WaitTOF;             { Synchronisation avec le faisceau électronique }
    DrawGList(rp,vp);    { Dessiner les BOBs, etc. }
end;

Procedure MoveBOB;
var
    M : MessagePtr;
begin
    while true do begin
   Inc(b.BobVSprite^.Y,yspeed);
        if b.BobVSprite^.Y > (w^.GZZHeight - ObjectHeight) then
       yspeed := -yspeed
   else
       Inc(yspeed);

   Inc(b.BobVSprite^.X,xspeed);
        if (b.BobVSprite^.X >= (w^.GZZWidth - ObjectWidth)) or
      (b.BobVSprite^.X <= 0) then
       xspeed := -xspeed;

        SortGList(rp);
        WaitTOF;
        DrawGList(rp,vp);
   M := GetMsg(w^.UserPort);
   if M <> Nil then begin
       ReplyMsg(M);
       return;
   end;
    end;
end;


Procedure Setup;
var
    i : Short;
    p : Byte;
begin
    UsedMemory := Nil;   { Pour garder trace des affectations }

    GfxBase := OpenLibrary("graphics.library", 0);
    if GfxBase = Nil then begin
   Writeln("Unable to open graphics library");
   exit(20);
    end;

    s := OpenScreen(@ns);
    nw.Screen := s;

    w := OpenWindow(@nw);     { ouvrir une fenêtre }
    rp := w^.RPort;
    vp := ViewPortAddress(w);

    xspeed := 2;
    yspeed := 0;

    SetRGB4(vp,5, 0, 0,12);   { Mettre le flag couleurs à bleu... }
    SetRGB4(vp,6,15,15,15);   { à blanc }
    SetRGB4(vp,7,12, 0, 0);   { à rouge }

    { Dessiner quelques motifs dans la fenêtre pour montrer que }
    { nous n'avons pas semé la pagaïe.                          }

    p := 1;
    SetAPen(rp,p);
    for i := 0 to w^.GZZWidth do begin
   Move(rp,i,0);
   Draw(rp,w^.GZZWidth - i,w^.GZZheight);
   p := Succ(p) and 3;
   SetAPen(rp,p);
    end;
    for i := 0 to w^.GZZheight do begin
   Move(rp, 0, i);
   Draw(rp, w^.GZZWidth, w^.GZZheight - i);
   p := Succ(p) and 3;
   SetAPen(rp,p);
    end;
end;

begin
    SetUp;
    InitializeBOB;
    MoveBOB; 

    RemBob(@b);

    FreeRemember(UsedMemory,True);
    CloseWindow(w);
    CloseScreen(s);
    CloseLibrary(GfxBase);
end.