Columbia Kermit/kermit.zip/archives/ucsdmagiscan2.zip/disk.text

Text File | 2011-08-11 | 6KB | 253 lines

(*$S+*)

 This Unit is based on the SLVDIMS of Joyce Loebl
 Created by H Balen 22-Aug-84
 Modified by H Balen 13-May-85

Unit DiskUnit;

   Interface


   Uses
      M2Types,M2IpRoot,M2Sys;

   type
     GreyVal = 0..255;
     LType = packed array[0..255] of GreyVal;
     L2Type = packed array[0..255] of char;
     LineType = record
                  case Boolean of
                    True :(i : LType);
                    False:(b : L2Type)
                    end;
     BufferType = record
                   case integer of
                    0 :(i : packed array[0..511] of GreyVal);
                    1 :(b : packed array[0..1] of L2Type);
                    2 :(Im : Image )
                    end;
   var
     Fl : File;

   procedure ImSve( Im : Image;
                     FName : String );
   procedure ImLd( var Im : Image;
                     FName  : String );

Implementation

procedure ImSve;
 This procedure saves an image, up to eight bits

var
   Line  : LineType;
   Buffer: BufferType;
   A,B,C,D : Image;
   Blk   : integer;


procedure Deposit( Im : Image );
{ This procedure writes the necessary data to the disk
  in units of 512 bytes,and Images of Half size       }

var
  Blks,RowNum : Integer;
  Row    : PointSet;

  procedure GetLine( LinePs : PointSet;
                     Im     : Image ;
                    var GVal: LType );
  { This procedure gets a 256 byte line from the picture }

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

  var
     Mrk : ^Integer;
     Idyn: ^Idynarray;
     i   : integer;

  begin
  { Mark the Heap, and create space }
  mark(Mrk);
  New(Idyn);
  { Sample the image over the pointset and collect data }
  ImSmp(LinePs,Im,Idyn^[0],i);
  { Transfer the sampled data to the array for returning }
  for i := 0 to 255 do
     GVal[i] := Idyn^[i];
  { Clear the heap }
  Release(Mrk)
  end{ GetLine };

begin
 Define a pointset for sampling purposes
DefWindow(Row,0,0,256,1);
 Get the necessary part of the image and save it
for RowNum := 0 to 255 do
   begin
   { Move pointset to current sample line }
   Row.Origin.Y := RowNum;
   { Sample the current line / collect the Data Values }
   GetLine(Row,Im,Line.i);
   if Odd(RowNum) then
     begin{ Write to the Disk }
     { Copy to buffer }
     Buffer.b[1] := Line.b;
     { Actual write to disk }
     Blks := BlockWrite(Fl,Buffer.i,1)
     end
    else{ Still to fill the Buffer }
      Buffer.b[0] := Line.b
   end
end{ Deposit };

begin{ Save }
 Open the file
Rewrite(Fl,FName);
 Collect the attributes of the image
Buffer.Im := Im;
 Put image attributes at the beginning of the file
Blk := BlockWrite(Fl,Buffer.Im,1);
 Deal with necessary image size
case Im.Res of
   Half: Deposit(Im);
   Full: begin
         with Im do
           begin
           { Split the image into 4 Half size images }
           DefImage(A,Origin.X,Origin.Y,Half,LsBit,NoBits);
           DefImage(B,Origin.X+256,Origin.Y,Half,LsBit,NoBits);
           DefImage(C,Origin.X+256,Origin.Y+256,Half,LsBit,NoBits);
           DefImage(D,Origin.X,Origin.Y+256,Half,LsBit,NoBits);
           { Save the image on disk }
           Deposit(A);
           Deposit(B);
           Deposit(C);
           Deposit(D)
           end{ with }
         end
   end{ Case };
 Close the file
Close(Fl,Lock)
end{ Save };


procedure ImLd;
 This procedure ReLoads a previously saved image

var
   Buffer : BufferType;
   Line   : LineType;
   A,B,C,D: Image;
   L,N,Blk: Integer;
   Error  : Boolean;


procedure ReDraw( var Im : Image );
 This procedure draws a Half size image on the screen

var
  RowNum,Blks : integer;
  Row    : PointSet;


  procedure PutRow( LinePs : PointSet;
                   var Im  : Image;
                   var GVal: LType );
  { This procedure gets the current row and draws it }

  type
    Idynarray = array[1..1] of integer;

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

  begin
  { Mark Heap and make room }
  mark(Mrk);
  New(Idyn);
  { Get the current line }
  for i := 0 to 255 do
    Idyn^[i] := GVal[i];
  { Draw the line }
  DrawFn(LinePs,Im,Idyn^[0]);
  { Tidy the Heap }
  release(Mrk)
  end{ PutRow };


begin
 Define a PointSet for the current line
DefWindow(Row,0,0,256,1);
 Draw the Half image to screen
for RowNum := 0 to 255 do
  begin
  { Move the PointSet to the current Line position }
  Row.Origin.Y := RowNum;
  if Odd(RowNum) then
    begin{ Read the Buffer }
    Line.b := Buffer.b[1];
    { and put on screen }
    PutRow(Row,Im,Line.i)
    end
   else
     begin{ Fill the Buffer from the Disk }
     Blks := BlockRead(Fl,Buffer.i,1);
     { Then read it and put on screen }
     Line.b := Buffer.b[0];
     PutRow(Row,Im,Line.i)
     end
  end
end{ ReDraw };

begin
 Take care of possible file name fault
(*$I-*)
Reset(Fl,FName);
Error := IOResult <> 0;
(*$I+*)
 If we have the correct file then
if not Error then
  begin{ Get the details of the stored image }
  Blk := BlockRead(Fl,Buffer.Im,1);
  { If the stored image does not match the declared image }
  if (Buffer.Im.Res <> Im.Res) then{ error }
    writeln(' ReLoad : Image Resolution incompatible ')
   else{ Everything ok }
    begin
    { Take care of image size }
    case Im.Res of
     Half: ReDraw(Im);
     Full: begin
           with Im do
            begin
            { Split image into 4 Half size images }
            L := LsBit;N := NoBits;
            DefImage(A,Origin.X,Origin.Y,Half,L,N);
            DefImage(B,Origin.X+256,Origin.Y,Half,L,N);
            DefImage(C,Origin.X+256,Origin.Y+256,Half,L,N);
            DefImage(D,Origin.X,Origin.Y+256,Half,L,N);
            { Get each image and draw it }
            ReDraw(A);
            ReDraw(B);
            ReDraw(C);
            ReDraw(D);
            end{ With };
           end;
     end{ Case }
    end;
   Close(Fl)
   end{ Not Error }
  else{ Error in file name }
    writeln(' ReLoad : Image file open error ')
end{ ReLoad };



end{ Save }.