kermit.columbia.edu/kermit.columbia.edu.tar/kermit.columbia.edu/ucsdmagiscan2/fileunit.text

Text File | 2011-08-11 | 8KB | 399 lines

(*$S+*)
{ This unit contains the primitives necessary to store
  the incoming data on the disk specified }

Unit FileHandle;

Interface

   Uses
     M2Types,M2IpRoot,M2Sys,
     (*$U Disk.Code*)DiskUnit;


   const
     BufEnd = 512;

   type
     BuffType = packed array[1..BufEnd] of char;
     FStates  = (TxtFile,BinFile,ImgFile,CodeFile); { File States }

   var
     FileBuf    : BuffType;
     BuffPosn   : integer;
     Disk       : String[3];
     TF         : Text;
     F          : File;
     TranState  : FStates;
     EOI        : boolean; { End of Image ! }



   procedure FileInit;

   procedure CloseF(var Name   : string;
                        Save   : boolean );

   function ReadOpenF(var Name     : string ;
                          State    : FStates ): boolean;

   function WriteOpenF(var Name     : string ;
                           State    : FStates ): boolean;

   procedure SaveBuff(var Buff : BuffType;
                      var Posn : integer;
                       NewLine : boolean  );

   procedure ReadBuff(var Buff : BuffType;
                      var Posn : integer );

   procedure LoadIm(var Name : string );



Implementation

var
  Im,TxtIm       : Image;
  Tab            : IOTab;
  Line           : PointSet;
  YPosn          : integer;

(* ---------------------------------------------------- *)

procedure GetLine(var Line   : PointSet;
                      Im     : Image;
                  var Buff   : BuffType );

type
  IdynArray = array[1..1]of Integer;

var
  Mrk     : ^integer;
  Idyn    : ^IdynArray;
  i       : integer;

begin
mark(Mrk);
New(Idyn);
ImSmp(Line,Im,Idyn^[0],i);
for i := 0 to 511 do
  Buff[i+1] := chr(Idyn^[i]);
Release(Mrk)
end{GetLine};

(* ---------------------------------------------------- *)

procedure PutLine(var Line   : PointSet;
                      Im     : image;
                  var Buff   : BuffType );

type
  IdynArray = array[1..1]of Integer;

var
  Mrk     : ^integer;
  Idyn    : ^IdynArray;
  i       : integer;

begin
mark(Mrk);
New(Idyn);
for i := 1 to BufEnd do
  Idyn^[i-1] := ord(Buff[i]);
DrawFn(Line,Im,Idyn^[0]);
Release(Mrk)
end{PutLine};

(* ---------------------------------------------------- *)

procedure InitF;

begin
SysInit;
DefImage(Im,0,512,Full,8,8);
DefImage(TxtIm,0,512,Full,0,1);
DefWindow(Line,0,512,512,1);
LinearIO(Tab,0,255);
Live(Im,Tab,Tab);
Photo;
Display(Im,Tab);
ClearIm(Im);
OvLay(TxtIm,XSat+Yellow);
YPosn := 511;
EOI := TranState <> ImgFile
end{InitF};

(* ---------------------------------------------------- *)

procedure LoadIm;

var
  Ok   : boolean;

begin
if TranState = ImgFile then
  begin
  InitF;
  (*$I-*)
  Reset(F,concat(disk,name));
  Ok := ioresult = 0;
  (*$I+*)
  write(chr(ff));
  if Ok then
    begin
    writeln('LOADING THE IMAGE');
    ImLd(Im,concat(disk,name))
    end
   else
     begin
     writeln('FILE DOES NOT EXIST');
     CursorOn;
     ScrollOn
     end
  end
 else
   writeln('Transfer type is not IMAGE')
end{LoadIm};

(* ---------------------------------------------------- *)

procedure EmptyBuff(var FileBuffer : BuffType;
                    var Posn       : integer );
 This procedure Empties the buffer

var
  i   : integer;

begin
for i := 1 to BufEnd do
  FileBuffer[i] := chr(0); { set all to nulls }
Posn := 1 { set the position at the begining }
end{EmptyBuff};

(* ---------------------------------------------------- *)

procedure FileInit;
{ This procedure initialises the unit,
  the disk is set up in the main program }

begin
EmptyBuff(FileBuf,BuffPosn);
TranState := TxtFile;
EOI := TranState <> ImgFile
end{fInit};

(* ---------------------------------------------------- *)

procedure CloseF;
 This procedure closes the file, neatly.

var
  Blk,i  : integer;
  s      : string;
  Key    : char;

begin
if Save then
  begin { we wish to save the file }
  case TranState of
    TxtFile          : begin
                       s := copy('',0,0);
                       if (BuffPosn <= BufEnd) and (BuffPosn > 1) then
                         begin
                         for i := 1 to pred(BuffPosn) do
                          begin
                          s := concat(s,' ');
                          s[Length(s)] := FileBuf[i]
                          end;
                         write(TF,s);
                         end;
                       Close(TF,Lock)
                       end;
    ImgFile          : begin
                       if (BuffPosn > 1) and (YPosn >= 0) then
                         begin
                         Line.Origin.Y := YPosn;
                         PutLine(Line,Im,FileBuf)
                         end;
                       EOI := True;
                       write('DO YOU WISH TO SAVE THE IMAGE ? ');
                       repeat
                         read(KeyBoard,Key)
                       until Key in ['Y','y','N','n'];
                       if Key in ['Y','y'] then
                         ImSve(Im,concat(disk,name))
                       end;
    CodeFile,BinFile : begin
                       if BuffPosn > 1 then
                         Blk := BlockWrite(F,FileBuf,1);
                       Close(F,Lock);
                       end
    end{case};
  EmptyBuff(FileBuf,BuffPosn)
  end
 else
   begin { This makes sure the file will be closed }
   close(TF);
   close(F)
   end;
CursorOn;
ScrollON
end{CloseF};

(* ---------------------------------------------------- *)

function ReadOpenF;
 This procedure opens the file for reading

var
  OK  : boolean;
  Blk : integer;

begin
EmptyBuff(FileBuf,BuffPosn);
EOI := TranState <> ImgFile;
if TranState <> ImgFile then
  begin
  (*$I-*)
  reset(F,concat(disk,name));
  OK := ioresult = 0;
  (*$I+*)
  if (State = TxtFile) then
    begin
    Blk := BlockRead(F,FileBuf,1);
    Blk := BlockRead(F,FileBuf,1)
    end
  end
 else
   begin{ this is an image file }
   OK := True;
   end;
ReadOpenF := OK
end{OpenF};

(* ---------------------------------------------------- *)

function WriteOpenF;
 This procedure opens the file for writing

var
  OK  : boolean;
  Blk : integer;

begin
EmptyBuff(FileBuf,BuffPosn);
(*$I-*)
if TranState <> TxtFile then
  begin
  if TranState = ImgFile then
    begin
    write(chr(ff));
    InitF;
    ClearIm(Im);
    OK := True
    end
   else
     begin
     rewrite(F,concat(disk,name));
     OK := ioresult = 0
     end
  end
 else
   begin
   ReWrite(TF,concat(disk,name));
   OK := ioresult = 0
   end;
(*$I+*)
WriteOpenF := OK
end{OpenF};

(* ---------------------------------------------------- *)

procedure SaveBuff;
 This procedure empties the buffer into the current file

var
  Blk,i : integer;
  s     : string;

begin
 If it is a text file then
if TranState = TxtFile then
  begin{ Insert a string ! }
  s := copy('',0,0);
  for i := 1 to pred(Posn) do
    begin
    s := concat(s,' ');
    s[Length(s)] := Buff[i]
    end;
  if NewLine then
    begin
    if Length(s) = 0 then
      writeln(TF)
     else
       writeln(TF,s)
    end
   else
     write(TF,s);
  EmptyBuff(Buff,Posn)
  end
 else{ insert the buffer as it is when full }
   if Posn > BufEnd then
     begin
     if TranState = ImgFile then
       begin
       if YPosn >= 0 then
         begin
         Line.Origin.Y := YPosn;
         PutLine(Line,Im,Buff);
         YPosn := YPosn -1
         end
        else
          EOI := True;
       EmptyBuff(Buff,Posn)
       end
      else
        begin
        Blk := BlockWrite(F,Buff,1);
        EmptyBuff(Buff,Posn)
        end
     end
end{SaveBuff};

(* ---------------------------------------------------- *)

procedure ReadBuff;
{ This procedure fills the buffer from the file when
  necessary }

var
  Blk    : integer;

begin
if ((Posn <= 1) or (Posn > BufEnd)) and (not EOF(F)) and (TranState <> ImgFile) then
  begin
  Blk := BlockRead(F,Buff,1);
  Posn := 1
  end
 else
   if ((Posn <=1) or (Posn > BufEnd)) and (TranState = ImgFile) then
     begin
     if YPosn >= 0 then
       begin
       Posn := 1;
       Line.Origin.Y := YPosn;
       GetLine(Line,Im,Buff);
       YPosn := YPosn - 1
       end
      else
        EOI := True;
     end
end{ReadBuff};

(* ---------------------------------------------------- *)

end{FileHandle}.