home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
ucsdmagiscan2
/
disk.text
< prev
next >
Wrap
Text File
|
2020-01-01
|
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 }.