--ContourMain.mesa
--Written by M.Stone
--Last changed by M.Stone July 14, 1982 12:14 pm
--Last changed by M.Plass October 14, 1982 2:59 pm
DIRECTORY
Rope,
Runtime,
Graphics,
GraphicsOps USING[NewAisImage],
TJaMGraphics USING[Painter],
AIS USING [OpenFile, FRef, WRef, OpenWindow,CloseFile, ReadSample, CloseWindow,Error],
CurveDefs,
Vector USING [Vec],
ConvertUnsafe,
Real,
RealFns,
Curve,
JaMFnsDefs;
ContourMain: PROGRAM IMPORTS CurveDefs, AIS, JaMFnsDefs, Graphics, TJaMGraphics, Real,
Runtime, ConvertUnsafe, GraphicsOps, Curve
EXPORTS CurveDefs =
BEGIN OPEN JaMFnsDefs, CurveDefs;
Vec: TYPE = Vector.Vec;
ais: AIS.FRef ← NIL;
window: AIS.WRef ← NIL;
aisname: Rope.ROPE;
allSLists,lastSList: SListHandle ← NIL;
allContours,lastContour: ContourHandle ← NIL;
OpenAIS: PROCEDURE = {
ENABLE AIS.Error =>{JaMFnsDefs.JaMExec["(AIS file error) .print"]; CONTINUE};
s: LONG STRING←[64];
PopString[s];
ais𡤊IS.OpenFile[s, FALSE];
window ← AIS.OpenWindow[ais];
aisname ← ConvertUnsafe.ToRope[s];
};
SetTValue: PROCEDURE = {tValue ← PopReal[]};
DrawAIS:PROCEDURE= {
Paint: PROC[dc: Graphics.Context] = {
imageRef: Graphics.ImageRef ← GraphicsOps.NewAisImage[aisname];
lx,rx,ty,by: REAL;
mark: Graphics.Mark ← Graphics.Save[dc];
[lx,by] ← AISToScreen[window.firstPixel,window.lastScan];
[rx,ty] ← AISToScreen[window.lastPixel,window.firstScan];
Graphics.Translate[dc,-lx,-by];
Graphics.ClipBox[dc,[lx,by,rx,ty]];
Graphics.DrawImage[dc,imageRef];
Graphics.Restore[dc,mark];
};
TJaMGraphics.Painter[Paint];
};
SetAISWindow:PROCEDURE= {
by,rx,ty,lx,temp: REAL;
crx,clx,cty,cby: CARDINAL;
by ← GetReal[];
rx ← GetReal[];
ty ← GetReal[];
lx ← GetReal[];
IF ty < by THEN {temp ← by; by ← ty; ty ← temp};
IF rx < lx THEN {temp ← rx; rx ← lx; lx ← temp};
[lx,by] ← ScreenToAIS[lx,by];
[rx,ty] ← ScreenToAIS[rx,ty];
cby ← Real.FixC[by];
cty ← Real.FixC[ty];
crx ← Real.FixC[rx];
clx ← Real.FixC[lx];
AIS.CloseWindow[window];
window ← AIS.OpenWindow[f: ais, firstScan: cty,lastScan: cby, firstPixel: clx, lastPixel: crx];
};
AISToScreen: PROC [x,y: REAL] RETURNS[nx,ny: REAL] ={
nx ← x; ny ← window.lastScan-y;
};
ScreenToAIS: PROC [x,y: REAL] RETURNS[nx,ny: REAL] ={
nx ← x; ny ← window.lastScan-y;
};
AnalyzeContour: PROCEDURE = {
count: INTEGER ← 0;
contour:ContourHandle;
cn: INTEGER ← PopInteger[];
countProc: PROC[c: ContourHandle] = {IF cn=count THEN contour ← c; count ← count+1};
ForAllContours[countProc];
IF contour#NIL THEN {
CurveDefs.AnalyzeContour[contour];
PushInteger[cn];
SetSamples[];
};
};
SetSamples: PROCEDURE = {
count: INTEGER ← 0;
contour:ContourHandle;
cn: INTEGER ← PopInteger[];
countProc: PROC[c: ContourHandle] = {IF cn=count THEN contour ← c; count ← count+1};
ForAllContours[countProc];
IF contour#NIL THEN {
sa: SampleHandle ← contour.sLists.samples;
Curve.StartSamples[Curve.defaultHandle, sa.xy.x,sa.xy.y];
FOR sa ← contour.sLists.samples.next, sa.next UNTIL sa=NIL DO
Curve.AddSample[Curve.defaultHandle, sa.xy.x,sa.xy.y];
ENDLOOP;
};
};
SetContours: PROCEDURE = {
fullContour: BOOLEAN ← FALSE;
SetContour: PROC[contour: ContourHandle] = {
sa: SampleHandle ← contour.sLists.samples;
IF fullContour THEN Curve.AddContour[Curve.defaultHandle];
Curve.StartSamples[Curve.defaultHandle, sa.xy.x,sa.xy.y];
FOR sa ← contour.sLists.samples.next, sa.next UNTIL sa=NIL DO
Curve.AddSample[Curve.defaultHandle, sa.xy.x,sa.xy.y];
ENDLOOP;
fullContour ← TRUE;
};
Curve.ResetContours[Curve.defaultHandle];
ForAllContours[SetContour];
Curve.NextContour[Curve.defaultHandle];
};
FreeContours: PROC = { allContours ← NIL};
Free: PROCEDURE = {
ENABLE AIS.Error =>{JaMFnsDefs.JaMExec["(AIS file error) .print"]; CONTINUE};
AIS.CloseWindow[window]; window ← NIL;
AIS.CloseFile[ais]; ais ← NIL;
};
LineCount: PROCEDURE = {
PushInteger[lineCount];
};
ContourCount: PROCEDURE = {
PushInteger[contourCount];
};
RMakeContours: PROCEDURE = {
MakeContours[];
DrawContours[];
};
DrawContours: PROCEDURE = {
Paint: PROC[dc: Graphics.Context] = {
drawContour: PROCEDURE[c: ContourHandle] = {
Graphics.MoveTo[path, 0, 0]; -- flush the old path.
EnterContour[path, c];
Graphics.DrawStroke[dc, path];
};
ForAllContours[drawContour];
};
path: Graphics.Path ← Graphics.NewPath[];
TJaMGraphics.Painter[Paint];
};
FillContours: PROCEDURE = {
Paint: PROC[dc: Graphics.Context] = {
fillContour: PROCEDURE[c: ContourHandle] = {
EnterContour[path, c];
};
ForAllContours[fillContour];
Graphics.DrawArea[dc, path];
};
path: Graphics.Path ← Graphics.NewPath[];
TJaMGraphics.Painter[Paint];
};
DrawSLists: PROCEDURE = {
ForAllSLists[DrawSList];
};
DrawSList: PROCEDURE[sl: SListHandle] = {
path: Graphics.Path ← Graphics.NewPath[];
Paint: PROC[dc: Graphics.Context] = {Graphics.DrawStroke[dc,path]};
Graphics.MoveTo[path, sl.samples.xy.x, sl.samples.xy.y];
LineToSamples[path,sl];
TJaMGraphics.Painter[Paint];
};
EnterContour: PROCEDURE[path: Graphics.Path, c: ContourHandle] = {
sl: SListHandle ← c.sLists;
Graphics.MoveTo[path, sl.samples.xy.x, sl.samples.xy.y, FALSE];
DO LineToSamples[path,sl]; IF sl=c.lastSList THEN EXIT ELSE sl ← sl.next; ENDLOOP;
};
LineToSamples: PROCEDURE[path:Graphics.Path, sl: SListHandle] = {
s: SampleHandle ← sl.samples.next;
DO
Graphics.LineTo[path, s.xy.x, s.xy.y];
IF s=sl.lastSample THEN EXIT ELSE s ← s.next;
ENDLOOP;
};
--the trajectory handling stuff
trajList,lastTraj: TrajHandle ← NIL;
AddTraj: PROC = {
traj: TrajHandle ← NIL ;-- CurrentTraj went away (MFP) Curve.CurrentTraj[];
IF traj=NIL THEN RETURN;
IF lastTraj=NIL THEN trajList ← lastTraj ← traj
ELSE {
lastTraj.next ← traj;
traj.prev ← lastTraj;
lastTraj ← lastTraj.next;
};
};
FreeTrajList: PROC = {trajList ← lastTraj ← NIL};
lineCount: INTEGER ← 0;
contourCount: INTEGER ← 0;
Outline: PROC = {
v1,v2,v3,v4,x,y: CARDINAL;
lineCount ← 0;
contourCount ← 0;
InitContours[];
FOR y IN [window.firstScan..window.lastScan) DO
IF JaMFnsDefs.GetJaMBreak[] THEN EXIT;
--this assumes the rd scan direction for ais files
FOR x IN [window.firstPixel..window.lastPixel) DO
v1 ← AIS.ReadSample[window,y,x];
v2 ← AIS.ReadSample[window,y,x+1];
v3 ← AIS.ReadSample[window,y+1,x+1];
v4 ← AIS.ReadSample[window,y+1,x];
ContourCell[v1,v2,v3,v4,x,y];
ENDLOOP;
ENDLOOP;
};
Trans: TYPE = RECORD[x,y,d: REAL, dir:{nt,dl,ld}];
--aisX and aisY relative to current AIS window
ContourCell: PROC[v1,v2,v3,v4:CARDINAL, aisX,aisY:REAL] = {
edgePts: ARRAY [0..3] OF Trans;
i,ldCount,dlCount,index,move: CARDINAL;
FindLD: PROC [start: CARDINAL] RETURNS[CARDINAL] = {
FOR k: CARDINAL IN [start..3] DO
IF edgePts[k].dir=ld THEN RETURN[k];
ENDLOOP;
ERROR;
};
FindDL: PROC [start: CARDINAL] RETURNS[CARDINAL] = {
FOR k: CARDINAL IN [start..3] DO
IF edgePts[k].dir=dl THEN RETURN[k]; ENDLOOP;
FOR k: CARDINAL IN [0..start) DO
IF edgePts[k].dir=dl THEN RETURN[k]; ENDLOOP;
ERROR;
};
-- v1 v2 clockwise
-- v4 v3
edgePts[0] ← ContourEdge[v1,v2];
edgePts[0].x ← aisX+edgePts[0].d; edgePts[0].y ← aisY;
edgePts[1] ← ContourEdge[v2,v3];
edgePts[1].x ← aisX+1; edgePts[1].y ← aisY+edgePts[1].d;
--switch the order here for numerical reasons. Must then invert the dir
edgePts[2] ← ContourEdge[v4,v3];
edgePts[2].x ← aisX+edgePts[2].d; edgePts[2].y ← aisY+1;
edgePts[2].dir ←
(SELECT edgePts[2].dir FROM ld => dl, dl => ld, ENDCASE => nt);
edgePts[3] ← ContourEdge[v1,v4];
edgePts[3].x ← aisX; edgePts[3].y ← aisY+edgePts[3].d;
edgePts[3].dir ←
(SELECT edgePts[3].dir FROM ld => dl, dl => ld, ENDCASE => nt);
ldCount ← dlCount ← 0;
FOR i IN [0..3] DO
SELECT edgePts[i].dir FROM
dl => dlCount ← dlCount+1;
ld => ldCount ← ldCount+1;
ENDCASE;
ENDLOOP;
IF dlCount#ldCount THEN Runtime.CallDebugger["odd transitions"];
IF dlCount>2 THEN Runtime.CallDebugger["too many transitions"];
IF dlCount=0 THEN RETURN; --no transitions
--ok, now have transitions. Need to connect ld to dl
--this prefers solid dark areas
move ← index ← FindLD[0];
index ← FindDL[index];
NewSample[edgePts[move].x,edgePts[move].y,edgePts[index].x,edgePts[index].y];
lineCount ← lineCount+1;
IF dlCount=2 THEN BEGIN
move ← index ← FindLD[index];
index ← FindDL[index];
NewSample[edgePts[move].x,edgePts[move].y,
edgePts[index].x,edgePts[index].y];
lineCount ← lineCount+1;
END;
};
tValue: REAL ← 128.5;
nPoints: INTEGER ← 4;
ContourEdge: PROC[v0,v1: REAL] RETURNS[trans: Trans] = {
trans ← [x:0, y:0, d:0, dir:nt];
IF v0<tValue AND v1<tValue THEN RETURN;
IF v0>tValue AND v1>tValue THEN RETURN;
trans.d ← (v0-tValue)/(v0-v1);
IF v0<tValue THEN trans.dir ← ld ELSE trans.dir ← dl;
};
InitContours: PROC = {
allSLists ← lastSList ← NIL;
allContours ← lastContour ← NIL;
};
--There exist a set of SLists Connect these edges into closed contours
--holes must have opposite wrap than areas.
MakeContours: PROC = {
contour: ContourHandle ← NewContour[FirstSList[]];
found: BOOLEAN ← FALSE;
close: PROC[c: ContourHandle] = {
IF c.sLists.samples.xy=c.sLists.lastSample.xy THEN {
c.sLists.lastSample ← c.sLists.lastSample.prev;
c.sLists.closed ← TRUE;
}
};
find: PROC[sl: SListHandle] = {
IF sl.samples.xy=contour.lastSList.lastSample.xy THEN {
AddSamplesToContour[contour,sl];
found ← TRUE};
};
UNTIL FirstSList[]=NIL DO
found ← FALSE;
ForAllSLists[find]; --finds pieces for contour
IF ~found THEN contour ← NewContour[FirstSList[]];
ENDLOOP;
ForAllContours[close];
};
--list manipulating routines
--these are for the stand alone set of SLists which are created as the image is outlined
NewSample: PROC[x0,y0,x1,y1: REAL] = {OPEN Real;
Paint: PROC[dc: Graphics.Context] = {
[p0.x,p0.y] ← AISToScreen[x0,y0];
[p1.x,p1.y] ← AISToScreen[x1,y1];
Graphics.SetCP[dc,p0.x,p0.y];
Graphics.DrawTo[dc,p1.x,p1.y];
};
p0,p1: Vec;
slist: SListHandle ← NIL;
sample: SampleHandle ← NEW[Sample];
found: BOOLEAN ← FALSE;
find: PROC[sl: SListHandle] = {
IF found THEN RETURN;
IF sl.lastSample.xy=p0 THEN
{sample.xy ← p1; AddSample[sl,sample,TRUE]; found ← TRUE} --add to tail of sl
ELSE IF sl.samples.xy=p1 THEN
{AddSample[sl,sample,FALSE]; found ← TRUE}; --add to head of sl
};
TJaMGraphics.Painter[Paint];
sample.xy ← p0;
ForAllSLists[find];
IF ~found THEN {
slist ← NewSList[sample];
sample ← NEW[Sample];
sample.xy ← p1;
AddSample[slist,sample]};
};
NewSList: PROC[sample: SampleHandle] RETURNS[SListHandle] = {
slist: SListHandle ← NEW[SList];
slist.samples ← slist.lastSample ← sample;
IF allSLists=NIL THEN allSLists ← lastSList ← slist
ELSE { slist.prev ← lastSList; slist.next ← NIL;
lastSList.next ← slist; lastSList ← slist};
RETURN[slist];
};
--atTail determines which end of the slist the sample will be added
AddSample: PROC [sl: SListHandle, sample: SampleHandle,atTail: BOOLEAN ← TRUE]= {
IF atTail THEN {
sample.prev ← sl.lastSample; sample.next ← NIL;
sl.lastSample.next ← sample; sl.lastSample ← sample}
ELSE {
sample.next ← sl.samples; sample.prev ← NIL;
sl.samples.prev ← sample; sl.samples ← sample};
};
FirstSList: PROC RETURNS[SListHandle] = {
RETURN[allSLists];
};
ForAllSLists: PROC[proc:PROC[sl: SListHandle]] = {
ptr: SListHandle ← allSLists;
next: SListHandle ← NIL;
UNTIL ptr=NIL DO next ← ptr.next; proc[ptr]; ptr ← next; ENDLOOP;
};
RemoveSList: PROC [sl: SListHandle]= {
IF sl.next#NIL THEN sl.next.prev ← sl.prev;
IF sl.prev#NIL THEN sl.prev.next ← sl.next;
IF sl=allSLists THEN allSLists ← sl.next;
IF sl=lastSList THEN lastSList ← sl.prev;
sl.next ← sl.prev ← NIL;
};
--these are for the stand alone set of contours created from the SLists by MakeContours
NewContour: PROC[sl: SListHandle] RETURNS[ContourHandle ← NIL] = {
IF sl # NIL THEN {
contour: ContourHandle ← NEW[Contour];
RemoveSList[sl];
contour.sLists ← contour.lastSList ← sl;
AddContour[contour];
RETURN[contour];
};
};
AddContour: PROC[contour: ContourHandle]= {
IF allContours=NIL THEN allContours ← lastContour ← contour
ELSE { contour.prev ← lastContour; contour.next ← NIL;
lastContour.next ← contour; lastContour ← contour};
};
DeleteContour: PROC [contour: ContourHandle]= {
IF contour.next#NIL THEN contour.next.prev ← contour.prev;
IF contour.prev#NIL THEN contour.prev.next ← contour.next;
contour.next ← contour.prev ← NIL;
};
AddSamplesToContour: PROC [contour: ContourHandle, sl: SListHandle]= {
c: SListHandle ← contour.sLists;
RemoveSList[sl];
c.lastSample ← c.lastSample.prev; --skip duplicate point
IF c.lastSample.next#NIL
THEN c.lastSample.next ← sl.samples
ELSE c.samples ← sl.samples; --single sample sLists
sl.samples.prev ← c.lastSample;
c.lastSample ← sl.lastSample;
};
ForAllContours: PROC[proc:PROC[c: ContourHandle]] = {
ptr: ContourHandle ← allContours;
next: ContourHandle ← NIL;
UNTIL ptr=NIL DO next ← ptr.next; proc[ptr]; ptr ← next; ENDLOOP;
};
--these are the calls to the output routines to write out the data
OpenOutputFile: PROC = {
s: STRING ← [40];
PopString[s];
CurveDefs.OpenFile[ConvertUnsafe.ToRope[s]];
};
CloseOutputFile: PROC = {
CurveDefs.CloseFile[];
};
RWriteContours: PROC = {
s: REAL;
write: PROC[c: ContourHandle] = {CurveDefs.WriteContour[c,1/s,[-minY,-minX]]};
minX ← 10000; minY ← 10000;
maxX ← 0; maxY ← 0;
ForAllContours[SetMinMax];
s ← maxY-minY;
IF maxX-minX > s THEN s ← maxX-minX;
ForAllContours[write];
};
RWriteTrajs: PROC = {
FOR traj: TrajHandle ← trajList, traj.next UNTIL traj=NIL DO CurveDefs.WriteTraj[traj,TRUE]; ENDLOOP;
};
minX,maxX,minY,maxY: REAL ← 0;
SetMinMax: PROC [c: ContourHandle] = {
compare: PROC [sa: SampleHandle] = {
IF sa.xy.x>maxX THEN maxX ← sa.xy.x;
IF sa.xy.y>maxY THEN maxY ← sa.xy.y;
IF sa.xy.x<minX THEN minX ← sa.xy.x;
IF sa.xy.y<minY THEN minY ← sa.xy.y;
};
ForAllSamples[c,compare];
};
ForAllSamples: PROC [c: ContourHandle,proc: PROC[sa: SampleHandle]] = {
sl: SListHandle ← c.sLists;
sa: SampleHandle ← NIL;
UNTIL sl=NIL DO
sa ← sl.samples;
UNTIL sa=NIL DO
proc[sa];
IF sa=sl.lastSample THEN EXIT ELSE sa ← sa.next;
ENDLOOP;
IF sl=c.lastSList THEN EXIT ELSE sl ← sl.next;
ENDLOOP
};
Register[".setupais"L,OpenAIS];
Register[".freeais"L,Free];
Register[".tvalue"L,SetTValue];
Register[".outline"L,Outline];
Register[".drawmyais"L,DrawAIS];
--Register[".window"L,SetAISWindow];
--Register[".linecount"L,LineCount];
--Register[".contourcount"L,ContourCount];
Register[".makecontours"L,RMakeContours];
--Register[".freecontours"L,FreeContours];
--Register[".drawcontours"L,DrawContours];
--Register[".fillcontours"L,FillContours];
--Register[".drawslists"L,DrawSLists];
Register[".analyzecontour"L,AnalyzeContour];
--Register[".writecontours"L,RWriteContours];
--Register[".writetrajs"L,RWriteTrajs];
--Register[".outputfile"L,OpenOutputFile];
--Register[".closeout"L,CloseOutputFile];
Register[".addtraj"L,AddTraj];
Register[".freetrajlist"L,FreeTrajList];
Register[".setsa"L,SetSamples];
Register[".setcontours"L,SetContours];
END.
M.Plass August 13, 1982 10:38 am: Added SetContours.