-- PressDeviceImpl.mesa
-- Last changed by Doug Wyatt, January 12, 1982  2:31 PM

DIRECTORY
	Device,
	AltoDevice,
    PressDevice,
	OpaqueDevice USING [TextHandle],
	Vector USING [Vec, Matrix,Add],
	Area USING [Rec, Handle, Vertices, Rectangular, Rectangle, Free],
	Poly USING [NewRec],
	Pipe USING [Handle, Object, Procs],
	Font USING [Id],
	ImageObj USING [Handle,SetSamplePosition,GetNextSample],
	Mapper USING [Handle, Concat,InverseMapDelta,InverseMap],
	Style USING [Data, PaintingFunction, Texture, Color],
    Inline,
	Memory USING [zone, mds],
	PressDefs USING [PressFileDescriptor, InitPressFileDescriptor,
		StartOutline, PutDrawTo, PutDots, EndOutline, SetColor, PutRectangle, PutComputedDots,
		ClosePressFile],
	Real USING [FixC];

PressDeviceImpl: PROGRAM
IMPORTS Memory,Mapper,Vector,ImageObj,Area,Poly,Inline,Real,PressDefs
EXPORTS OpaqueDevice,PressDevice SHARES Device,Pipe = {
OPEN Device,Inline;

zone: UNCOUNTED ZONE = Memory.zone;
mds: MDSZone = Memory.mds;

PaintFunction: TYPE = Style.PaintingFunction;
Texture: TYPE = Style.Texture;
Color: TYPE = Style.Color;

DeviceObject: PUBLIC TYPE = Device.Object;

PressHandle: TYPE = POINTER TO PressDefs.PressFileDescriptor;

-- Concrete form of the data
Data: TYPE = RECORD [
	pressHandle: PressHandle,
	fileName: STRING,
	width,height: CARDINAL -- width and height in micas
	];
DataRef: TYPE = LONG POINTER TO Data;

procs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
	NewPipe: CNewPipe,
	NewText: CNewText,
	ApplyBaseTransform: CApplyBaseTransform,
	Boundary: CBoundary,
	Free: CFree
	]]; 

-- Procedures for creating a Device object

NewPressDevice: PUBLIC PROCEDURE[filename: STRING] RETURNS[Handle] = {
	pd: PressHandle = mds.NEW[PressDefs.PressFileDescriptor];
	name: STRING = CopyString[filename];
	d: DataRef = zone.NEW[Data _ [
		pressHandle: pd,
		fileName: name,
		width: (2540/2)*17, height: 2540*11
		]];
	PressDefs.InitPressFileDescriptor[pd,name];
	pd.solidCode _ 's; -- solid (default was transparent)
	RETURN[zone.NEW[Object _ [procs: procs, data: LOOPHOLE[d]]]];
	};

CopyString: PROCEDURE[s: STRING] RETURNS[STRING] = {
	n: CARDINAL=s.length;
	t: STRING=mds.NEW[StringBody[n]];
	FOR i: CARDINAL IN[0..n) DO t[i]_s[i] ENDLOOP; t.length_n;
	RETURN[t];
	};

PData: TYPE = RECORD [
	pressHandle: PressHandle,
	list,curr,start: PointRef,
	miny,maxy: REAL,
	mapper:Mapper.Handle,
	image:ImageObj.Handle,
	color: Color
	];

PDataRef: TYPE = LONG POINTER TO PData;

pProcs: LONG POINTER TO READONLY Pipe.Procs = zone.NEW[Pipe.Procs = [
	Put: PPut, Free: PFree]];

CNewPipe: PROCEDURE[self: Handle, style: POINTER TO Style.Data,mapper:Mapper.Handle, image:ImageObj.Handle]
	RETURNS[Pipe.Handle] = {
	d: DataRef=LOOPHOLE[self.data];
	pd: PressHandle=d.pressHandle;
	p: PDataRef=zone.NEW[PData _ [
		pressHandle: pd, list: NIL, curr: NIL, start: NIL, 
		miny: 0, maxy: 0, mapper:mapper,image:image, 
		color: style.color
		]];
	PressDefs.SetColor[pd,p.color.r,p.color.g,p.color.b];
	RETURN[zone.NEW[Pipe.Object _ [procs: pProcs, data: LOOPHOLE[p]]]];
	};

RoundC: PROC[r: REAL] RETURNS[CARDINAL] = INLINE { RETURN[Real.FixC[r+.5]] };
Side: TYPE = {l,r};

Point: TYPE = RECORD [
	link: ARRAY Side OF PointRef,
	v: Vector.Vec
	];
PointRef: TYPE = LONG POINTER TO Point;

-- This assumes that the polygon comes in anticlockwise!
Link: PROC[old,new: PointRef] = INLINE {
	new.link[l]_old; old.link[r]_new
	};


PPut: PROCEDURE[self: Pipe.Handle, area: Area.Handle] = {
	p: PDataRef=LOOPHOLE[self.data];
	pd: PressHandle=p.pressHandle;
	IF Area.Rectangular[area] AND p.image = NIL THEN {
		r: Area.Rec=Area.Rectangle[area];
		llx: CARDINAL=RoundC[r.ll.x];
		lly: CARDINAL=RoundC[r.ll.y];
		urx: CARDINAL=RoundC[r.ur.x];
		ury: CARDINAL=RoundC[r.ur.y];
		PressDefs.PutRectangle[pd,llx,lly,urx-llx,ury-lly];
		}
	ELSE {
		IF p.image # NIL THEN
			{Put: PROC[v: Vector.Vec] = {
					new: PointRef = zone.NEW[Point_[link: [NIL,NIL], v: v]];
					IF p.list=NIL THEN {
						p.list_p.curr_new;
						p.miny_p.maxy_v.y; p.start_new;
						}
					ELSE {
						Link[p.curr,new]; p.curr_new;
						IF v.y<p.miny THEN { p.miny_v.y; p.start_new }
						ELSE IF v.y>p.maxy THEN p.maxy_v.y;
						};
					};
				Area.Vertices[area,Put];
				IF p.list#NIL THEN {
					Link[p.curr,p.list]; -- close the ring
					DrawImagePolygon[p];};}
			ELSE
		{first: BOOLEAN_TRUE;
		Put: PROC[v: Vector.Vec] = {
			mx: CARDINAL=RoundC[v.x]; -- rounded to micas
			my: CARDINAL=RoundC[v.y]; -- rounded to micas
			IF first THEN { PressDefs.StartOutline[pd,mx,my]; first_FALSE }
			ELSE PressDefs.PutDrawTo[pd,mx,my];};
		Area.Vertices[area,Put]; PressDefs.EndOutline[pd];
		};};
	Area.Free[@area];
	};

FreeList: PROC[d: PDataRef] = {
	p: PointRef_d.list;
	IF p=NIL THEN RETURN;
	p.link[l].link[r]_NIL; -- break the circle
	UNTIL p=NIL DO -- free all the Points
		q: PointRef_p.link[r]; zone.FREE[@p]; p_q ENDLOOP;
	d.list_d.curr_d.start_NIL;
	};

PFree: PROCEDURE[self: Pipe.Handle] = {
	p: PDataRef_LOOPHOLE[self.data];
	zone.FREE[@p]; zone.FREE[@self];
	};

CNewText: PROCEDURE[self: Handle, id: Font.Id, size: REAL,
	pm: POINTER TO READONLY Vector.Matrix,
	style: POINTER TO READONLY Style.Data]
	RETURNS[OpaqueDevice.TextHandle] = {
	RETURN[NIL];
	};

CApplyBaseTransform: PROCEDURE[self: Handle, mapper: Mapper.Handle] = {
	s: REAL=2540.0/72.0;
	Mapper.Concat[mapper,[s,0,0,s]];
	};

CBoundary: PROCEDURE[self: Handle] RETURNS[Area.Handle] = {
	d: DataRef=LOOPHOLE[self.data];
	r: Area.Rec=[[0,0],[d.width,d.height]];
	RETURN[Poly.NewRec[r]];
	};

CFree: PROCEDURE[self: Handle] = {
	d: DataRef_LOOPHOLE[self.data];
	pd: PressHandle_d.pressHandle;
	name: STRING_d.fileName;
	PressDefs.ClosePressFile[pd];
	mds.FREE[@pd]; mds.FREE[@name];
	zone.FREE[@d]; zone.FREE[@self];
	};

Floor: PROC[r: REAL] RETURNS[CARDINAL] = INLINE {
	i:CARDINAL_Real.FixC[r];
	RETURN[IF r = i THEN i-1 ELSE i]
	};

Ceiling: PROC[r: REAL] RETURNS[CARDINAL] = INLINE {
	i:CARDINAL_Real.FixC[r];
	RETURN[IF r = i THEN i ELSE i+1]
	};
Edge: TYPE = RECORD [
	ytop: CARDINAL,
	xt: REAL,
	udx: REAL,
	vert: BOOLEAN,
	end: PointRef
	];
Grid:PROC [c:CARDINAL] RETURNS [CARDINAL]=INLINE {
RETURN[(c/isampc)*isampc];};

sampc:REAL=18.0;
isampc:CARDINAL=18;

DrawImagePolygon: PROC[p: PDataRef] = {
	image:ImageObj.Handle=p.image;
	mapper:Mapper.Handle=p.mapper;
	i:Vector.Vec;
	id:Vector.Vec;
	sx:Vector.Vec;
	rycurr:REAL_p.miny;
	ycurr: CARDINAL_Grid[Real.FixC[p.miny]];
	ystop: CARDINAL=Grid[Real.FixC[p.maxy]];
	edge: ARRAY Side OF Edge_[
		l: [ytop:ycurr,xt:0,udx:0,vert:FALSE,end:p.start],
		r: [ytop:ycurr,xt:0,udx:0,vert:FALSE,end:p.start]
		];
	vertical: BOOLEAN_FALSE;
	CurLX: PROC RETURNS[CARDINAL] =
		INLINE { i:CARDINAL;
		i_Grid[Real.FixC[edge[l].xt]];
		RETURN[IF i = edge[l].xt THEN i ELSE i+isampc]; };
	CurRX: PROC RETURNS[CARDINAL] =
		INLINE { i:CARDINAL;
		i_Grid[Real.FixC[edge[r].xt]];
		RETURN[IF i = edge[r].xt THEN i-isampc ELSE i]; };
	CurSX: PROC[side: Side] RETURNS[Vector.Vec] =
		INLINE  {RETURN[Mapper.InverseMap[
									mapper,Vector.Vec[CurLX[],ycurr+isampc]]]};
	Vert: PROC[side: Side] RETURNS[BOOLEAN] =
		INLINE { RETURN[edge[side].vert] };
	YTop: PROC[side: Side] RETURNS[CARDINAL] =
		INLINE { RETURN[edge[side].ytop] };
	Bump: PROC[side: Side] =
		 { OPEN edge[side];
		IF ytop>ycurr THEN {xt_xt+udx;} ELSE {NextEdge[side];} };
	NextPt: PROC[p: PointRef, side: Side] RETURNS[PointRef] =
		INLINE { RETURN[p.link[side]] };
	NextEdge: PROC[side: Side] =  {
		OPEN edge[side];
		s,e: Vector.Vec;
		delta: REAL;
		e_end.v;
		DO -- advance to an edge that intersects ycurr
			s_e; end_NextPt[end,side]; e_end.v;
			ytop_Grid[Real.FixC[e.y]]; IF ytop>ycurr THEN EXIT;
			ENDLOOP;
		delta_(e.x-s.x)/(e.y-s.y);
		xt_s.x+(ycurr+sampc-s.y)*delta;
		IF side=l THEN 
			{i_Mapper.InverseMap[mapper,Vector.Vec[xt,ycurr+isampc]];
			id_Mapper.InverseMapDelta[mapper,Vector.Vec[delta*sampc,sampc]];
			};
		IF (ytop-ycurr)>isampc THEN { udx_delta*sampc; vert_(udx=0) }
		ELSE { udx_0; vert_FALSE };
		};
	-- Code for DrawPolygon starts here
	sx_Mapper.InverseMapDelta[mapper,Vector.Vec[sampc,0]];
	WHILE ycurr< ystop DO
		v:Vector.Vec;
		maxx,x,cx,wx,tic:CARDINAL;
		ynext: CARDINAL_ycurr+isampc;
		Bump[l]; Bump[r];
		i_Vector.Add[i,id];
		cx_x_CurLX[];
		maxx_CurRX[];
		wx_maxx-cx+isampc;
		v_CurSX[l];
		ImageObj.SetSamplePosition[image,v.x,v.y,sx.x,sx.y];
		tic_0;
		WHILE x <= maxx DO
			lbuff[tic]_LOOPHOLE[ImageObj.GetNextSample[image],CHARACTER]; 
			tic_tic+1;
			x_x+isampc;
		ENDLOOP;
		IF wx > isampc THEN PressDefs.PutDots[p.pressHandle,
							cx,ycurr,tic,1,8,wx,isampc,lbuffptr];
		ycurr_ynext;
		ENDLOOP;
	FreeList[p];
	};

DumpScreen:PUBLIC PROC [name:STRING,bm:AltoDevice.Bitmap] =
	BEGIN OPEN PressDefs;
	p: PressFileDescriptor;
	nWords: CARDINAL = bm.raster;
	nBits: CARDINAL = 16*bm.raster;
	nLines: CARDINAL = bm.height;

	InitPressFileDescriptor[@p, name];
   p.solidCode _ 's;
	PutLongAltoDots[
	  @p, 10795 - 16*nBits, 14605 + 16*nLines, nWords, nBits, nLines, bm.base];
	ClosePressFile[@p];
	END;

PutLongAltoDots: PROCEDURE [
	p: POINTER TO PressDefs.PressFileDescriptor,
	x, y, wordsPerLine, npixels, nscans: CARDINAL, bitmapAddress: LONG POINTER] =
	--Generate Press bitmap file
	BEGIN OPEN PressDefs;
	width, height, wordindent: CARDINAL;
	wordindent _ x/16;
	width _ 32*npixels;
	height _ 32*nscans;
	ResetScanProc[bitmapAddress, wordsPerLine];
	PutComputedDots[
	  p: p, x: x, y: y - height, nPixels: npixels, nScanLines: nscans,
	  bitsPerPixel: 0, width: width, height: height, nextScanLine: ScanProc];
	END;

ResetScanProc: PROCEDURE [bitmapAddress: LONG POINTER, wordsPerLine: CARDINAL] =
	BEGIN LineAddress _ bitmapAddress; WordsPerLine _ wordsPerLine; END;

ScanProc: PROCEDURE RETURNS [POINTER] =
	BEGIN
	--This procedure must return a pointer to a single scanline of dots
	--It will be called repetitively by PutComputedDots
	LongCOPY[LineAddress, WordsPerLine, LineBuffer];
	LineAddress _ LineAddress + WordsPerLine;
	RETURN[LineBuffer];
	END;

LineArray: ARRAY [0..40) OF WORD;
LineBuffer: POINTER _ BASE[LineArray];
LineAddress: LONG POINTER;
WordsPerLine: CARDINAL;

lbuff:STRING_[1024];
lbuffptr:POINTER_@lbuff.text;
}.(670)\8976b15B505b13B139b8B