home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB29.ZIP / TURBLE.LBR / GETPUT.PQS / getput.pas
Encoding:
Pascal/Delphi Source File  |  1985-03-03  |  10.0 KB  |  255 lines
  1.  
  2.   {These constants for the portion of memory where picture bits are 
  3.    stored.  Bits for odd lines on the screen are stored at a different 
  4.    location than even lines. See the IBM technical manual for an 
  5.    explanation.} 
  6.  
  7. Const
  8.   SegEven   = $b800;     {Starting segment for even lines on screen   }
  9.   SegOdd    = $ba00;     {Starting segment for odd lines on screen    }
  10.   LineBytes = $50;       {Bytes per line                              }
  11.   MaxArray  = 3000;      {Maximum array -- increase for larger figures}
  12.  
  13.   {The array Storage is a memory area used by both GET and PUT.  GET 
  14.    stores the old bits in the array.  PUT removes them and places them 
  15.    at the new memory location.  The 3000 byte array used here may be 
  16.    more or less than you need for a particular figure.  If memory is 
  17.    tight and you must conserve it, you can multiply the length of the 
  18.    moved block by its width, then divide by four for medium resolution 
  19.    or eight for high resolution.  Change MaxArray to this number.  
  20.    However, if you are using several figures, the array will be the 
  21.    same for all.  This might be wasteful of memory, but...you can wait 
  22.    for the next release. } 
  23.  
  24. Type
  25.   Strng   = String[14];     {Allows you to use type String in a parameter.}
  26.   Storage = Record
  27.               Pixels : Array[1..MaxArray] of Byte;
  28.               StoreHeight : Integer;
  29.               StoreWidth  : Integer;
  30.             end;
  31.  
  32.   {This procedure Gets the bytes that define a figure and places them 
  33.    either in memory and, optionally, in a file.  One limitation is 
  34.    that the procedure gets whole bytes.  If your figure starts or ends 
  35.    midway through the byte, then the additional bits before or after 
  36.    will also be captured.  You can see this when you move something 
  37.    with the NOT parameter.  The next version may solve this problem.}
  38.  
  39. Procedure Get(StartWidth, StartHeight, Width, Height : Integer;
  40.                                            var AName : Storage;
  41.                                                FName : Strng);
  42. Label Exit;
  43.  
  44. Var
  45.   HeightLoop, WidthLoop,
  46.   StartWidthByte, EndWidthByte,
  47.   EndHeight, WidthBytes,
  48.   Segment, OffSet,
  49.   Divisor, Counter, Size : Integer;
  50.   FileName : String[14];
  51.   Destination : File;
  52.  
  53.   {Adjusts for two bits per pixel in medium resolution or one bit per
  54.    pixel in high resolution.  Also adjusts Y coordinates for aspect.
  55.    This procedure is used by both Get and Put. }
  56.  
  57. Procedure Adjust;
  58. begin
  59.   If ResolutionHigh then Divisor := 8 else Divisor := 4;
  60.   StartHeight := Round(StartHeight * Scrunch);
  61.   Height := Round(Height * Scrunch);
  62. end;
  63.  
  64.   {Move the bytes of the figure to a file. }
  65.  
  66. Procedure FileWrite;
  67. begin
  68.   FileName := FName;
  69.   Assign(Destination,FileName);
  70.   Rewrite(Destination);
  71.   Size := (Counter * 8) div 128;          {Find the number of blocks.         }
  72.   BlockWrite(Destination, AName, Size);
  73.   Close(Destination);
  74. end;
  75.  
  76. begin
  77.   Adjust;
  78.   If Width * Height div Divisor > MaxArray then
  79.     begin
  80.       Write(#7);                          {Error and quit if array too small. }
  81.       Goto Exit;
  82.     end;
  83.   AName.StoreHeight := Height;            {Store the width and height.        }
  84.   AName.StoreWidth  := Width;
  85.   HeightLoop := StartHeight;              {Set the loops and the starting...  }
  86.   EndHeight  := StartHeight + Height;     {...and ending points for the loops.}
  87.   StartWidthByte := StartWidth div Divisor;
  88.   WidthBytes := (Width div divisor) + 1;
  89.   Counter := 1;
  90.   While HeightLoop <= EndHeight do        {Store each line, alternating...    }
  91.     begin                                 {...segments for even and odd.      }
  92.       If Odd(HeightLoop) then Segment := SegOdd else Segment := SegEven;
  93.       Offset := ((HeightLoop div 2) * LineBytes) + StartWidthByte;
  94.       Move(mem[Segment:Offset], AName.Pixels[Counter], WidthBytes);
  95.       Counter := Counter + WidthBytes;     
  96.       HeightLoop := HeightLoop + 1;       {Increment counter and loop.        }
  97.     end;
  98.   If FName <> '' then FileWrite;          {If file exists, write bits to it.  }
  99. Exit : end;
  100.  
  101.   {Constants to indicate how intersecting figures will be treated 
  102.    when new bits are put on old bits. }
  103.  
  104. Const
  105.   A = 1;             {New picture bits AND old picture bits}
  106.   O = 2;             {New picture bits OR  old picture bits}
  107.   X = 3;             {New picture bits XOR old picture bits}
  108.   N = 4;             {                 NOT new picture bits}
  109.   E = 5;             {               EQUAL new picture bits}
  110.   B = 6;             {      New bits BLANK old picture bits}
  111.                                         
  112.   {This procedure Puts the bytes stored with Get onto the screen.  
  113.    Notice that the procedure for the EQU and BLANK operators is 
  114.    completely different than the one for the other operators.  Because 
  115.    whole bytes are being moved unchanged with EQUAL and BLANK, the 
  116.    Turbo MOVE procedure is used to move a whole line at a time.  It 
  117.    works considerable faster than combining the old and new bytes one 
  118.    at time as with the other operators.  
  119.    
  120.    This gives you two choices for animation.  If you want to move a 
  121.    ball accross the screen, you can BLANK the old figure and EQU the 
  122.    new figure at the new location.  Or you can XOR the old figure to 
  123.    erase it and XOR the new figure to draw it.  Try it and see which 
  124.    is faster.}
  125.  
  126. Procedure Put(var AName : Storage;  Startwidth, StartHeight : Integer;
  127.                                                    Operator : Byte;
  128.                                                       FName : Strng);
  129. var
  130.   HeightLoop, WidthLoop,
  131.   StartWidthByte, EndWidthByte, WidthBytes,
  132.   Height, Width, EndHeight,
  133.   Segment, OffSet,
  134.   Divisor, Counter, Size : Integer;
  135.   OldValue, NewValue : Byte;
  136.   FileName : String[14];
  137.   Source : File;
  138.   Blank  : Array[0..LineBytes] of Byte;
  139.  
  140.   {Adjusts for two bits per pixel in medium resolution or one bit
  141.    per pixel in medium resolution.  Also adjusts Y coordinates for
  142.    aspect.  This procedure is used by both Get and Put. }
  143.  
  144. Procedure Adjust;
  145. begin
  146.   If ResolutionHigh then Divisor := 8 else Divisor := 4;
  147.   StartHeight := Round(StartHeight * Scrunch);
  148.   Height := Round(Height * Scrunch);
  149. end;                             
  150.  
  151. Procedure DrawThing;          {Mixes old and new bytes one at a time. }
  152. begin
  153.   OldValue := AName.Pixels[Counter];
  154.   NewValue := mem[Segment:Offset];
  155.   Case Operator of
  156.     1  : Mem[Segment:Offset] := NewValue AND OldValue;
  157.     2  : Mem[Segment:Offset] := NewValue OR  OldValue;
  158.     3  : Mem[Segment:Offset] := NewValue XOR OldValue;
  159.     4  : Mem[Segment:Offset] := NOT OldValue;
  160.   end;
  161.   Offset := Offset + 1;       {Increment the loops.                   }
  162.   Counter := Counter + 1;
  163.   WidthLoop := WidthLoop + 1;
  164. end;
  165.  
  166. Procedure Movething;          {Moves a whole line of bytes at a time. }
  167. begin
  168.   If Operator = 5 then        {Move in new values for EQU.            }
  169.     Move(AName.Pixels[Counter], mem[Segment:Offset], WidthBytes)
  170.   else                        {Move in blanks (zeros) for BLANK.      }
  171.     Move(Blank[0], mem[Segment:Offset], WidthBytes);
  172.   Counter := Counter + Widthbytes;
  173. end;
  174.  
  175. Procedure FileRead;           {Reads bytes from a file.               }
  176. begin
  177.   FileName := FName;
  178.   Assign(Source, FileName);
  179.   Reset(Source);
  180.   Size := FileSize(Source);
  181.   BlockRead(Source, AName, Size);
  182.   Close(Source);
  183. end;
  184.  
  185. begin
  186.   If FName <> '' then FileRead;         {If file exists, then read bits.    }
  187.   Adjust;
  188.   Width :=  AName.StoreWidth;           {Get height and width from record.  }
  189.   Height := AName.StoreHeight;                                                
  190.   HeightLoop := StartHeight;            {Set the loops and the starting...  }
  191.   EndHeight  := StartHeight + Height;   {...and ending points for loops.    }
  192.   StartWidthByte := StartWidth div Divisor;                                 
  193.   WidthBytes := (Width div Divisor) + 1;                                    
  194.   EndWidthByte   := StartWidthByte + (Width div Divisor);                     
  195.   If Operator = 6 then                  {If BLANK then fill array with 0.   }
  196.     For Counter := 0 to WidthBytes do Blank[Counter] := 0;
  197.   Counter := 1;
  198.   While HeightLoop <= EndHeight do
  199.     begin                               {Set loops and segments.            }
  200.       if Odd(HeightLoop) then Segment := SegOdd else Segment := SegEven;
  201.       Offset := ((HeightLoop div 2) * LineBytes) + StartWidthByte;
  202.       WidthLoop := StartWidthByte;        
  203.       If operator > 4 then Movething    {Move or draw depending on operator.}
  204.         else While WidthLoop <= EndWidthByte do Drawthing;
  205.       HeightLoop := HeightLoop + 1;
  206.     end;
  207. end;
  208.  
  209.   {Before using GET, you must declare a variable of type Storage that 
  210.    you will use to name the figure you want to move.  Later you will 
  211.    use the same name to get the figure.  For example:
  212.    
  213.        Var
  214.          Box : Storage;
  215.        
  216.        Get(1,1,50,50,Box,'');
  217.        Put(Box,150,150,e,'');
  218.    
  219.    This gets a square 50 by 50 starting at 1,1.  It stores the figure 
  220.    in Box.  Then Put takes the figure out of Box and puts it onto the 
  221.    screen at 150,150.  The operator "e" indicates that the new figure 
  222.    overwrites anything that was there before.  The empty set indicates 
  223.    that the whole process takes place in memory.  
  224.    
  225.    If you wanted Box to be saved in a file, you could do it like this: 
  226.    
  227.        Var
  228.          Box : Storage;
  229.        
  230.        Get(1,1,50,50,Box,'BOX.FIG');
  231.    
  232.    Then you could get the figure from the file even after booting (or 
  233.    from another program) with this command:
  234.    
  235.        Var
  236.          Box : Storage;
  237.     
  238.        Put(Box,150,150,e,'BOX.FIG');
  239.    
  240.    You can declare several different figures and move them all in different 
  241.    combinations.
  242.    
  243.        Var
  244.          Box    : Storage;
  245.          Circle : Storage;
  246.  
  247.        Get(1,1,50,50,Box,'');
  248.        Get(1,1,50,150,Circle,'');
  249.        Put(Circle,150,150,x,'');
  250.        Put(Box,150,150,x,'');
  251.  
  252.    }
  253.  
  254.  
  255.