home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 254a.lha / PCQ / Examples / Moire.p < prev    next >
Encoding:
Text File  |  1989-05-10  |  3.6 KB  |  143 lines
  1. Program Moire;
  2.  
  3.     { This program just draws a Moire pattern in a window.
  4.       It uses a surprising breadth of functions, so it shows
  5.       off a bit of what PCQ can do.  And it works to boot. }
  6.  
  7. {$I "Include/Exec.i" for Forbid, Permit and library things }
  8. {$I "Include/Ports.i" for the Message stuff }
  9. {$I "Include/Intuition.i" for window & screen structures and functions }
  10. {$I "Include/Graphics.i" for drawing stuff }
  11.  
  12. var
  13.     w  : WindowPtr;
  14.     s  : ScreenPtr;
  15.     m  : MessagePtr;
  16.  
  17. Function OpenTheScreen() : Boolean;
  18. var
  19.     ns : NewScreenPtr;
  20. begin
  21.     new(ns);
  22.  
  23.     ns^.LeftEdge := 0;
  24.     ns^.TopEdge  := 0;
  25.     ns^.Width    := 640;
  26.     ns^.Height   := 200;
  27.     ns^.Depth    := 2;
  28.     ns^.DetailPen := 3;
  29.     ns^.BlockPen  := 2;
  30.     ns^.ViewModes := 32768;
  31.     ns^.SType     := CUSTOMSCREEN_f;
  32.     ns^.Font      := nil;
  33.     ns^.DefaultTitle := "Close the Window to End This Demonstration";
  34.     ns^.Gadgets   := nil;
  35.     ns^.CustomBitMap := nil;
  36.  
  37.     s := OpenScreen(ns);
  38.     dispose(ns);
  39.     OpenTheScreen := s <> nil;
  40. end;
  41.  
  42. Function OpenTheWindow() : Boolean;
  43. var
  44.     nw : NewWindowPtr;
  45. begin
  46.     new(nw);
  47.  
  48.     nw^.LeftEdge := 20;
  49.     nw^.TopEdge := 50;
  50.     nw^.Width := 300;
  51.     nw^.Height := 100;
  52.  
  53.     nw^.DetailPen := -1;
  54.     nw^.BlockPen  := -1;
  55.     nw^.IDCMPFlags := CLOSEWINDOW_f;
  56.     nw^.Flags := WINDOWSIZING_f + WINDOWDRAG_f + WINDOWDEPTH_f +
  57.          WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
  58.     nw^.FirstGadget := nil;
  59.     nw^.CheckMark := nil;
  60.     nw^.Title := "Feel Free to Re-Size the Window";
  61.     nw^.Screen := s;
  62.     nw^.BitMap := nil;
  63.     nw^.MinWidth := 50;
  64.     nw^.MaxWidth := -1;
  65.     nw^.MinHeight := 20;
  66.     nw^.MaxHeight := -1;
  67.     nw^.WType := CUSTOMSCREEN_f;
  68.  
  69.     w := OpenWindow(nw);
  70.     dispose(nw);
  71.     OpenTheWindow := w <> nil;
  72. end;
  73.  
  74. Procedure DoDrawing(RP : RastPortPtr);
  75. var
  76.     x  : Integer;
  77.     Pen : Integer;
  78.     Stop : Integer;
  79. begin
  80.  
  81. {
  82.     Note that for all the border things I have to use ord() to
  83. use them in calculations.  This is because I have not yet added a
  84. byte type to PCQ (I didn't realize I needed one until I started
  85. using system functions).  Just for your information, I'll point out
  86. that ord() here has the same overhead that mixing byte and integer
  87. types would have anyway.
  88. }
  89.  
  90.     Pen := 1;
  91.     while true do begin
  92.     Stop := w^.Width - w^.BorderRight;
  93.     for x:= 0 to Stop - w^.BorderLeft do begin
  94.         SetAPen(RP, Pen);
  95.         Move(RP, x + w^.BorderLeft, w^.BorderTop);
  96.         Draw(RP, Stop - x, w^.Height - w^.BorderBottom);
  97.         Pen := (Pen + 1) mod 4;
  98.         m := GetMsg(w^.UserPort);
  99.         if m <> nil then
  100.         return;
  101.     end;
  102.     Stop := w^.Height - w^.BorderBottom;
  103.     for x := 0 to Stop - w^.BorderTop do begin
  104.         SetAPen(RP, Pen);
  105.         Move(RP, w^.Width - w^.BorderRight, x + w^.BorderTop);
  106.         Draw(RP, w^.BorderLeft, Stop - x);
  107.         Pen := (Pen + 1) mod 4;
  108.         m := GetMsg(w^.UserPort);
  109.         if m <> nil then
  110.         return;
  111.     end;
  112.     end;
  113. end;
  114.  
  115. begin
  116.     { Note that the startup code of all PCQ programs depends on
  117.       Intuition, so if we got to this point Intuition must be
  118.       open, so the run time library just uses the pointer that
  119.       the startup code created.  Same with DOS, although we don't
  120.       use that here. }
  121.  
  122.     GfxBase := OpenLibrary("graphics.library", 0);
  123.     if GfxBase <> nil then begin
  124.     if OpenTheScreen() then begin
  125.         if OpenTheWindow() then begin
  126.         DoDrawing(w^.RPort);
  127.         Forbid;
  128.         repeat
  129.             m := GetMsg(w^.UserPort);
  130.         until m = nil;
  131.         CloseWindow(w);
  132.         Permit;
  133.         end else
  134.         writeln('Could not open the window');
  135.         CloseScreen(s);
  136.     end else
  137.         writeln('Could not open the screen.');
  138.     CloseLibrary(GfxBase);
  139.     end else
  140.     writeln('Could not open graphics.library');
  141. end.
  142.  
  143.