unit files;
interface
uses pscplm;
{$F+}
var end_of_file:boolean;
    file_mark:longint;
    sourcedate : longint;
procedure change_ext(var s:string;ext:three_char);

procedure init_files;

procedure reset_file(var s:string;ext:three_char);

procedure rewrite_file(var s:string;ext:three_char);

procedure append_file(var s:string; ext:three_char);

procedure files_abs_write(addr: longint; b:byte);

procedure close_files;

procedure delete_file(var s:string;ext:three_char);

procedure put_byte(b:byte);

procedure put_2_byte(w:word);

procedure put_word(w:word);

function get_byte:byte;

function next_byte:byte;

function get_2_byte:word;

function get_word:word;

function next_word:word;

function get_line(var line: string):integer;

procedure files_set_mark;

procedure files_jump_start;

procedure files_return_to_mark;

function files_pos:longint;

function files_read_pos:longint;

procedure files_skip_to(addr:longint);

Procedure SetSourceDate;
implementation
uses mpaunit,dos;
(* !!! TURBO !!! *)
(*const systemx = 15;
procedure fatal_error(s: integer; e: word);
begin end;
*)
type buf_page= array[0..1025] of byte;
     buf_page_ptr= ^buf_page;


     buf_index=record case integer of
                 0: (i,j: word);
                 1: (pw:  ^word);
                 2: (pb:  ^byte);
                 3: (buf: buf_page_ptr);
               end; 
(*$I codes*)

var 
    udi_read_conn,udi_write_conn: file;
    udi_end_read:word;
    udi_end_write: word;
    udi_read_index, udi_write_index: buf_index;
    udi_read_start, udi_write_start: word;
    read_buffer, write_buffer: buf_page_ptr;
	write_addr,read_addr:longint;

Procedure SetSourceDate;
  Begin
    GetFTime(udi_read_conn,SourceDate);
  end;
procedure change_ext(var s:string;ext:three_char);
var i,pos:integer;
begin
  pos:= length(s)+1;
  for i:=1 to length(s) do
    if s[i]='.' then pos:= i;
  delete(s, pos, 255);
  s:= concat(s, '.', ext);
(*  writeln('CHANGE extention: ',s);*)
end;

procedure init_files;
begin
  new(read_buffer);
  udi_read_index.buf:=read_buffer;
  udi_read_index.j:=udi_read_index.j+udi_read_index.i div 16-1;
  udi_read_start:=udi_read_index.i mod 16+16;
  udi_read_index.i:=65535; (* 0FFFFH *)
  new(write_buffer);
  udi_write_index.buf:=write_buffer;
  udi_write_index.j:=udi_write_index.j+udi_write_index.i div 16;
  udi_write_start:=udi_write_index.i mod 16;
  udi_end_write:=udi_write_start+1022;
  udi_write_index.i:=65535; (* 0FFFFH *)
  end_of_file:=true;
  file_mark:=0;
end;

function close_read_file:word;
begin
  if udi_read_index.i<>65535 (*0FFFFH*) then
  begin
    udi_read_index.i:=65535 (*0FFFFH*);
    end_of_file:=true;
    close(udi_read_conn);
  end;
  close_read_file:=0;
end;

function close_write_file:word;
var exc,dump:word;
begin
  exc:=0;
  if udi_write_index.i<>65535 (*0FFFFH*) then
  begin
    dump:=udi_write_index.i-udi_write_start;
    if dump>0 then
    begin
      blockwrite(udi_write_conn,write_buffer^,dump,exc);
      exc := dump - exc;
    end;
    udi_write_index.i:=65535 (*0FFFFH*);
    if exc=0 then close(udi_write_conn);
  end;
  close_write_file:= exc;
end;

procedure files_abs_write(addr:longint;b:byte);
var dump:word;
begin
  if udi_write_index.i<>65535 (*0FFFFH*) then
  begin
    dump:=udi_write_index.i-udi_write_start;
    if dump>0 then
      blockwrite(udi_write_conn,write_buffer^,dump);
    udi_write_index.i:=udi_write_start;
    close(udi_write_conn);
    filemode := 2;
    reset(udi_write_conn,1);
    filemode := 0;
  end;
  seek(udi_write_conn,addr);
  udi_write_index.pb^:=b;
  blockwrite(udi_write_conn,write_buffer^,1);
end;

  

procedure close_files;
var exc:word;
begin
  exc:=close_write_file;
  exc:=close_read_file;
end;

procedure rewrite_file(var s:string;ext:three_char);
var exc:word;
begin
  if ext[1]<>'.' then change_ext(s,ext);
  exc:=close_write_file;
  assign(udi_write_conn,s);
  rewrite(udi_write_conn,1);
  udi_write_index.i:=udi_write_start;
  write_addr:=0;
end;

procedure append_file(var s:string;ext:three_char);
var exc:word;
begin
  if ext[1]<>'.' then change_ext(s,ext);
  exc:=close_write_file;
  assign(udi_write_conn,s);
  rewrite(udi_write_conn,1);
  seek(udi_write_conn,filesize(udi_write_conn));
  udi_write_index.i:=udi_write_start;
end;

(*b* )
procedure dump_buffer(l:word);
var i:integer;
    s:word;
begin
  s:=udi_read_index.i;
  for i:=0 to l-1 do write(chr(read_buffer^[i]));
  writeln('*');
  udi_read_index.i:=udi_read_start;
  for i:=0 to l-1 do begin
  write(chr(udi_read_index.pb^));
  udi_read_index.i:=udi_read_index.i+1;
  end;
  writeln('-');
  udi_read_index.i:=s;
end;
(**)
procedure reset_file(var s:string;ext:three_char);
var exc:word;
    i:integer;
begin
  if ext[1]<>'.' then change_ext(s,ext);
  exc:=close_read_file;
  assign(udi_read_conn,s);
  reset(udi_read_conn,1);
  udi_read_index.i:=udi_read_start;
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
  read_buffer^[udi_end_read]:=10; (* lf *)
(*b* )  dump_buffer(udi_end_read+1); (**)
  end_of_file:=udi_end_read=0;
  udi_end_read:=udi_end_read+udi_read_start-1;
  read_addr:=0;
end;

procedure delete_file(var s:string;ext:three_char);
var exc:word;
    help: file;
begin
  if ext[1]<>'.' then change_ext(s,ext);
    assign(help,s);
    erase(help);
end;

procedure put_2_byte(w:word);
begin
  udi_write_index.pw^:= w;
  if udi_write_index.i>=udi_end_write then
  begin
    blockwrite(udi_write_conn,write_buffer^,1024);
	write_addr:=write_addr+1024;
    if udi_write_index.i>udi_end_write then
    begin
      write_buffer^[0]:=write_buffer^[1024];
      udi_write_index.i:=udi_write_start+1;
    end else udi_write_index.i:=udi_write_start;
  end else udi_write_index.i:=udi_write_index.i+2;
end;

procedure put_word(w:word);
begin
  put_2_byte(w);
end;

procedure put_byte(b:byte);
begin
    udi_write_index.pb^:= b;
    if udi_write_index.i>udi_end_write then
    begin
        blockwrite(udi_write_conn,write_buffer^,1024);
    	write_addr:=write_addr+1024;
        udi_write_index.i:=udi_write_start;
    end else udi_write_index.i:= succ(udi_write_index.i);
end;

function get_byte:byte;
begin
    if udi_read_index.i>udi_end_read then
    begin
      read_addr:=read_addr+udi_end_read+1-udi_read_start;
      blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
(*b* )      dump_buffer(udi_end_read); (**)
      udi_read_index.i:=udi_read_start;
      if udi_end_read=0 then begin
        get_byte:=ord(ceos);
        end_of_file:=true;
      end else begin
        get_byte:=udi_read_index.pb^;
        udi_read_index.i:=succ(udi_read_index.i);
      end;
      udi_end_read:= udi_end_read+udi_read_start-1;
    end else
    begin
      get_byte:=udi_read_index.pb^;
      udi_read_index.i:=succ(udi_read_index.i);
    end;
end;

function next_byte:byte;
begin
    if udi_read_index.i>udi_end_read then
    begin
      read_addr:=read_addr+udi_end_read+1-udi_read_start;
      blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
(*b* )      dump_buffer(udi_end_read); (**)
      udi_read_index.i:=udi_read_start;
      if udi_end_read=0 then begin
        next_byte:=ord(' ');
        end_of_file:=true;
      end else next_byte:=udi_read_index.pb^;
      udi_end_read:= udi_end_read+udi_read_start-1;
    end else next_byte:=udi_read_index.pb^;
end;

function next_word:word;
begin
  next_word:=0;
end;

function get_2_byte:word;
var exc:word;
     help: record case boolean of
            false: ( w: word);
            true:  (b0, b1: byte);
           end;
begin
    if udi_read_index.i>=udi_end_read then
    begin
        help.b0:=get_byte;
        help.b1:=get_byte;
        get_2_byte:=help.w;
    end else
    begin
        get_2_byte:=udi_read_index.pw^;
        udi_read_index.i:=udi_read_index.i+2;
    end;
end;

function get_word: word;
begin
  get_word:=get_2_byte;
end;



function get_line(var line:string):integer;
var exc:word;
    ch:char;
    length:integer;
    stop:boolean;
begin
  stop:=false;
  length := 0;
  repeat
   ch := chr(Get_Byte);
   if end_of_file THEN stop := true
   else
   if (ch>' ') and (ch<chr(127)) (* del *) then
    begin
      if length<254 then begin (* space for space *)
        length:=length+1;
        line[length]:=ch;
      end;
     end
   ELSE
    BEGIN
      if ord(ch) = 10 then
        stop := true
      else
      if (ord(ch) <> 13) THEN
      BEGIN
        if (ord(ch) = 25) or (ord(ch) = 26) THEN
          BEGIN
            repeat ch:=chr(get_byte); until end_of_file;
            stop := true;
          END
        else
          BEGIN
            if (length<254) and (length <> 0) then begin (* space for space *)
            length:=length+1;
            line[length]:=' ';
            end
          END;
      END;

    END;




  until stop;
  length:=length+1;
  line[length]:=' ';
  get_line:=length;
end;

procedure files_set_mark;
begin
  file_mark:=write_addr+udi_write_index.i-udi_write_start;
end;

procedure files_jump_start;
begin
  file_mark:=read_addr+udi_read_index.i-udi_read_start;
  seek(udi_read_conn,0);
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
(*b* )  dump_buffer(udi_end_read); (**)
  read_buffer^[udi_end_read]:=10; (* lf *)
  end_of_file:=udi_end_read=0;
  udi_end_read:=udi_end_read+udi_read_start-1;
  udi_read_index.i:=udi_read_start;
  read_addr:=0;
end;

procedure files_return_to_mark;
var
    file_mark_rest: integer;
begin
  file_mark_rest:= file_mark mod 128;
  file_mark:= file_mark - file_mark_rest;
  seek(udi_read_conn,file_mark);
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
  if file_mark_rest > udi_end_read then file_mark_rest:= udi_end_read;
(*b* )  dump_buffer(udi_end_read); (**)
  read_buffer^[udi_end_read]:=10; (* lf *)
  end_of_file:=udi_end_read=file_mark_rest;
  udi_end_read:=udi_end_read+udi_read_start-1;
  udi_read_index.i:=udi_read_start+file_mark_rest;
  read_addr:=file_mark;
end;

function files_pos:longint;
begin
  files_pos:=write_addr+udi_write_index.i-udi_write_start;
end;

function files_read_pos:longint;
begin
  files_read_pos:=read_addr+udi_read_index.i-udi_read_start;
end;

procedure files_skip_to(addr:longint);
var
    addr_rest: integer;
begin
  addr_rest:= addr mod 128;
  addr:= addr - addr_rest;
  seek(udi_read_conn,addr);
  blockread(udi_read_conn,read_buffer^,1024,udi_end_read);
  if addr_rest>udi_end_read then addr_rest:=udi_end_read;
(*b* )  dump_buffer(udi_end_read); (**)
  read_buffer^[udi_end_read]:=10; (* lf *)
  end_of_file:=udi_end_read=addr_rest;
  udi_end_read:=udi_end_read+udi_read_start-1;
  udi_read_index.i:=udi_read_start+addr_rest;
  read_addr:=addr;
end;
end.