home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EXPLOD.ZIP / EXPLODE.DOC < prev   
Encoding:
Text File  |  1988-01-13  |  14.9 KB  |  464 lines
  1. This file describes changes required to the Turbo Professional TPWINDOW unit
  2. (version 4.00 or 4.01) in order to add capabilities for "exploding windows."
  3. Exploding windows are those which start small and quickly grow to their full
  4. size on screen. When such a window is erased from the screen, it shrinks
  5. gradually away to nothing.
  6.  
  7. Special thanks to David Gerrold, who significantly improved the aesthetics of
  8. the original exploding windows by making them start from a smaller box and
  9. grow more smoothly to their final size. This version incorporates his changes.
  10.  
  11. Turbo Professional is a commercial library of 400 procedures and functions for
  12. Turbo Pascal 4.0. Contact TurboPower Software at 408-438-8608 for more
  13. information about this product. You must already own Turbo Professional in
  14. order for this file to be of much use.
  15.  
  16. To use this file, print it out or read it into a multi-file text editor while
  17. you edit the TPWINDOW.PAS source file. Then follow the directions below to
  18. modify your copy of TPWINDOW. Once the edits are made you should be able to
  19. recompile the TPWINDOW unit.
  20.  
  21. The changes made here are transparent to the calling program. That is,
  22. existing programs will continue to work unchanged. To activate exploding
  23. windows, set the boolean constant Explode to True prior to calling MakeWindow.
  24. You can have a mixture of exploding and normal windows by changing the value
  25. of Explode to the desired value prior to calling MakeWindow each time.
  26.  
  27. You can also modify the constant ExplodeDelay, which specifies the number of
  28. milliseconds delay per stage of the explosion. The default value of 15 ms
  29. seemed right to us, but you may prefer a shorter or longer value.
  30.  
  31. Also, you can change the constant SoundFlagW to enable sound effects while
  32. windows explode and implode. The example program demonstrates this -- give it
  33. a try!
  34.  
  35. Generally, the parameters SaveWindow and ClearWindow that are passed to
  36. MakeWindow should be False when exploding windows are in use. A side effect of
  37. exploding windows is to clear the window when it explodes. Setting SaveWindow
  38. to True thus effectively disables exploding windows. The DrawFrame parameter
  39. to MakeWindow may be either True or False when using exploding windows.
  40.  
  41. A demonstration program, DEMO.PAS, is also supplied with this file. Once
  42. you've modified TPWINDOW, compile DEMO.PAS to see how the explosions and
  43. implosions look and feel.
  44.  
  45. This file also incorporates additional changes to TPWINDOW, including a new
  46. routine (SelectTopWindow) that allows "no-flash" selection of tiled windows.
  47.  
  48. ************************************************************************
  49.  
  50. Modifications to TPWINDOW.PAS source code
  51.  
  52. I + in the left hand margin means to insert a new line
  53. D - in the left hand margin means to delete existing line
  54. Surrounding lines are shown for reference
  55.  
  56. ************************************************************************
  57. Starting at line 1
  58.  
  59. {$S-,R-,I-,V-,B-}
  60.  
  61. I + {Deactivate the following define if exploding windows are not desired.
  62. I +  Saves about 2200 bytes of code space which cannot be removed by the
  63. I +  Turbo smart linker.}
  64. I + {$DEFINE ExplodingWindows}
  65.  
  66. ************************************************************************
  67. Starting around line 16
  68.  
  69.     uses
  70.       TPCrt;
  71. I +
  72. I + {$IFDEF ExplodingWindows}
  73. I + const
  74. I +   Explode : Boolean = False; {True to make exploding windows}
  75. I +   ExplodeDelay : Word = 15;  {Milliseconds per stage of explosion}
  76. I +   SoundFlagW : Boolean = True; {True to make sound during explosions}
  77. I + {$ENDIF}
  78.  
  79. ************************************************************************
  80. Starting around line 48
  81.  
  82.     function SetTopWindow(W : WindowPtr) : Boolean;
  83.       {-Put already active window on top of stack, returning true if successful}
  84. I +
  85. I + function SelectTopWindow(W : WindowPtr) : Boolean;
  86. I +   {-Make an already active, tiled window the current one}
  87. I +
  88. I + function SelectTiledWindow(W : WindowPtr) : Boolean;
  89. I +   {-Display or reselect (tiled) window}
  90.  
  91. ************************************************************************
  92. Starting around line 59
  93.  
  94.     implementation
  95.  
  96.     type
  97. D -   BufferArray = array[1..MaxInt] of Char; {Will hold screen image}
  98. I +   BufferArray = array[0..MaxInt] of Char; {Will hold screen image}
  99.  
  100. ************************************************************************
  101. Starting around line 87
  102.  
  103.     HeaderP : ^string;       {Stores frame title, nil if none}
  104. I + {$IFDEF ExplodingWindows}
  105. I + Exploding : Boolean;     {True if window displays and erases in stages}
  106. I + ExploDelay : Word;       {Milliseconds per stage of explosion}
  107. I + {$ENDIF}
  108.   end;
  109.  
  110. ************************************************************************
  111. Starting around line 268
  112.  
  113.       {Initialize remaining fields}
  114. I +   WAttr := MapColor(WindowAttr);
  115. I +   HAttr := MapColor(HeaderAttr);
  116. I +   if (XHigh-XLow < 2) or (YHigh-YLow < 2) then
  117. I +     DrawFrame := False;
  118.       if DrawFrame then begin
  119.         {Correct for size of frame}
  120.  
  121. ************************************************************************
  122. Starting around line 276
  123.  
  124.         {Store current frame array}
  125.         Frame := FrameChars;
  126. I +     FAttr := MapColor(FrameAttr);
  127.       end else begin
  128.  
  129. ************************************************************************
  130. Starting around line 282
  131.  
  132.         YH := YHigh;
  133. D -     Frame := #0#0#0#0#0#0;
  134. I +     Frame := '      ';
  135. I +     FAttr := WAttr;
  136.       end;
  137.  
  138. ************************************************************************
  139. Starting around line 287
  140.  
  141.       YH1 := YHigh;
  142. D -   WAttr := MapColor(WindowAttr);
  143. D -   FAttr := MapColor(FrameAttr);
  144. D -   HAttr := MapColor(HeaderAttr);
  145. I +   {Make sure window coordinates are legal}
  146. I +   if (XL > XH) or (YL > YH) then begin
  147. I +     DisposeWindow(W);
  148. I +     Exit;
  149. I +   end;
  150.       Framed := DrawFrame;
  151.  
  152. ************************************************************************
  153. Starting around line 295
  154.  
  155.       DisplayedOnce := False;
  156.  
  157. I +   {$IFDEF ExplodingWindows}
  158. I +   {Initialize for exploding windows}
  159. I +   if (XH1-XL1 < 2) and (YH1-YL1 < 2) then
  160. I +     Exploding := False
  161. I +   else
  162. I +     Exploding := Explode;
  163. I +   ExploDelay := ExplodeDelay;
  164. I +   {$ENDIF}
  165. I +
  166.       {Store cursor information for this window}
  167.  
  168. ************************************************************************
  169. Starting around line 305
  170. Add all of the following routines immediately after the MakeWindow function.
  171. The new routines are not interfaced.
  172.  
  173.   {$IFDEF ExplodingWindows}
  174.   procedure ClearRegion(XL, YL, XH, YH, Attr : Byte);
  175.     {-Clear a region with specified attribute}
  176.   var
  177.     WordsPerRow, Row : Word;
  178.     Span : string;
  179.   begin
  180.     WordsPerRow := Succ(XH-XL);
  181.     Span[0] := Chr(WordsPerRow);
  182.     FillChar(Span[1], WordsPerRow, ' ');
  183.     for Row := YL to YH do
  184.       FastWrite(Span, Row, XL, Attr);
  185.   end;
  186.  
  187.   procedure SetDeltas(var SD, BD : Real; var Frames : Integer);
  188.     {-Compute dimensions for exploding frame}
  189.   begin
  190.     Frames := Round(BD);
  191.     if SD < 1.0 then
  192.       SD := 1.0/Succ(Frames);
  193.     SD := SD/BD;
  194.     BD := 1.0;
  195.   end;
  196.  
  197.   procedure ComputeDeltas(W : WindowPtr;
  198.                           var XD, YD : Real;
  199.                           var Frames : Integer);
  200.     {-Compute information for exploding frame boundaries}
  201.   begin
  202.     with WindowP(W)^ do begin
  203.       XD := Succ(XH1-XL1)/2.0-0.55; {Fudge factor}
  204.       YD := Succ(YH1-YL1)/2.0-0.55;
  205.       if XD < YD then
  206.         SetDeltas(XD, YD, Frames)
  207.       else
  208.         SetDeltas(YD, XD, Frames);
  209.     end;
  210.   end;
  211.  
  212.   procedure ExplodeWindow(W : WindowPtr);
  213.     {-Explode a window}
  214.   var
  215.     XD, YD, dX, dY : Real;
  216.     Frames, F : Integer;
  217.     cXL, cXH, cYL, cYH : Byte;
  218.   begin
  219.     with WindowP(W)^ do begin
  220.       {Compute the smallest frame that will fit}
  221.       ComputeDeltas(W, XD, YD, Frames);
  222.       {Draw a series of frames}
  223.       FrameChars := Frame;
  224.       F := Pred(Frames);
  225.       while F >= 0 do begin
  226.         {Erase region}
  227.         dX := F*XD;
  228.         dY := F*YD;
  229.         cXL := Trunc(XL1+dX);
  230.         cYL := Trunc(YL1+dY);
  231.         cXH := Round(XH1-dX);
  232.         cYH := Round(YH1-dY);
  233.         ClearRegion(cXL, cYL, cXH, cYH, WAttr);
  234.         if Framed then
  235.           {Draw frame around window}
  236.           FrameWindow(cXL, cYL, cXH, cYH, FAttr, FAttr, '');
  237.         {Make a sound}
  238.         if SoundFlagW then
  239.           Sound(1320-F*35);
  240.         if (Frames > 10) and (F > 1) then
  241.           {Use only half the frames for big windows}
  242.           Dec(F);
  243.         Dec(F);
  244.         Delay(ExploDelay);
  245.       end;
  246.       NoSound;
  247.     end;
  248.   end;
  249.  
  250.   procedure RestoreRect(W : WindowPtr; XLc, YLc, XHc, YHc : Byte);
  251.     {-Restore a rectangular screen chunk from the Covers buffer}
  252.   var
  253.     fBPR, cBPR, R : Byte;
  254.     fOfs, cOfs : Word;
  255.   begin
  256.     with WindowP(W)^ do begin
  257.       {Get the bytes per row in full window and in chunk}
  258.       fBPR := 2*Succ(XH1-XL1);
  259.       cBPR := Succ(XHc-XLc);
  260.       {Get the first address to use in the Covers buffer}
  261.       fOfs := fBPR*(YLc-YL1)+2*(XLc-XL1);
  262.       {Get the first address on the screen to restore}
  263.       cOfs := 2*(CurrentWidth*Pred(YLc)+Pred(XLc));
  264.       {Restore row by row}
  265.       for R := YLc to YHc do begin
  266.         MoveScreen(Covers^[fOfs], MemW[VideoSegment:cOfs], cBPR);
  267.         Inc(fOfs, fBPR);
  268.         Inc(cOfs, 2*CurrentWidth);
  269.       end;
  270.     end;
  271.   end;
  272.  
  273.   procedure ImplodeWindow(W : WindowPtr);
  274.     {-Erase an exploding window from the screen}
  275.   var
  276.     XD, YD, dX, dY : Real;
  277.     Frames, F : Integer;
  278.     pXL, pXH, pYL, pYH : Byte;
  279.     cXL, cXH, cYL, cYH : Byte;
  280.   begin
  281.     with WindowP(W)^ do begin
  282.       {Compute the smallest frame that will fit}
  283.       ComputeDeltas(W, XD, YD, Frames);
  284.       {Restore underlying screen in stages}
  285.       pXL := XL1;
  286.       pXH := XH1;
  287.       pYL := YL1;
  288.       pYH := YH1;
  289.       FrameChars := Frame;
  290.       F := 1;
  291.       while F < Frames do begin
  292.         dX := F*XD;
  293.         dY := F*YD;
  294.         cXL := Trunc(XL1+dX);
  295.         cYL := Trunc(YL1+dY);
  296.         cXH := Round(XH1-dX);
  297.         cYH := Round(YH1-dY);
  298.         if YL1 <> YH1 then begin
  299.           RestoreRect(W, pXL, pYL, pXH, cYL);
  300.           RestoreRect(W, pXL, cYH, pXH, pYH);
  301.         end;
  302.         if XL1 <> XH1 then begin
  303.           RestoreRect(W, pXL, cYL, cXL, cYH);
  304.           RestoreRect(W, cXH, cYL, pXH, cYH);
  305.         end;
  306.         if Framed then
  307.           {Draw frame around window}
  308.           FrameWindow(cXL, cYL, cXH, cYH, FAttr, HAttr, '');
  309.         pXL := cXL;
  310.         pXH := cXH;
  311.         pYL := cYL;
  312.         pYH := cYH;
  313.         if SoundFlagW then
  314.           {Make a sound}
  315.           Sound(1320-F*35);
  316.         if (Frames > 10) and (F < Frames-2) then
  317.           {Use only half the frames for big windows}
  318.           Inc(F);
  319.         Inc(F);
  320.         Delay(ExploDelay);
  321.       end;
  322.       {Assure core is restored}
  323.       RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Covers));
  324.       NoSound;
  325.     end;
  326.   end;
  327.   {$ENDIF}
  328.  
  329.   procedure SetCurrentWindow(W : WindowPtr);
  330.     {-Set the parameters for the current window}
  331.   begin
  332.     with WindowP(W)^ do begin
  333.       Window(XL, YL, XH, YH);
  334.       GoToXY(CursorX, CursorY);
  335.       SetCursorSize(CStart, CEnd);
  336.       CurrentWindow := W;
  337.     end;
  338.   end;
  339.  
  340.   procedure SaveCurrentWindow(W : WindowPtr);
  341.     {-Save state of current window}
  342.   begin
  343.     with WindowP(W)^ do
  344.       GetCursorInfo(CStart, CEnd, CursorX, CursorY, Clear);
  345.   end;
  346.  
  347. ************************************************************************
  348. Starting around line 328
  349.  
  350.           Fr := FrameChars;
  351.         end;
  352. D -   end else with WindowP(CurrentWindow)^ do
  353. I +   end else
  354.         {Save current window settings}
  355. D -     GetCursorInfo(CStart, CEnd, CursorX, CursorY, False);
  356. I +     SaveCurrentWindow(CurrentWindow);
  357.  
  358.       {Set the default text attribute}
  359.  
  360. ************************************************************************
  361. Starting around line 343
  362.  
  363.       if Save and DisplayedOnce then
  364.         {Previous image of window available to restore}
  365.         RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Holds))
  366.       else begin
  367.         {No previous image to restore}
  368. D -     if Clear then
  369. D -       {Clear the window}
  370. D -       ClrScr;
  371. I +     {$IFDEF ExplodingWindows}
  372. I +     if Exploding then
  373. I +       ExplodeWindow(W);
  374. I +     {$ENDIF}
  375.         if Framed then begin
  376.           {Draw frame around window}
  377.           FrameChars := Frame;
  378.           FrameWindow(XL1, YL1, XH1, YH1, FAttr, HAttr, StringFromHeap(HeaderP));
  379.         end;
  380. I +     if Clear then
  381. I +       {Clear the window}
  382. I +       ClrScr;
  383.       end;
  384.  
  385.       {Set the cursor for this window}
  386. D -   GoToXY(CursorX, CursorY);
  387. D -   SetCursorSize(CStart, CEnd);
  388. I +   SetCurrentWindow(W);
  389.  
  390.       Active := True;
  391.  
  392. ************************************************************************
  393. Starting around line 378
  394.  
  395.     with WindowP(CurrentWindow)^ do begin
  396.       if Save then
  397.         {Save what window currently holds}
  398.         if SaveWindow(XL1, YL1, XH1, YH1, False, Pointer(Holds)) then ;
  399.       {Save cursor information}
  400.       GetCursorInfo(CStart, CEnd, CursorX, CursorY, not(Save));
  401. I +   {$IFDEF ExplodingWindows}
  402. I +   if Exploding then
  403. I +     ImplodeWindow(CurrentWindow)
  404. I +   else
  405. I +     {$ENDIF}
  406.         {Restore screen}
  407.         RestoreWindow(XL1, YL1, XH1, YH1, False, Pointer(Covers));
  408.       Active := False;
  409.     end;
  410.  
  411. ************************************************************************
  412. Starting around line 469
  413. Add the following two routines immediately after the SetTopWindow function.
  414.  
  415.   function SelectTopWindow(W : WindowPtr) : Boolean;
  416.     {-Make an already active, tiled window the current one}
  417.   var
  418.     TempStack : WindowStackP;
  419.     U, V : WindowPtr;
  420.   begin
  421.     SelectTopWindow := False;
  422.     if (W = nil) or not WindowIsActive(W) then
  423.       Exit;
  424.     if CurrentWindow <> W then begin
  425.       {Save the state of the current window}
  426.       SaveCurrentWindow(CurrentWindow);
  427.       {Remove windows from stack until desired window is taken off}
  428.       TempStack := nil;
  429.       repeat
  430.         V := WindowStack^.Top;
  431.         U := PopStack(WindowStack);
  432.         if V <> W then
  433.           if not PushStack(TempStack, V) then
  434.             Exit;
  435.       until V = W;
  436.       {Put remaining windows back on stack}
  437.       V := TempStack^.Top;
  438.       while V <> nil do begin
  439.         if not PushStack(WindowStack, V) then
  440.           Exit;
  441.         V := PopStack(TempStack);
  442.       end;
  443.       {Put desired window on top of stack}
  444.       if not PushStack(WindowStack, W) then
  445.         Exit;
  446.       {Select the desired window for writing}
  447.       TextAttr := WindowP(W)^.WAttr;
  448.       SetCurrentWindow(W);
  449.     end;
  450.     SelectTopWindow := True;
  451.   end;
  452.  
  453.   function SelectTiledWindow(W : WindowPtr) : Boolean;
  454.     {-Display or reselect tiled window}
  455.   begin
  456.     if WindowIsActive(W) then
  457.       SelectTiledWindow := SelectTopWindow(W)
  458.     else
  459.       SelectTiledWindow := DisplayWindow(W);
  460.   end;
  461.  
  462. ************************************************************************
  463. That's all, folks.
  464.