home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / CPROG / PGRAPH.ZIP / PASCAL.ZIP / PGRAFBUF.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-05  |  3KB  |  136 lines
  1. {$B-} { Short circuit boolean evaluation }
  2. {$I-} { I/O checking    OFF   }
  3. {$R-} { Range checking  OFF   }
  4. {$S-} { Stack checking  OFF   }
  5. {$V-} { Var-str check   OFF   }
  6. {$F+} { Force FAR calls ON    }
  7.  
  8. UNIT PGrafbuf;
  9.  
  10. INTERFACE
  11. uses pgraph;
  12.  
  13. procedure init_buffering;
  14.  
  15. CONST
  16.   UnitVersion           = '1.00' ;
  17.   UnitVerDate           = '21 Jul 91' ;
  18.  
  19.  
  20. IMPLEMENTATION {============================================================}
  21.  
  22. VAR
  23.   ExitSave       : pointer ;
  24.   OriginalVector : pointer ;
  25. type buffer = array[0..$7fff] of byte;
  26.  
  27. var buff_ptr: array[0..31] of ^buffer;
  28.  
  29. {---------------------------------------------------------------------------}
  30. {                     L O C A L     P R O C E D U R E S                     }
  31. {---------------------------------------------------------------------------}
  32.  
  33. PROCEDURE TerminateUnit ;
  34. BEGIN { TerminateUnit }
  35.   ExitProc := ExitSave
  36.   END { TerminateUnit } ;
  37.  
  38.  
  39. PROCEDURE InitializeUnit ;
  40.  
  41. { initialize variables }
  42.  
  43. VAR
  44.      i: integer;
  45.      Index        : word ;
  46.     k            : byte ;
  47.     ID_Var       : string[11] ;
  48.  
  49. begin
  50.     ExitSave := ExitProc ;
  51.     ExitProc := @TerminateUnit;
  52. END { InitializeUnit } ;
  53.  
  54. procedure pgr_graphfreemem(ptr: pointer; size: longint);
  55. begin
  56.     freemem(ptr, size);
  57. end;
  58.  
  59. function pgr_graphgetmem(size: longint): pointer;
  60. var temp: pointer;
  61. begin
  62.     if (maxavail < size) or (size > 65535)
  63.     then temp := nil
  64.     else getmem(temp, size);
  65.     pgr_graphgetmem := temp;
  66. end;
  67.  
  68. function pgr_graphgetbuff(size: longint): integer;
  69. var i: integer;
  70. var got_ok: boolean;
  71.  
  72. begin
  73.     if size > $8000 * 32
  74.     then got_ok := false
  75.     else begin
  76.         got_ok := true;
  77.         if size >= $8000
  78.         then for i := 0 to (size div $8000) - 1 do
  79.             if (maxavail < $8000)
  80.             then got_ok := false
  81.             else begin
  82.                 getmem(buff_ptr[i], $8000);
  83.                 fillchar(buff_ptr[i]^, $8000, 0);
  84.             end;
  85.  
  86.         if size mod $8000 <> 0 then begin
  87.             if (maxavail < size mod $8000)
  88.             then got_ok := false
  89.             else begin
  90.                 getmem(buff_ptr[size div $8000], size mod $8000);
  91.                 fillchar(buff_ptr[size div $8000]^, size mod $8000, 0);
  92.             end;
  93.         end;
  94.     end;
  95.     pgr_graphgetbuff := ord(got_ok);
  96. end;
  97.  
  98. procedure pgr_graphfreebuff(size: longint);
  99. var i: integer;
  100. begin
  101.     if (size >= $8000)
  102.     then for i := 0 to (size div $8000) - 1 do
  103.         freemem(buff_ptr[i], $8000);
  104.     if size mod $8000 <> 0 then
  105.         freemem(buff_ptr[size div $8000], size mod $8000);
  106. end;
  107.  
  108. function pgr_getbyte(offset: longint): byte;
  109. begin
  110.     pgr_getbyte := buff_ptr[offset div $8000]^[offset mod $8000];
  111. end;
  112.  
  113.  
  114. procedure pgr_putbyte(offset: longint; value: byte);
  115. begin
  116.     buff_ptr[offset div $8000]^[offset mod $8000] := value;
  117. end;
  118.  
  119. procedure init_buffering;
  120. begin
  121.     __p_graphgetmem     := @pgr_graphgetmem;
  122.     __p_graphfreemem     := @pgr_graphfreemem;
  123.  
  124.     __p_graphgetbuff     := @pgr_graphgetbuff;
  125.     __p_graphfreebuff := @pgr_graphfreebuff;
  126.  
  127.     __p_putbyte         := @pgr_putbyte;
  128.     __p_getbyte             := @pgr_getbyte;
  129. end;
  130.  
  131.  
  132.  
  133. BEGIN { PGRAPH unit body }
  134.     InitializeUnit
  135. END.  { PGRAPH unit body }
  136.