-- File: AisObjImpl.mesa
-- Written by: J Warnock
-- Last changed by J Warnock,October 15, 1980  11:26 AM
-- Last changed by Doug Wyatt, January 12, 1982  4:30 PM

-- Cedar graphics code specific to Ais Image Files

DIRECTORY
	Mopcodes,
	AltoDefs,
	AreaPath,
	Path,
	Vector,
	Mapper,
	Memory,
	StreamDefs: FROM "StreamDefs" USING [
		StreamIndex,NewWordStream,ReadBlock,SetIndex,StreamHandle,Read],
	SystemDefs USING [AllocateSegment,FreeSegment],
 	ImageObj: FROM "ImageObj",
 	Real: FROM "Real",
 	RealFns: FROM "RealFns",
 	AISObj: FROM "AISObj",
	InlineDefs: FROM "InlineDefs" USING [
		HighHalf, LowHalf, LongNumber];

AisObjImpl: PROGRAM
IMPORTS Memory,StreamDefs,Mapper,Real,RealFns,Path,AreaPath,InlineDefs,SystemDefs EXPORTS AISObj, ImageObj SHARES ImageObj
 =
BEGIN OPEN AISObj, ImageObj;

zone:UNCOUNTED ZONE = Memory.zone;

DataRef: TYPE = LONG POINTER TO Data;
ProcRef: TYPE = LONG POINTER TO Procs;
Data: PUBLIC TYPE = RECORD
	[
	stream:StreamDefs.StreamHandle,-- stream Handle to AISfile
	headerinfo: POINTER TO AISHeader, -- Ais header information
	rasterinfo: POINTER TO RasterPart,
	bbinfo: BitBufInfo,
	ixpos,iypos,dx,dy:Fraction,
	curline:LONG POINTER,
	bitbuf: POINTER TO UNSPECIFIED
		];

AISHeader:TYPE = MACHINE DEPENDENT 
	RECORD[Password:CARDINAL,HeaderLength:CARDINAL];

RasterPart:TYPE = MACHINE DEPENDENT RECORD
	[partHeader:TypeRecord,
	scanCount,
	scanLength,
	direction,
	samplesPerPixel:CARDINAL,
	codingType:CARDINAL,
	uca:UCA];

UCA:TYPE = MACHINE DEPENDENT RECORD
	[bitsPerSample,
	wordsPerScanLine,
	scanLinesPerBlock,
	paddingPerBlock:CARDINAL];

TypeRecord: TYPE = MACHINE DEPENDENT RECORD[Type:[0..77B),Length:[0..1777B)];

BitBufInfo:TYPE =
		RECORD[ycounter,yfirst,ylast,linesperbuff,
				wordsperline:CARDINAL, filebase:LONG CARDINAL];

Fraction: TYPE = LONG INTEGER;
sclup: InlineDefs.LongNumber _ [num[highbits: 1, lowbits: 0]];
scaleup: REAL=sclup.li;

-- fix a real into a signed integer.fraction
FixF: PROC[r: REAL] RETURNS[Fraction] = INLINE {
	RETURN[Real.Fix[r*scaleup]]
	};

-- return the integer part of an integer.fraction
IntF: PROC[f: Fraction] RETURNS[INTEGER] = INLINE {
	RETURN[InlineDefs.HighHalf[f]]
	};


NewAISObj: PUBLIC PROCEDURE[filename:STRING] 	RETURNS[ImageObj.Handle] =
	BEGIN
	d:DataRef_ zone.NEW[Data];
	p:ProcRef_ zone.NEW[Procs_[GetScanCount,
		SetScanCount,
		GetScanLength,
		SetScanLength,
		GetSamplesPerPixel,
		SetSamplesPerPixel,
		GetBitsPerSample,
		SetBitsPerSample,
		ReadSample,
		SetSamplePosition,
		GetNextSample,
		PutNextSample,
		Reset,
		EnumerateBoundaries,
		Free]];
	d.stream_StreamDefs.NewWordStream[filename,StreamDefs.Read];
	d.headerinfo_SystemDefs.AllocateSegment[SIZE[AISHeader]];
	[] _StreamDefs.ReadBlock[d.stream, d.headerinfo, SIZE[AISHeader]];
	IF d.headerinfo.Password # 33962 THEN ERROR;
	d.rasterinfo_SystemDefs.AllocateSegment[SIZE[RasterPart]];
	[] _StreamDefs.ReadBlock[d.stream, d.rasterinfo, SIZE[RasterPart]];
	d.bitbuf_SystemDefs.AllocateSegment[bitbufsize];
	d.bbinfo_[ 0, 0, 0,
		bitbufsize/d.rasterinfo.uca.wordsPerScanLine,
		d.rasterinfo.uca.wordsPerScanLine,
		d.headerinfo.HeaderLength];
	RETURN[zone.NEW[Object _ [procs:p, data: d]]];
	END;

GetScanCount:PUBLIC PROCEDURE [self:Handle]RETURNS [sc:CARDINAL]=
	{d:DataRef=self.data; RETURN[d.rasterinfo.scanCount];};

SetScanCount:PUBLIC PROCEDURE [self:Handle,sc:CARDINAL]=
	{};

GetScanLength:PUBLIC PROCEDURE[self:Handle] RETURNS [sl:CARDINAL]=
	{d:DataRef=self.data; RETURN[d.rasterinfo.scanLength];};

SetScanLength:PUBLIC PROCEDURE [self:Handle,sl:CARDINAL]=
	{};

GetSamplesPerPixel:PUBLIC PROCEDURE[self:Handle] RETURNS[spp:CARDINAL]=
	{d:DataRef=self.data; RETURN[d.rasterinfo.samplesPerPixel];};

SetSamplesPerPixel:PUBLIC PROCEDURE[self:Handle,spp:CARDINAL]=
	{};

GetBitsPerSample:PUBLIC PROCEDURE[self:Handle] RETURNS [bps:CARDINAL]=
	{d:DataRef=self.data; RETURN[d.rasterinfo.uca.bitsPerSample];};

SetBitsPerSample:PUBLIC PROCEDURE [self:Handle,bps:CARDINAL]=
	{};

ReadSample:PUBLIC PROCEDURE[self:Handle,x,y:REAL] RETURNS [v:CARDINAL]=
	{ 	OPEN Vector;
		GetBuff:PROC =
		{mark,twpl:LONG CARDINAL;
		twpl_d.bbinfo.wordsperline;
		mark_	d.headerinfo.HeaderLength+	twpl*ylow;
		StreamDefs.SetIndex[d.stream,LongCardinalToStreamIndex[mark]];
		[] _StreamDefs.ReadBlock[d.stream, d.bitbuf, 
											(yhigh-ylow)*d.bbinfo.wordsperline];
		d.bbinfo.yfirst_ylow; 
		d.bbinfo.ylast_yhigh;
		};
	d:DataRef=self.data;
	ix,iy:CARDINAL;
	ylow,yhigh:CARDINAL;
	ix_Real.FixC[x]; iy_Real.FixC[y];
	IF iy NOT IN [d.bbinfo.yfirst..d.bbinfo.ylast) THEN 
		{ylow_IF iy < d.bbinfo.linesperbuff/2 
			THEN 0 ELSE iy -d.bbinfo.linesperbuff/2;
		yhigh_MIN[d.rasterinfo.scanCount,ylow+d.bbinfo.linesperbuff];
		GetBuff[];};
	RETURN[GetPixel[ix,iy-d.bbinfo.yfirst,d.bitbuf,d.bbinfo.wordsperline]];
};

SetSamplePosition:PUBLIC PROCEDURE[self:Handle,x,y,dx,dy:REAL] =
	{d:DataRef=self.data;
	p:ProcRef=LOOPHOLE[self.procs]; -- LOOPHOLE to defeat READONLY
	d.ixpos_FixF[x];
	d.dx_FixF[dx];
	IF RealFns.AlmostZero[dy,-30] THEN 
	{d.curline_(Real.Fix[y]-d.bbinfo.yfirst)*d.bbinfo.wordsperline+d.bitbuf;
	p.GetNextSample_GetHSample;}
	 ELSE
	{d.iypos_FixF[y];
	d.dy_FixF[dy];
	p.GetNextSample_GetNextSample;};
 	};

GetNextSample:PUBLIC PROCEDURE [self: Handle] RETURNS [CARDINAL]  = 	
	{d:DataRef=self.data; 
	c:CARDINAL_GetPixel[IntF[d.ixpos],IntF[d.iypos]-d.bbinfo.yfirst,
				d.bitbuf,d.bbinfo.wordsperline];
	d.ixpos_d.ixpos+d.dx;
	d.iypos_d.iypos+d.dy;
	RETURN[c];
	};

GetHSample:PUBLIC PROCEDURE [self: Handle] RETURNS [CARDINAL]  = 	
	{d:DataRef=self.data; 
	i:CARDINAL_IntF[d.ixpos];
	c:CARDINAL_RLF[d.curline + i/2,IF i MOD 2 = 1 
		THEN FieldParam[0,FD[8, 7]]
		ELSE FieldParam[0,FD[0, 7]]];
	d.ixpos_d.ixpos+d.dx;
	RETURN[c];
	};

PutNextSample:PUBLIC PROCEDURE [self: Handle,v:CARDINAL]  = 
	{d:DataRef=self.data; 
	};

Reset:PUBLIC PROCEDURE[self:Handle]=
	{d:DataRef=self.data;
	d.bbinfo.ycounter_0;};

EnumerateBoundaries:PUBLIC PROCEDURE[self:Handle,mapper:Mapper.Handle] RETURNS [p:Path.Handle]=
	{ 	OPEN Vector;
		GetBuff:PROC =
		{mark,twpl:LONG CARDINAL;
		twpl_d.bbinfo.wordsperline;
		mark_	d.headerinfo.HeaderLength+	twpl*ylow;
		StreamDefs.SetIndex[d.stream,LongCardinalToStreamIndex[mark]];
		[] _StreamDefs.ReadBlock[d.stream, d.bitbuf, 
											(yhigh-ylow)*d.bbinfo.wordsperline];
		d.bbinfo.yfirst_ylow; 
		d.bbinfo.ylast_yhigh;
		};
	d:DataRef=self.data;
	ylow,yhigh:CARDINAL;
	rylow,ryhigh:REAL;
	IF d.bbinfo.ycounter >= d.rasterinfo.scanCount THEN RETURN[NIL];
	ylow_d.bbinfo.ycounter;
	yhigh_MIN[d.rasterinfo.scanCount,d.bbinfo.ycounter+d.bbinfo.linesperbuff];
	GetBuff[];
	ryhigh_yhigh-1; rylow_ylow+1;
	p_AreaPath.New[FALSE];
	Path.EnterPoint[p,Mapper.Map[mapper,Vec[1,rylow]]];
	Path.EnterPoint[p,Mapper.Map[mapper,Vec[d.rasterinfo.scanLength-2,rylow]]];
	Path.EnterPoint[p,Mapper.Map[mapper,Vec[d.rasterinfo.scanLength-2,ryhigh]]];
	Path.EnterPoint[p,Mapper.Map[mapper,Vec[1,ryhigh]]];
	d.bbinfo.ycounter_d.bbinfo.ycounter+d.bbinfo.linesperbuff-2;
	};

Free:PUBLIC PROCEDURE [selfptr: LONG POINTER TO Handle]=
	{d:DataRef_selfptr.data; 
	p:ProcRef_LOOPHOLE[selfptr.procs]; -- LOOPHOLE to defeat READONLY
	SystemDefs.FreeSegment[d.bitbuf];
	SystemDefs.FreeSegment[d.rasterinfo]; 
	SystemDefs.FreeSegment[d.headerinfo];
	zone.FREE[@d];
	zone.FREE[@p];
	zone.FREE[@selfptr^];};


bitbufsize:CARDINAL_8192;

LongCardinalToStreamIndex: PROCEDURE [l:LONG CARDINAL] RETURNS [s:StreamDefs.StreamIndex]=
BEGIN
s.page _ InlineDefs.LowHalf[(LOOPHOLE[l,LONG CARDINAL]*2)/AltoDefs.CharsPerPage];
s.byte _ InlineDefs.LowHalf[(LOOPHOLE[l,LONG CARDINAL]*2) MOD AltoDefs.CharsPerPage];END;

StreamIndexToLongCardinal: PROCEDURE [s:StreamDefs.StreamIndex] RETURNS [l:LONG CARDINAL]=
BEGIN
l _ InlineDefs.LowHalf[LOOPHOLE[s,LONG CARDINAL]] *AltoDefs.CharsPerPage;
l _ (InlineDefs.HighHalf[LOOPHOLE[s,LONG CARDINAL]] +l)/2;
END;

BltPixel: PUBLIC PROCEDURE [i,j,val:CARDINAL,xbase:LONG POINTER TO UNSPECIFIED, xwords:CARDINAL] =
BEGIN
p:CARDINAL;
field: FieldParam;
word: LONG POINTER;
word _ xbase + j*xwords + i/4;
field.alpha _ 0;
field.beta _ [(i MOD 4)*4, 3];
p_RLF[word,field];
p_MIN[p+val,15];
WLF[p,word,field];
RETURN;
END;

bitsperpixel:CARDINAL=8;
PixelField: PROCEDURE[i,j:CARDINAL,xbase:LONG POINTER TO UNSPECIFIED, xwords:CARDINAL]
               RETURNS [LONG POINTER, FieldParam] =
	INLINE 
	BEGIN
	RETURN[xbase + j*xwords + i/2,
			FieldParam[0,FD[i*bitsperpixel MOD 16, bitsperpixel-1]]];
	END;


GetPixel: PUBLIC PROCEDURE[i,j:CARDINAL,xbase:LONG POINTER TO UNSPECIFIED, xwords:CARDINAL] RETURNS [CARDINAL] =
INLINE
BEGIN
RETURN[RLF[xbase + j*xwords + i/2,IF i MOD 2 = 1 
		THEN FieldParam[0,FD[8, bitsperpixel-1]]
		ELSE FieldParam[0,FD[0, bitsperpixel-1]]]];
END;

PutPixel: PUBLIC PROCEDURE[i,j:CARDINAL,xbase:LONG POINTER TO UNSPECIFIED, xwords:CARDINAL,p:CARDINAL] =
BEGIN
field: FieldParam;
word: LONG POINTER;
[word, field] _ PixelField[i,j,xbase,xwords];
WLF[p, word, field];
RETURN
END;


FD: TYPE = RECORD [pos, size: [0..17B]];
FieldParam: TYPE = RECORD [alpha: [0..377B], beta: FD];

RLF: PROCEDURE [p:LONG POINTER, f: FieldParam] RETURNS [UNSPECIFIED] =
      MACHINE CODE BEGIN Mopcodes.zRFSL; END;

WLF: PROCEDURE [data: UNSPECIFIED, p:LONG POINTER, f: FieldParam] =
      MACHINE CODE BEGIN Mopcodes.zWFSL; END;


END.(600)\624b10B1533b9B5132b26B244b26B211b8B321b10B246b8B263b8B223b2B39b10B47b3B115b3B