home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / PascalPCQ / Examples / BobTest.p < prev    next >
Text File  |  1991-06-10  |  7KB  |  270 lines
  1. Program BOBTest;
  2.  
  3. {
  4.     This program is based on BobTest.c from the original RKM
  5.     example set.  It simply creates a BOB, then moves it
  6.     around the window until you close the window.
  7. }
  8.  
  9. {$I "Include:Graphics/Gfx.i"}
  10. {$I "Include:Graphics/Rastport.i"}
  11. {$I "Include:Graphics/View.i"}
  12. {$I "Include:Exec/Exec.i"}
  13. {$I "Include:Graphics/Gels.i"}
  14. {$I "Include:Intuition/Intuition.i"}
  15. {$I "Include:Graphics/Graphics.i"}
  16. {$I "Include:Graphics/Pens.i"}
  17.  
  18. Const
  19.     ScreenDepth  = 3;
  20.  
  21.     ObjectWidth  = 48; { Three words wide  }
  22.     ObjectHeight = 30; { Thirty lines tall }
  23.  
  24.     ObjectWords  = (ObjectWidth + 15) div 16;
  25.  
  26.     Memory_Flags = MEMF_PUBLIC or MEMF_CHIP or MEMF_CLEAR;
  27.  
  28. Var
  29.     w    : WindowPtr;
  30.     s    : ScreenPtr;
  31.     rp    : RastPortPtr;
  32.     vp    : ViewPortPtr;
  33.  
  34. Const
  35.     TestFont : TextAttr = ("topaz.font", 8, 0, 0);
  36.  
  37.     ns    : NewScreen = (
  38.     0,0,            { start position               }
  39.     320, 200, ScreenDepth,
  40.     0, 1,            { detail pen, block pen        }
  41.     0,            { viewing mode (was HIRES)     }
  42.     CUSTOMSCREEN_f,        { screen type                  }
  43.     @TestFont,        { font to use                  }
  44.     "GELS Example Program",    { default title for screen     }
  45.     Nil,            { pointer to additional gadgets }
  46.     Nil
  47.     );
  48.  
  49.     WINDOWFLAGS = GIMMEZEROZERO or WINDOWDRAG or WINDOWSIZING or
  50.           WINDOWDEPTH or WINDOWCLOSE or ACTIVATE;
  51.  
  52.     nw    : NewWindow = (
  53.         20, 20,                 { start position               }
  54.         220, 150,               { width, height                }
  55.         -1, -1,                 { detail pen, block pen        }
  56.         CLOSEWINDOW_f,        { IDCMP flags                  }
  57.         WINDOWFLAGS,        { window flags                 }
  58.         Nil,                    { pointer to first user gadget }
  59.         Nil,                    { pointer to user checkmark    } 
  60.         "Bouncing BOB",         { window title         } 
  61.         Nil,                    { pointer to screen    (later) }
  62.         Nil,                    { pointer to superbitmap       }
  63.         30,20,-1,-1,            { sized window }
  64.         CUSTOMSCREEN_f          { type of screen in which to open }   
  65.         );
  66.  
  67.  
  68.  
  69. var
  70.     s1, s2    : VSprite;    { dummy sprites for gels list }
  71.     mygelsinfo    : GelsInfo;    { gelsinfo to link into system rastport }
  72.     collisiontable    : collTable;
  73.  
  74.     v    : VSprite;
  75.     b    : Bob;
  76.  
  77.     i    : Short;
  78.  
  79.     UsedMemory    : RememberPtr;
  80.  
  81.     BorderMask,        { Used for detecting collisions with border }
  82.     CMask,        { Collision, or shadow, mask }
  83.     Images,        { The actual image data }
  84.     BackBuffer    : ^Array [0..MaxInt] of Short;
  85.  
  86.     xspeed    : Short;
  87.     yspeed    : Short;
  88.  
  89. Function GetGfxMem(size : Integer) : Address;
  90. var
  91.     Result : Address;
  92. begin
  93.     Result := AllocRemember(UsedMemory,size,Memory_Flags);
  94.     if Result = Nil then begin
  95.     CloseWindow(w);
  96.     CloseScreen(s);
  97.     CloseLibrary(GfxBase);
  98.     FreeRemember(UsedMemory,True);
  99.     Writeln('Could not allocate memory');
  100.     Exit(20);
  101.     end;
  102.     GetGfxMem := Result;
  103. end;
  104.  
  105. Procedure InitializeBOB;
  106. begin
  107.     with MyGelsInfo do begin
  108.     nextLine  := Nil;
  109.     lastColor := Nil;
  110.     collHandler := @collisiontable;
  111.     end;
  112.  
  113.     InitGels(@s1, @s2, @MyGelsInfo);
  114.     rp^.GelsInfo := @MyGelsInfo;
  115.  
  116.     with v do begin
  117.     X       := 20;
  118.     Y       := 4;
  119.     Flags   := OVERLAY + SAVEBACK;
  120.     Height  := ObjectHeight;
  121.     Width   := ObjectWords;
  122.     Depth   := ScreenDepth;
  123.  
  124.     MeMask  := 1;
  125.     HitMask := 1;
  126.  
  127.     Images     := GetGfxMem(ObjectWords * ObjectHeight * ScreenDepth * 2);
  128.     BackBuffer := GetGfxMem(Succ(ObjectWords) * ObjectHeight * ScreenDepth * 2);
  129.  
  130.     CMask      := GetGfxMem(ObjectWords * ObjectHeight * 2);
  131.     BorderMask := GetGfxMem(ObjectWords * 2);
  132.  
  133.     { Set first bit plane like:     1 0 1 }
  134.     {                1 0 1 }
  135.     {                1 0 1 }
  136.  
  137.     for i := 0 to Pred(ObjectHeight) do begin
  138.         Images^[i*ObjectWords]     := $FFFF;
  139.         Images^[i*ObjectWords + 2] := $FFFF;
  140.     end;
  141.  
  142.     { Set second bit plane like:    0 1 1 }
  143.     {                0 1 1 }
  144.     {                0 1 1 }
  145.  
  146.     for i := ObjectHeight to Pred(ObjectHeight * 2) do begin
  147.         Images^[i*ObjectWords+1] := $FFFF;
  148.         Images^[i*ObjectWords+2] := $FFFF;
  149.     end;
  150.  
  151.     ImageData := Images;    { Point VSprite to image data }
  152.     CollMask  := CMask;    { Point to collision mask area }
  153.     BorderLine := BorderMask; { Point to border mask area }
  154.  
  155.     InitMasks(@v);        { Set up collision & border masks }
  156.  
  157.     PlanePick := $03;     { Just use first two planes }
  158.     PlaneOnOff := 4;      { Set third plane solid }
  159.     end;
  160.  
  161.         { ****************** now initialize the Bob variables ******* }       
  162.  
  163.     with b do begin
  164.     Flags := 0;
  165.     SaveBuffer := BackBuffer;  { show where to save background }
  166.     ImageShadow := CMask;   { collision and shadow are same }
  167.     Before := Nil;        { dont care about drawing order }
  168.     After := Nil; 
  169.  
  170.     BobComp := Nil;       { not animation component }
  171.     DBuffer := Nil;       { not double buffered }
  172.  
  173.     BobVSprite := @v;      { link to the VSprite }
  174.     end;
  175.  
  176.     v.VSBob := @b;        { Link the VSprite to the BOB }
  177.  
  178.     AddBob(@b, rp);        { Add to the GELS list }
  179.     SortGList(rp);        { Sort it for drawing }
  180.     WaitTOF;            { Sync with beam }
  181.     DrawGList(rp,vp);        { Draw the BOBs, etc. }
  182. end;
  183.  
  184. Procedure MoveBOB;
  185. var
  186.     M : MessagePtr;
  187. begin
  188.     while true do begin
  189.     Inc(b.BobVSprite^.Y,yspeed);
  190.         if b.BobVSprite^.Y > (w^.GZZHeight - ObjectHeight) then
  191.         yspeed := -yspeed
  192.     else
  193.         Inc(yspeed);
  194.  
  195.     Inc(b.BobVSprite^.X,xspeed);
  196.         if (b.BobVSprite^.X >= (w^.GZZWidth - ObjectWidth)) or
  197.        (b.BobVSprite^.X <= 0) then
  198.         xspeed := -xspeed;
  199.  
  200.         SortGList(rp);
  201.         WaitTOF;
  202.         DrawGList(rp,vp);
  203.     M := GetMsg(w^.UserPort);
  204.     if M <> Nil then begin
  205.         ReplyMsg(M);
  206.         return;
  207.     end;
  208.     end;
  209. end;
  210.  
  211.  
  212. Procedure Setup;
  213. var
  214.     i : Short;
  215.     p : Byte;
  216. begin
  217.     UsedMemory := Nil;    { To keep track of allocations }
  218.  
  219.     GfxBase := OpenLibrary("graphics.library", 0);
  220.     if GfxBase = Nil then begin
  221.     Writeln("Unable to open graphics library");
  222.     exit(20);
  223.     end;
  224.  
  225.     s := OpenScreen(@ns);
  226.     nw.Screen := s;
  227.  
  228.     w := OpenWindow(@nw);            { open a window }
  229.     rp := w^.RPort;
  230.     vp := ViewPortAddress(w);
  231.  
  232.     xspeed := 2;
  233.     yspeed := 0;
  234.  
  235.     SetRGB4(vp,5, 0, 0,12);    { Set flag colors to blue...}
  236.     SetRGB4(vp,6,15,15,15);    { white }
  237.     SetRGB4(vp,7,12, 0, 0);    { red }
  238.  
  239.     { Draw some sort of pattern in the window to show that }
  240.     { we aren't messing it up.                             }
  241.  
  242.     p := 1;
  243.     SetAPen(rp,p);
  244.     for i := 0 to w^.GZZWidth do begin
  245.     Move(rp,i,0);
  246.     Draw(rp,w^.GZZWidth - i,w^.GZZheight);
  247.     p := Succ(p) and 3;
  248.     SetAPen(rp,p);
  249.     end;
  250.     for i := 0 to w^.GZZheight do begin
  251.     Move(rp, 0, i);
  252.     Draw(rp, w^.GZZWidth, w^.GZZheight - i);
  253.     p := Succ(p) and 3;
  254.     SetAPen(rp,p);
  255.     end;
  256. end;
  257.  
  258. begin
  259.     SetUp;
  260.     InitializeBOB;
  261.     MoveBOB; 
  262.  
  263.     RemBob(@b);
  264.  
  265.     FreeRemember(UsedMemory,True);
  266.     CloseWindow(w);
  267.     CloseScreen(s);
  268.     CloseLibrary(GfxBase);
  269. end.
  270.