home *** CD-ROM | disk | FTP | other *** search
- {$B-} { Short circuit boolean evaluation }
- {$I-} { I/O checking OFF }
- {$R-} { Range checking OFF }
- {$S-} { Stack checking OFF }
- {$V-} { Var-str check OFF }
- {$F+} { Force FAR calls ON }
-
- UNIT PGrafbuf;
-
- INTERFACE
- uses pgraph;
-
- procedure init_buffering;
-
- CONST
- UnitVersion = '1.00' ;
- UnitVerDate = '21 Jul 91' ;
-
-
- IMPLEMENTATION {============================================================}
-
- VAR
- ExitSave : pointer ;
- OriginalVector : pointer ;
- type buffer = array[0..$7fff] of byte;
-
- var buff_ptr: array[0..31] of ^buffer;
-
- {---------------------------------------------------------------------------}
- { L O C A L P R O C E D U R E S }
- {---------------------------------------------------------------------------}
-
- PROCEDURE TerminateUnit ;
- BEGIN { TerminateUnit }
- ExitProc := ExitSave
- END { TerminateUnit } ;
-
-
- PROCEDURE InitializeUnit ;
-
- { initialize variables }
-
- VAR
- i: integer;
- Index : word ;
- k : byte ;
- ID_Var : string[11] ;
-
- begin
- ExitSave := ExitProc ;
- ExitProc := @TerminateUnit;
- END { InitializeUnit } ;
-
- procedure pgr_graphfreemem(ptr: pointer; size: longint);
- begin
- freemem(ptr, size);
- end;
-
- function pgr_graphgetmem(size: longint): pointer;
- var temp: pointer;
- begin
- if (maxavail < size) or (size > 65535)
- then temp := nil
- else getmem(temp, size);
- pgr_graphgetmem := temp;
- end;
-
- function pgr_graphgetbuff(size: longint): integer;
- var i: integer;
- var got_ok: boolean;
-
- begin
- if size > $8000 * 32
- then got_ok := false
- else begin
- got_ok := true;
- if size >= $8000
- then for i := 0 to (size div $8000) - 1 do
- if (maxavail < $8000)
- then got_ok := false
- else begin
- getmem(buff_ptr[i], $8000);
- fillchar(buff_ptr[i]^, $8000, 0);
- end;
-
- if size mod $8000 <> 0 then begin
- if (maxavail < size mod $8000)
- then got_ok := false
- else begin
- getmem(buff_ptr[size div $8000], size mod $8000);
- fillchar(buff_ptr[size div $8000]^, size mod $8000, 0);
- end;
- end;
- end;
- pgr_graphgetbuff := ord(got_ok);
- end;
-
- procedure pgr_graphfreebuff(size: longint);
- var i: integer;
- begin
- if (size >= $8000)
- then for i := 0 to (size div $8000) - 1 do
- freemem(buff_ptr[i], $8000);
- if size mod $8000 <> 0 then
- freemem(buff_ptr[size div $8000], size mod $8000);
- end;
-
- function pgr_getbyte(offset: longint): byte;
- begin
- pgr_getbyte := buff_ptr[offset div $8000]^[offset mod $8000];
- end;
-
-
- procedure pgr_putbyte(offset: longint; value: byte);
- begin
- buff_ptr[offset div $8000]^[offset mod $8000] := value;
- end;
-
- procedure init_buffering;
- begin
- __p_graphgetmem := @pgr_graphgetmem;
- __p_graphfreemem := @pgr_graphfreemem;
-
- __p_graphgetbuff := @pgr_graphgetbuff;
- __p_graphfreebuff := @pgr_graphfreebuff;
-
- __p_putbyte := @pgr_putbyte;
- __p_getbyte := @pgr_getbyte;
- end;
-
-
-
- BEGIN { PGRAPH unit body }
- InitializeUnit
- END. { PGRAPH unit body }