-- AltoDeviceImpl.mesa
-- Last changed by Doug Wyatt, January 12, 1982 4:31 PM

DIRECTORY
Device,
OpaqueDevice USING [],
AltoDevice USING [Bitmap, ScreenBitmap],
Vector USING [Vec, Matrix, Add, Sub],
ImageObj USING [Handle, SetSamplePosition, GetNextSample],
Mapper USING [Handle, Translate, Concat, InverseMap, InverseMapDelta],
Area USING [Rec, Handle, Vertices, Rectangle, Rectangular, Free],
Poly USING [NewRec],
Pipe USING [Handle, Object, Procs, Put, Free],
Clipper USING [Handle, State, NewPipe, Push, Test, Pop],
Style USING [Data, PaintingFunction, Texture],
Font USING [Id],
Text USING [Info, Handle, Object, Procs],
AltoFont USING [Handle, BBox, Rast, New, Default,
Character, CharBox, StringBox, FontBox, Free],
Blt USING [Handle, New, Source, SetX, SetY, SetBox, SetYCur, PutPixel,Rect, Ref, Free],
Memory USING [zone, mds],
Real USING [Fix, FixC, FixI],
InlineDefs USING [ HighHalf, LowHalf],
TimeDefs USING [PackedTime, CurrentDayTime];

AltoDeviceImpl: PROGRAM
IMPORTS AltoDevice,Memory,Vector,ImageObj,Mapper,Clipper,
Area,Poly,Pipe,AltoFont,Blt,
Real,InlineDefs,TimeDefs
EXPORTS AltoDevice,OpaqueDevice SHARES Device,Pipe,Text = {
OPEN Device;

pause: BOOLEAN←FALSE;

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

Paint: TYPE = Style.PaintingFunction;
Texture: TYPE = Style.Texture;

DeviceObject: PUBLIC TYPE = Device.Object;
TextObject: PUBLIC TYPE = Text.Object;

-- Concrete form of the data
Data: TYPE = RECORD [
bca: LONG POINTER, -- bitmap address
bmr: CARDINAL, -- raster width in words
width,height: CARDINAL, -- width and height in bits
refs: CARDINAL
];
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

NewAltoDevice: PUBLIC PROC[b: AltoDevice.Bitmap] RETURNS[Handle] = {
d: DataRef = zone.NEW[Data ← [bca: b.base, bmr: b.raster,
width: 16*b.raster, height: b.height, refs: 1]];
RETURN[zone.NEW[Object ← [procs: procs, data: LOOPHOLE[d]]]];
};

screenHandle: Handle←NIL;

ScreenDevice: PUBLIC PROC RETURNS[Handle] = {
IF screenHandle=NIL THEN
screenHandle←NewAltoDevice[AltoDevice.ScreenBitmap[]];
RETURN[screenHandle];
};

-- Operations on an Alto Device

PData: TYPE = RECORD [
list,curr,start: PointRef,
miny,maxy: REAL,
blt: Blt.Handle,
mapper:Mapper.Handle,
image:ImageObj.Handle,
refs: CARDINAL
];
PDataRef: TYPE = LONG POINTER TO PData;

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

BltStyle: PROC[d: Blt.Handle, style: POINTER TO Style.Data] = {
Nibbles: TYPE = PACKED ARRAY[0..4) OF [0..17B];
t: Nibbles=LOOPHOLE[style.texture];
FOR i: CARDINAL IN[0..4) DO
LOOPHOLE[d.grays[i],Nibbles]←ALL[t[i]]
ENDLOOP;
SELECT style.paint FROM
replace => d.bbt.function←replace;
paint => d.bbt.function←paint;
invert => d.bbt.function←invert;
erase => d.bbt.function←erase;
ENDCASE;
};

CNewPipe: PROC[self: Handle, style: POINTER TO Style.Data,mapper:Mapper.Handle←NIL,image:ImageObj.Handle←NIL]
RETURNS[Pipe.Handle] = {
d: DataRef=LOOPHOLE[self.data];
blt: Blt.Handle=Blt.New[d.bca,d.bmr];
BltStyle[blt,style];
RETURN[IF mapper=NIL THEN MakePipe[blt]
ELSE MakeImagePipe[blt,mapper,image]];
};

MakePipe: PROC[blt: Blt.Handle] RETURNS[Pipe.Handle] = --INLINE-- {
p: PDataRef = zone.NEW[PData ← [
list: NIL, curr: NIL, start: NIL, miny: 0, maxy: 0,
blt: blt, mapper:NIL, image:NIL, refs: 1
]];
RETURN[zone.NEW[Pipe.Object ← [procs: pProcs, data: LOOPHOLE[p]]]]
};

MakeImagePipe: PROC[blt: Blt.Handle, m:Mapper.Handle,i:ImageObj.Handle] RETURNS[Pipe.Handle] = --INLINE-- {
p: PDataRef = zone.NEW[PData ← [
list: NIL, curr: NIL, start: NIL, miny: 0, maxy: 0,
blt: blt, mapper:m, image:i,refs: 1
]];
RETURN[zone.NEW[Pipe.Object ← [procs: pProcs, data: LOOPHOLE[p]]]]
};

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: PROC[self: Pipe.Handle, area: Area.Handle] = {
p: PDataRef=LOOPHOLE[self.data];
r: Area.Rec=Area.Rectangle[area];
-- *** should test whether within display rectangle
IF Area.Rectangular[area] AND p.image = NIL THEN {
blt: Blt.Handle=p.blt;
IF pause THEN Pause;
Blt.SetX[blt,Ceiling[r.ll.x],Floor[r.ur.x]+1];
Blt.SetY[blt,Real.FixC[r.ll.y],Real.FixC[r.ur.y]];
Blt.Rect[blt];
}
ELSE {
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
IF pause THEN Pause;
IF p.image = NIL THEN DrawPolygon[p] ELSE DrawImagePolygon[p];
};
};
Area.Free[@area];
};

Pause: PROC = {
OPEN TimeDefs;
t: PackedTime=CurrentDayTime[];
WHILE CurrentDayTime[]=t DO ENDLOOP;
};

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: PROC[self: Pipe.Handle] = {
p: PDataRef←LOOPHOLE[self.data];
Blt.Free[@p.blt];
zone.FREE[@p]; 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]
};

RoundLI: PROC[r: REAL] RETURNS[LONG INTEGER] = INLINE {
RETURN[Real.Fix[r+.5]]
};

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

RoundI: PROC[r: REAL] RETURNS[INTEGER] = INLINE {
RETURN[Real.FixI[r+.5]]
};


Edge: TYPE = RECORD [
ytop: CARDINAL,
xt: REAL,
udx: REAL,
vert: BOOLEAN,
end: PointRef
];

DrawPolygon: PROC[p: PDataRef] = {
blt: Blt.Handle=p.blt;
ycurr: CARDINAL←Real.FixC[p.miny];
ystop: CARDINAL=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 {RETURN[Ceiling[edge[l].xt]];};
CurRX: PROC RETURNS[CARDINAL] =
INLINE {RETURN[Floor[edge[r].xt]];};
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] =
INLINE { 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] = INLINE {
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←Real.FixC[e.y]; IF ytop > ycurr THEN EXIT;
ENDLOOP;
delta←(e.x-s.x)/(e.y-s.y);
xt←s.x+(ycurr+1.0-s.y)*delta;
IF (ytop-ycurr)>1 THEN { udx←delta; vert←(udx=0) }
ELSE { udx←0; vert←FALSE };
};
-- Code for DrawPolygon starts here
WHILE ycurr<ystop DO
ynext: CARDINAL←ycurr+1;
Bump[l]; Bump[r];
IF Vert[l] AND Vert[r] THEN ynext←MIN[YTop[l],YTop[r]];
Blt.SetX[blt,CurLX[],CurRX[]+1];
Blt.SetY[blt,ycurr,ynext];
Blt.Rect[blt];
ycurr←ynext;
ENDLOOP;
FreeList[p];
};

DrawImagePolygon: PROC[p: PDataRef] = {
blt:Blt.Handle=p.blt;
image:ImageObj.Handle=p.image;
mapper:Mapper.Handle=p.mapper;
--tsh:ARRAY [0..24] OF CARDINAL=
--[1*10,18*10,24*10,10*10,12*10,
--14*10,7*10,5*10,23*10,16*10,
--20*10,21*10,13*10,2*10,9*10,
--22*10,15*10,6*10,19*10,3*10,
--8*10,4*10,2*10,11*10,25*10];
tsh:ARRAY [0..8] OF CARDINAL=
[200,75,150,125,25,225,50,175,100];
i:Vector.Vec;
id:Vector.Vec;
sx:Vector.Vec;
mx,my:CARDINAL;
rycurr:REAL←p.miny;
ycurr: CARDINAL←Real.FixC[p.miny];
ystop: CARDINAL=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←Real.FixC[edge[l].xt];
RETURN[IF i = edge[l].xt THEN i ELSE i+1]; };
CurRX: PROC RETURNS[CARDINAL] =
INLINE { i:CARDINAL;
i←Real.FixC[edge[r].xt];
RETURN[IF i = edge[r].xt THEN i-1 ELSE i]; };
CurSX: PROC[side: Side] RETURNS[Vector.Vec] =
INLINE {RETURN[Mapper.InverseMap[
mapper,Vector.Vec[CurLX[],ycurr+1]]]};
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←Real.FixC[e.y]; IF ytop>ycurr THEN EXIT;
ENDLOOP;
delta←(e.x-s.x)/(e.y-s.y);
xt←s.x+(ycurr+1.0-s.y)*delta;
IF side=l THEN
{i←Mapper.InverseMap[mapper,Vector.Vec[xt,ycurr+1]];
id←Mapper.InverseMapDelta[mapper,Vector.Vec[delta,1]];
};
IF (ytop-ycurr)>1 THEN { udx←delta; vert←(udx=0) }
ELSE { udx←0; vert←FALSE };
};
-- Code for DrawPolygon starts here
sx←Mapper.InverseMapDelta[mapper,Vector.Vec[1,0]];
my←(ycurr MOD 3)*3;
WHILE ycurr< ystop DO
v:Vector.Vec;
maxx,x:CARDINAL;
ynext: CARDINAL←ycurr+1;
Bump[l]; Bump[r];
i←Vector.Add[i,id];
x←CurLX[];
mx←x MOD 3;
maxx←CurRX[];
v←CurSX[l];
ImageObj.SetSamplePosition[image,v.x,v.y,sx.x,sx.y];
Blt.SetYCur[blt,ycurr];
WHILE x <= maxx DO
IF ImageObj.GetNextSample[image] < tsh[my+mx]
THEN Blt.PutPixel[blt,x];
x←x+1;
mx←IF mx = 2 THEN 0 ELSE mx + 1;
ENDLOOP;
ycurr←ynext;
my←IF my = 6 THEN 0 ELSE my + 3;
ENDLOOP;
FreeList[p];
};

-- Text stuff (ecchhh!)

TData: TYPE = RECORD [
d: DataRef,
blt: Blt.Handle,
font: AltoFont.Handle
];
TDataRef: TYPE = LONG POINTER TO TData;

tProcs: LONG POINTER TO READONLY Text.Procs = zone.NEW[Text.Procs = [
CharInfo: TCharInfo,
StringInfo: TStringInfo,
FontInfo: TFontInfo,
DrawChar: TDrawChar,
DrawString: TDrawString,
Free: TFree
]];

fProcs: LONG POINTER TO READONLY Text.Procs = zone.NEW[Text.Procs = [
CharInfo: TCharInfo,
StringInfo: TStringInfo,
FontInfo: TFontInfo,
DrawChar: FDrawChar,
DrawString: FDrawString,
Free: TFree
]];

CNewText: PROC[self: Handle, id: Font.Id, size: REAL,
pm: POINTER TO READONLY Vector.Matrix,
style: POINTER TO READONLY Style.Data]
RETURNS[Text.Handle] = {
d: DataRef=LOOPHOLE[self.data];
t: TDataRef=zone.NEW[TData ← [d: d, blt: TextBlt[d,style], font: NIL]];
fake: BOOLEAN←FALSE;
IF UniformScale[pm↑] THEN size←size*pm.a11 ELSE fake←TRUE;
IF size IN[FIRST[CARDINAL]..LAST[CARDINAL]] THEN
t.font←AltoFont.New[id,Real.FixC[size+0.49]];
IF t.font=NIL THEN { fake←TRUE; t.font←AltoFont.Default[] };
RETURN[zone.NEW[Text.Object ← [
procs: IF fake THEN fProcs ELSE tProcs, data: LOOPHOLE[t]
]]];
};

TextBlt: PROC[d: DataRef, style: POINTER TO READONLY Style.Data]
RETURNS[Blt.Handle] = INLINE {
blt: Blt.Handle=Blt.New[d.bca,d.bmr];
BltStyle[blt,LOOPHOLE[style]]; -- LOOPHOLE to defeat READONLY
blt.bbt.sourcetype←andgray;
RETURN[blt];
};

UniformScale: PROC[m: Vector.Matrix] RETURNS[BOOLEAN] = INLINE {
eps: REAL=1E-6;
Tiny: PROC[r: REAL] RETURNS[BOOLEAN] = INLINE { RETURN[ABS[r]<eps] };
RETURN[Tiny[m.a12] AND Tiny[m.a21] AND Tiny[m.a11+m.a22]];
};

FillInfo: PROC[bbox: POINTER TO AltoFont.BBox,
info: POINTER TO Text.Info] = INLINE {
info↑ ← [
size: [bbox.dx,bbox.dy],
origin: [bbox.ox,bbox.oy],
width: [bbox.wx,bbox.wy]
];
};
TCharInfo: PROC[self: Text.Handle, c: CHARACTER,
info: POINTER TO Text.Info] = {
t: TDataRef=LOOPHOLE[self.data];
bbox: AltoFont.BBox←AltoFont.CharBox[t.font,c];
FillInfo[@bbox,info];
};
TStringInfo: PROC[self: Text.Handle, s: LONG STRING,
info: POINTER TO Text.Info] = {
t: TDataRef=LOOPHOLE[self.data];
bbox: AltoFont.BBox←AltoFont.StringBox[t.font,s];
FillInfo[@bbox,info];
};
TFontInfo: PROC[self: Text.Handle,
info: POINTER TO Text.Info] = {
t: TDataRef=LOOPHOLE[self.data];
bbox: AltoFont.BBox←AltoFont.FontBox[t.font];
FillInfo[@bbox,info];
};

TDrawChar: PROC[self: Text.Handle, c: CHARACTER,
origin: Vector.Vec, clipper: Clipper.Handle]
RETURNS[Vector.Vec] = {
t: TDataRef=LOOPHOLE[self.data];
bbox: AltoFont.BBox;
rast: AltoFont.Rast;
AltoFont.Character[t.font,c,@bbox,@rast];
IF bbox.dx>0 THEN {
state: Clipper.State;
CharArea: PROC[orig: Vector.Vec] RETURNS[Area.Handle] = {
ll: Vector.Vec=Vector.Add[orig,[bbox.ox,bbox.oy]];
ur: Vector.Vec=Vector.Add[ll,[bbox.dx,bbox.dy]];
RETURN[Poly.NewRec[[ll,ur]]];
};
Clipper.Push[clipper,CharArea[origin]];
state←Clipper.Test[clipper];
IF state.in THEN {
rx: INTEGER=RoundI[origin.x];
ry: INTEGER=RoundI[origin.y];
blt: Blt.Handle=t.blt;
blt.sdx←rx-rast.x0; blt.sdy←ry-rast.y0;
Blt.Source[blt,rast.bca,rast.bmr];
IF state.out THEN {
pipe: Pipe.Handle←MakePipe[Blt.Ref[blt]];
pipe←Clipper.NewPipe[clipper,pipe];
Pipe.Put[pipe,CharArea[[rx,ry]]]; Pipe.Free[@pipe];
}
ELSE {
Blt.SetBox[blt,rx+bbox.ox,ry+bbox.oy,bbox.dx,bbox.dy];
Blt.Rect[blt];
};
};
Clipper.Pop[clipper];
};
RETURN[Vector.Add[origin,[bbox.wx,bbox.wy]]];
};

TDrawString: PROC[self: Text.Handle, s: LONG STRING,
origin: Vector.Vec, clipper: Clipper.Handle]
RETURNS[Vector.Vec] = {
t: TDataRef=LOOPHOLE[self.data];
bbox: AltoFont.BBox←AltoFont.StringBox[t.font,s];
state: Clipper.State;
StringArea: PROC[orig: Vector.Vec] RETURNS[Area.Handle] = {
ll: Vector.Vec=Vector.Add[orig,[bbox.ox,-(bbox.dy+bbox.oy)]];
ur: Vector.Vec=Vector.Add[ll,[bbox.dx,bbox.dy]];
RETURN[Poly.NewRec[[ll,ur]]];
};
Clipper.Push[clipper,StringArea[origin]];
state←Clipper.Test[clipper];
IF state.in THEN {
IF state.out THEN {
v: Vector.Vec←origin;
FOR i: CARDINAL IN[0..s.length) DO
v←TDrawChar[self,s[i],v,clipper]
ENDLOOP;
}
ELSE {
rx: INTEGER←RoundI[origin.x];
ry: INTEGER←RoundI[origin.y];
blt: Blt.Handle=t.blt;
FOR i: CARDINAL IN[0..s.length) DO
bbox: AltoFont.BBox;
rast: AltoFont.Rast;
AltoFont.Character[t.font,s[i],@bbox,@rast];
blt.sdx←rx-rast.x0; blt.sdy←ry-rast.y0;
Blt.Source[blt,rast.bca,rast.bmr];
Blt.SetBox[blt,rx+bbox.ox,ry+bbox.oy,bbox.dx,bbox.dy];
Blt.Rect[blt];
rx←rx+bbox.wx; ry←ry+bbox.wy;
ENDLOOP;
};
};
Clipper.Pop[clipper];
RETURN[Vector.Add[origin,[bbox.wx,-bbox.wy]]];
};

FDrawChar: PROC[self: Text.Handle, c: CHARACTER,
origin: Vector.Vec, clipper: Clipper.Handle]
RETURNS[Vector.Vec] = {
-- *** fix this
RETURN[origin];
};

FDrawString: PROC[self: Text.Handle, s: LONG STRING,
origin: Vector.Vec, clipper: Clipper.Handle]
RETURNS[Vector.Vec] = {
-- *** fix this
RETURN[origin];
};

TFree: PROC[selfPtr: LONG POINTER TO Text.Handle] = {
self: Text.Handle←selfPtr↑;
t: TDataRef←LOOPHOLE[self.data];
selfPtr↑←NIL;
Blt.Free[@t.blt];
AltoFont.Free[@t.font];
zone.FREE[@t];
zone.FREE[@self];
};


CApplyBaseTransform: PROC[self: Handle, mapper: Mapper.Handle] = {
d: DataRef=LOOPHOLE[self.data];
Mapper.Translate[mapper,[0,d.height]];
Mapper.Concat[mapper,[1,0,0,-1]];
};

CBoundary: PROC[self: Handle] RETURNS[Area.Handle] = {
d: DataRef=LOOPHOLE[self.data];
ll: Vector.Vec←[0,0];
ur: Vector.Vec←[d.width,d.height];
margin: Vector.Vec=[0.1,0.1];
ll←Vector.Add[ll,margin]; ur←Vector.Sub[ur,margin];
RETURN[Poly.NewRec[[ll,ur]]];
};

CFree: PROC[self: Handle] = {
d: DataRef←LOOPHOLE[self.data];
zone.FREE[@d]; zone.FREE[@self];
};

}.