home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / tpw / pasdk / splat.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-18  |  9.8 KB  |  292 lines

  1. {$A-,B-,D-,F-,G-,I+,L-,N-,R-,S-,V+,W+,X+}
  2. {$M 4096,4096}
  3. Library Splat;
  4.  
  5.   (* SPLAT.PAS - An AfterDark Module
  6.    * Written by Richard R. Sands 04/91 Copyright ⌐ Richard R. Sands 1991
  7.    *
  8.    * This module "throws" globs of paint onto the screen where they drip
  9.    * down.
  10.    *
  11.    * Written with the object-oriented AfterDark module in Borland's
  12.    * Turbo Pascal for Windows.
  13.    *)
  14.  
  15.   USES WinTypes, WinProcs, Strings, AfterDark;
  16.  
  17.   CONST
  18.      MaxColors = 8;
  19.      Colors : Array[0..MaxColors] of TColorRef =
  20.          ($000000, $0000FF,  $00FF00, $FF0000,
  21.           $00FFFF, $FF00FF,  $FFFF00, $FFFFFF, $808080);
  22.  
  23.   TYPE
  24.     SplatData = Record        { Data for Value Table }
  25.        BrushSize : Integer;
  26.        DripLength: Integer;
  27.     end;
  28.  
  29.     SplatRec = Record         { Information regarding Splat State }
  30.       I        : Integer;         { Drip Index }
  31.       Go       : Boolean;         { Start the Splat }
  32.       RgbColor : LongInt;         { Color      }
  33.       Width    : Integer;         { Width of ellipse rectangle from Center }
  34.       CenterX  : Integer;         { Center X of Rectangle }
  35.       CenterY  : Integer;         { Center Y of Rectangle }
  36.       Count    : Integer;
  37.       BrushDat : Integer;         { Index to splat Data Value Table }
  38.     end;
  39.  
  40.   CONST
  41.     MaxSplats = 10;
  42.     SplatDat : Array[0..2] of SplatData = (
  43.                            (BrushSize:4; DripLength:50),
  44.                            (BrushSize:8; DripLength:30),
  45.                            (BrushSize:12; DripLength:30));
  46.  
  47.   TYPE
  48.      TSplat = object(TAfterDark)
  49.        Splats : Array[1..MaxSplats] of SplatRec;  { Each Splat }
  50.        Initted: Boolean;                         { Are we done splatting these? }
  51.        BlankFirst: Boolean;                      { Blank screen first? }
  52.        Size   : Integer;                         { What size splats? }
  53.        Max    : Integer;                         { Number of simultanius Splats }
  54.        Cur    : Integer;                         { Current Splat we are splatting }
  55.        function DoInitialize:Integer; virtual;
  56.        function DoBlank:Integer; virtual;
  57.        function DoDrawFrame:Integer; virtual;
  58.        function DoButtonMessage1(Value:Integer):Integer; virtual;
  59.        function DoButtonMessage2(Value:Integer):Integer; virtual;
  60.        function DoButtonMessage3(Value:Integer):Integer; virtual;
  61.        function DoClose:Integer; virtual;
  62.      end;
  63.  
  64. { ------------------------------------------------------------------------ }
  65. { TSplat                                                                    }
  66. { ------------------------------------------------------------------------ }
  67. function TSplat.DoInitialize:Integer;
  68.   begin
  69.      Initted := FALSE;  { We haven't even begun yet! }
  70.      Max := 3;
  71.      Size := 4;        { Random Splats }
  72.      BlankFirst := FALSE;
  73.      DoInitialize := NOERROR
  74.   end;
  75.  
  76. { ------------------------------------------------------------------------ }
  77. Function TSplat.DoClose:Integer;
  78.   var Buffer: Array[0..16] of char;
  79.       c1,c2,c3:String[3];
  80.   begin
  81.      Str(lpModule^.iControlValue[0], c1);
  82.      Str(lpModule^.iControlValue[1], c2);
  83.      Str(lpModule^.iControlValue[2], c3);
  84.      StrPCopy(Buffer, c1 + ',' + c2 + ',' + c3);
  85.      WritePrivateProfileString('Splat', 'info', Buffer, 'ad_prefs.ini')
  86.   end;
  87.  
  88. { ------------------------------------------------------------------------ }
  89. function TSplat.DoBlank:Integer;
  90.   const rBlank : TRect = (Left:0;Top:0);
  91.   begin
  92.      DoBlank := TAfterDark.DoBlank;
  93.      if BlankFirst then
  94.      begin
  95.         SetRect(rBlank, 0, 0, lpModule^.ptRgnSize.x, lpModule^.ptRgnSize.y);
  96.         FillRect (DC, rBlank, GetStockObject(BLACK_BRUSH))
  97.      end;
  98.   end;
  99.  
  100. { ------------------------------------------------------------------------ }
  101. function TSplat.DoDrawFrame:Integer;
  102.   var
  103.     OldPen, Pen : HPen;
  104.     OldBrush, Brush: HBrush;
  105.     LB: TLogBrush;
  106.     HalfBrush: Integer;
  107.  
  108.   procedure Circle(CenterX, CenterY, Width:Integer);
  109.     var x1, y1, x2,y2:Integer;
  110.     begin
  111.        x1 := centerX - Width;
  112.        x2 := centerX + Width;
  113.        y1 := centerY - Width;
  114.        y2 := centerY + Width;
  115.        Ellipse(DC, x1, y1, x2, y2)
  116.     end;
  117.  
  118.   function InRange(I:Integer):Boolean;
  119.     { This function checks the current splat will intersect any of the
  120.       precceding splats }
  121.     var J:Integer;
  122.         CurXL, CurXR : Integer;
  123.     begin
  124.        if I = 1 then EXIT;  { OK }
  125.        InRange := FALSE; { Assume the worst }
  126.        CurXL := Splats[i].CenterX - Splats[i].Width;  { Left End }
  127.        CurXR := Splats[i].CenterX + Splats[i].Width;  { Right End }
  128.        for J:=1 to pred(I) do { each splat }
  129.        begin
  130.           if ((CurXL>=(Splats[j].CenterX - Splats[j].Width)) AND
  131.               (CurXL<=(Splats[j].CenterX + Splats[j].Width))) OR
  132.              ((CurXR>=(Splats[j].CenterX - Splats[j].Width)) AND
  133.              (CurXR<=(Splats[j].CenterX + Splats[j].Width))) then
  134.           begin
  135.              InRange := TRUE;
  136.              EXIT
  137.           end
  138.        end
  139.     end;
  140.  
  141.   procedure CheckFinished;
  142.     var S: Integer;
  143.     begin
  144.        for S := 1 to Max do
  145.           if Splats[S].I <= Splats[S].Count then EXIT;
  146.        Initted := FALSE  { Next Frame, we will reinit }
  147.     end;
  148.  
  149.   procedure InitSplats;
  150.     var S,S1 : Integer;
  151.     begin
  152.        for S :=1 to Max do
  153.        begin
  154.           with Splats[S] do
  155.           begin
  156.              I       := 1;
  157.              RgbColor:= Colors[random(MaxColors+1)];
  158.              if Size < 4 then
  159.                BrushDat := pred(Size)  { User Picked a Splat Size }
  160.              else
  161.                BrushDat:= random(3);
  162.              width   := 5 + SplatDat[BrushDat].BrushSize + random(15);   { half width of rectangle }
  163.              Count   := SplatDat[BrushDat].DripLength + random(25);   { length of the drip }
  164.  
  165.              { This next loop -tries- to keep the splats from intersecting
  166.                each other - it makes a very non-splat effect - by checking
  167.                if the current splat intersect the bounds of any previous
  168.                splat.  HOWEVER, since it is random, there is a chance of
  169.                some serious delay while it keeps recalculating new bounds.
  170.                This is suppress by only recalculating 7 times and giving
  171.                up, thus once in a while it's possible that an intersect
  172.                might happen. }
  173.              S1 := 1;
  174.              Repeat
  175.                 centerX := random(lpModule^.ptRgnSize.X);  { center X of rectangle }
  176.                 inc(S1);
  177.              Until (Not InRange(S)) OR (S1>7) { Five Hits };
  178.  
  179.              { Calc center Y of rectangle }
  180.              centerY := random(lpModule^.ptRgnSize.Y-(lpModule^.ptRgnSize.Y div 4));
  181.              Go := S = 1
  182.           end
  183.        end;
  184.        Cur := 1;       { Reset states }
  185.        Initted := TRUE
  186.     end;
  187.  
  188. const
  189.    InValidRange: PChar = 'Invalid Range Values';
  190. begin
  191.    if (Max<1) OR (Max>10) OR (Size<1) OR (Size>4) THEN
  192.    begin
  193.       DoDrawFrame := USER_ERROR;
  194.       lpSystemAD^.lpszErrorMessage := InvalidRange;   { POINTER TO ERROR STRING                  }
  195.       EXIT
  196.    end;
  197.    if NOT Initted then  { --- (re)initialize the splats --- }
  198.      InitSplats;
  199.  
  200.    if (Splats[Cur].I <= Splats[Cur].Count) AND (Splats[Cur].Go) then  { Continue to splat }
  201.    begin
  202.        With Splats[Cur] do
  203.        begin
  204.            HalfBrush := SplatDat[BrushDat].BrushSize div 2;
  205.  
  206.            Pen := CreatePen(ps_Solid, SplatDat[BrushDat].BrushSize, RgbColor);
  207.            OldPen := SelectObject(DC, Pen);
  208.            LB.lbStyle := bs_solid;
  209.            LB.lbColor := RgbColor;
  210.            LB.lbHatch := bs_solid;
  211.            Brush := CreateBrushIndirect(LB);
  212.            OldBrush := SelectObject(DC, Brush);
  213.  
  214.            { Are we still Drawing the Splat? }
  215.            if Width > SplatDat[BrushDat].BrushSize then
  216.            begin
  217.                Circle(CenterX, CenterY, Width);
  218.                dec(Width, HalfBrush);
  219.                inc(CenterY, SplatDat[BrushDat].BrushSize)
  220.            end
  221.            else
  222.            begin
  223.                { Make the drip }
  224.                Circle(CenterX, CenterY, Width);
  225.                inc(CenterY, HalfBrush);
  226.                inc(I);
  227.                if I = Count div 2 then
  228.                begin
  229.                    { Make drip a little smaller if possible }
  230.                    if Width > (HalfBrush) then
  231.                      dec(Width, HalfBrush);
  232.                end;
  233.                { And Start the next Splat }
  234.                if Cur < 10 then
  235.                  if I >= (Count div Max) then
  236.                  Splats[Cur+1].Go := TRUE;
  237.            end
  238.        end;
  239.        SelectObject(DC, OldPen);
  240.        SelectObject(DC, OldBrush);
  241.        DeleteObject(Pen);
  242.        DeleteObject(Brush)
  243.    end
  244.    else  { Check if we are finished }
  245.       CheckFinished;
  246.    if Cur = Max then Cur := 1
  247.    else
  248.      inc(Cur);
  249.    DoDrawFrame := NOERROR
  250. end;
  251.  
  252. { ------------------------------------------------------------------------ }
  253. function TSplat.DoButtonMessage1(Value:Integer):Integer;
  254.   begin
  255.      case value of
  256.        0 : Size := 1;
  257.        25: Size := 2;
  258.        50: Size := 3;
  259.      else
  260.        Size := 4
  261.      end;
  262.      Initted := FALSE;
  263.      DoButtonMessage1 := NOERROR
  264.   end;
  265.  
  266. { ------------------------------------------------------------------------ }
  267. function TSplat.DoButtonMessage2(Value:Integer):Integer;
  268.   begin
  269.      if Value in [1..10] then
  270.        Max := Value
  271.      else
  272.        Max := 3;
  273.      Initted := FALSE;
  274.      DoButtonMessage2 := NOERROR;
  275.   end;
  276.  
  277. { ------------------------------------------------------------------------ }
  278. function TSplat.DoButtonMessage3(Value:Integer):Integer;
  279.   begin
  280.      BlankFirst := Value = 1;
  281.      DoButtonMessage3 := NOERROR
  282.   end;
  283.  
  284. { ------------------------------------------------------------------------ }
  285. EXPORTS Module;
  286.  
  287. VAR MySaver : TSplat;
  288.  
  289. begin
  290.    MySaver.Init  { Initialize our Module  }
  291. end.
  292.