-- 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;
}.