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