-- TACallig.mesa, for drawing thick lines for Tioga Artwork.
-- liberally borrowed from Callig.mesa
-- Rick Beach, June 30, 1982 10:25 pm
-- Maureen Stone October 22, 1982 2:54 pm

DIRECTORY
 Complex, Cubic, Graphics, GraphicsOps, GraphicsBasic, JaMFnsDefs, TJaMGraphics, PolygonPen, Real, RealFns, Rope, SirPress, Vector, CGPath;

TACallig: PROGRAM
 IMPORTS Complex, Cubic, Graphics, GraphicsOps, JaMFnsDefs, TJaMGraphics, PolygonPen, Real, RealFns, Rope, SirPress, CGPath = {

ROPE: TYPE = Rope.ROPE;
Vec: TYPE = GraphicsBasic.Vec;

pi: REAL = 3.14159625;
RoundPenCacheRef: TYPE = REF RoundPenCacheRec;
RoundPenCacheRec: TYPE = RECORD [
 next: RoundPenCacheRef,
 numCorners: CARDINAL,
 multiplier: Vec,
 record: PolygonPen.Pen];
pens: RoundPenCacheRef ← NIL;

curLoc: Vec;
pen: PolygonPen.Pen;

shadowLoc: Vec;
shadowPen: PolygonPen.Pen;

p: SirPress.PressHandle ← NIL;
press: BOOLEAN ← FALSE;

path: Graphics.Path ← Graphics.NewPath[];
penPath: Graphics.Path ← Graphics.NewPath[];

PaintPath: PROC [context: Graphics.Context] = {Graphics.DrawArea[context,path]};
PaintPenPath: PROC [context: Graphics.Context] = {Graphics.DrawArea[context,penPath]};

Mica: PROCEDURE[pt:REAL] RETURNS [LONG INTEGER] = INLINE {
 RETURN[Real.RoundLI[pt*2540.0/72.0]]};

Transform: PROCEDURE[u: Vec] RETURNS[v: Vec] = {
 paint: PROC[context: Graphics.Context] = {
  [v.x, v.y] ← GraphicsOps.UserToDevice[context, u.x, u.y, FALSE]};
 TJaMGraphics.Painter[paint];
 };

JBeginObject: PROC = {
 IF press THEN SirPress.StartOutline[p]
 ELSE Graphics.FlushPath[path];
 };

JEndObject: PROC = {
 IF press THEN SirPress.EndOutline[p]
 ELSE {TJaMGraphics.Painter[PaintPath]; Graphics.FlushPath[path]};
 };

JMoveTo: PROC = {t: Vec ← PopVec[]; Graphics.MoveTo[path, t.x, t.y]};

JLineTo: PROC = {t: Vec ← PopVec[]; Graphics.LineTo[path, t.x, t.y]};

JCurveTo: PROC = {
 b3:Vec ← PopVec[];
 b2:Vec ← PopVec[];
 b1: Vec ← PopVec[];
 Graphics.CurveTo[path,b1.x,b1.y, b2.x,b2.y, b3.x,b3.y]};

JDrawPath: PROC = {
 width: REAL ← JaMFnsDefs.PopReal[];
 IF width <= 0 AND ~press THEN
  SimplePath[]
 ELSE {
  pen ← RoundPen[width];
  JOutlinePath[]};
 };

SimplePath: PROC = {TJaMGraphics.Painter[PaintPath]};

JOutlinePath: PROC = {
 moveTo: SAFE PROC[z0: Vec] = CHECKED {curLoc ← z0};
 lineTo: SAFE PROC[z1: Vec] = TRUSTED {
  PolygonPen.Line[pen, curLoc, z1, PenMoveTo, PenLineTo, PenCurveTo];
  curLoc ← z1};
 curveTo: SAFE PROC[b1,b2,b3: Vec] = TRUSTED {
  PolygonPen.Stroke[pen, [curLoc, b1, b2, b3], PenMoveTo, PenLineTo, PenCurveTo];
  curLoc ← b3};
 IF press THEN SirPress.StartOutline[p];
 CGPath.Generate[path,moveTo,lineTo,curveTo];
 IF press THEN SirPress.EndOutline[p]
 ELSE TJaMGraphics.Painter[PaintPenPath];
 Graphics.FlushPath[path];
 Graphics.FlushPath[penPath];
 };

PenMoveTo: PolygonPen.MoveToProc = {
 IF press THEN {
  tz0: Vec = Transform[z0];
  SirPress.EndOutline[p];
  SirPress.StartOutline[p];
  SirPress.PutMoveTo[p,Mica[tz0.x],Mica[tz0.y]]}
 ELSE {
  TJaMGraphics.Painter[PaintPenPath];
  Graphics.MoveTo[penPath,z0.x,z0.y]};
 curLoc ← z0;
 };

PenLineTo: PolygonPen.LineToProc = {
 IF press THEN {tz1: Vec = Transform[z1]; SirPress.PutDrawTo[p,Mica[tz1.x],Mica[tz1.y]]}
 ELSE Graphics.LineTo[penPath,z1.x,z1.y];
 curLoc ← z1;
 };

PenCurveTo: PolygonPen.CurveToProc = {
 IF press THEN {
  tcurLoc: Vec = Transform[curLoc];
  tz1: Vec = Transform[z1];
  tz2: Vec = Transform[z2];
  tz3: Vec = Transform[z3];
  c: Cubic.Coeffs ← Cubic.BezierToCoeffs[[tcurLoc,tz1,tz2,tz3]];
  SirPress.PutCubic[p,
   Mica[c.c1.x], Mica[c.c1.y],
   Mica[c.c2.x], Mica[c.c2.y],
   Mica[c.c3.x],Mica[c.c3.y]]}
 ELSE Graphics.CurveTo[penPath,z1.x,z1.y,z2.x,z2.y,z3.x,z3.y];
 curLoc ← z3;
 };

JShadowPen: PROC = {
 shadowPen ← pen};

JShadowPath: PROC = {
 moveTo: SAFE PROC[z0: Vec] = CHECKED {curLoc ← z0};
 lineTo: SAFE PROC[z1: Vec] = TRUSTED {
  PolygonPen.Line[pen, curLoc, z1, ShadowMoveTo, ShadowLineTo, ShadowCurveTo];
  curLoc ← z1};
 curveTo: SAFE PROC[b1,b2,b3: Vec] = TRUSTED {
  PolygonPen.Stroke[pen, [curLoc, b1, b2, b3], ShadowMoveTo, ShadowLineTo, ShadowCurveTo];
  curLoc ← b3};
 IF press THEN SirPress.StartOutline[p];
 CGPath.Generate[path,moveTo,lineTo,curveTo];
 IF press THEN SirPress.EndOutline[p]
 ELSE TJaMGraphics.Painter[PaintPenPath];
 Graphics.FlushPath[path];
 Graphics.FlushPath[penPath];
 };

ShadowMoveTo: PolygonPen.MoveToProc = {
 shadowLoc ← z0};

ShadowLineTo: PolygonPen.LineToProc = {
 PolygonPen.Line[shadowPen, shadowLoc, z1, PenMoveTo, PenLineTo, PenCurveTo];
 shadowLoc ← z1};

ShadowCurveTo: PolygonPen.CurveToProc = {
 PolygonPen.Stroke[shadowPen, [shadowLoc, z1, z2, z3], PenMoveTo, PenLineTo, PenCurveTo];
 shadowLoc ← z3};

JDrawArea: PROC = {
 IF press THEN {
  moveTo: SAFE PROC[z0: Vec] = TRUSTED {
    tz0: Vec = Transform[z0]; SirPress.PutMoveTo[p, Mica[tz0.x], Mica[tz0.y]];
    curLoc ← z0};
  lineTo: SAFE PROC[z1: Vec] = TRUSTED {
    tz1: Vec = Transform[z1]; SirPress.PutDrawTo[p, Mica[tz1.x], Mica[tz1.y]];
    curLoc ← z1};
  curveTo: SAFE PROC[b1,b2,b3: Vec] = TRUSTED {
   tcurLoc: Vec = Transform[curLoc];
   tb1: Vec = Transform[b1];
   tb2: Vec = Transform[b2];
   tb3: Vec = Transform[b3];
   c: Cubic.Coeffs ← Cubic.BezierToCoeffs[[tcurLoc, tb1, tb2, tb3]];
   SirPress.PutCubic[p,
     Mica[c.c1.x], Mica[c.c1.y], Mica[c.c2.x], Mica[c.c2.y], Mica[c.c3.x], Mica[c.c3.y]];
   curLoc ← b3};
  SirPress.StartOutline[p];
  CGPath.Generate[path,moveTo,lineTo,curveTo];
  SirPress.EndOutline[p];
  }
 ELSE {
  TJaMGraphics.Painter[PaintPath];
  Graphics.FlushPath[path];
  };
 };

PopVec: PROCEDURE RETURNS [v:Vec] = {
 v.y ← JaMFnsDefs.GetReal[];
 v.x ← JaMFnsDefs.GetReal[]};

PopText: PROCEDURE RETURNS [t: REF TEXT] = {
 t←NEW[TEXT[128]];
 JaMFnsDefs.PopString[LOOPHOLE[t]];
 };

UseThisPressHandle: PUBLIC PROCEDURE[pressHandle: SirPress.PressHandle] = {
 p ← pressHandle;
 press ← p#NIL};

ForgetThePressHandle: PUBLIC PROCEDURE = {
 p ← NIL;
 press ← FALSE};

JOpenPress: PROC = {
 name: ROPE ← Rope.FromRefText[PopText[]];
 p ← SirPress.NewPressHandle[FixFileName[name, ".Press"]];
 press ← p#NIL};

FixFileName: PROC [oldname, extension: ROPE] RETURNS [newname:ROPE] = {
 dotPosition: INTEGER ← Rope.Find[oldname, "."];
 IF dotPosition < 0 THEN
  newname ← Rope.Cat[oldname, extension]
 ELSE
  newname ← Rope.Cat[Rope.Substr[oldname, 0, dotPosition], extension];
 };

JClosePress: PROC = {
 IF press THEN SirPress.ClosePress[p];
 p ← NIL;
 press ← FALSE};

JNewPage: PROC = {
 IF press THEN SirPress.WritePage[p]};

JPen: PROC = {
 n: NAT ← JaMFnsDefs.PopInteger[];
 pen ← NEW[PolygonPen.PenRec[n]];
 FOR i:NAT DECREASING IN [0..n) DO pen[i] ← PopVec[]; ENDLOOP;
 };

JRoundPen: PROC = {
 pen ← RoundPen[JaMFnsDefs.PopReal[]]};

-- create a regular polygon of n sides, with n > pi*sqrt(w/2)
RoundPen: PROC[width: REAL] RETURNS[PolygonPen.Pen] = {
 halfWidth: REAL = MAX[.5, width/2];
 nCorners: CARDINAL ← Real.RoundC[0.5+(pi*RealFns.SqRt[halfWidth])];
 r: RoundPenCacheRef ← pens;
 i: CARDINAL;
 WHILE r#NIL DO
  IF r.numCorners=nCorners THEN RETURN[r.record];
  r ← r.next;
  ENDLOOP;
 pens ← NEW[RoundPenCacheRec ← [pens, nCorners, Complex.Exp[[0,2*pi/nCorners]], NEW[PolygonPen.PenRec[nCorners]]] ];
 pens.record[0] ← [halfWidth, 0];
 FOR i IN [1 .. nCorners) DO
  pens.record[i] ← Complex.Mul[pens.record[i-1], pens.multiplier];
  ENDLOOP;
 RETURN[pens.record];
 };

JRectangularPen: PROC = {
 slant: REAL ← JaMFnsDefs.PopReal[];
 height: REAL ← JaMFnsDefs.PopReal[];
 width: REAL ← JaMFnsDefs.PopReal[];
 pen ← RectangularPen[width, height, slant]};

RectangularPen: PROC[width, height, slant: REAL] RETURNS[pen: PolygonPen.Pen] = {
 halfWidth: REAL ← MAX[0.5, width/2];
 halfHeight: REAL ← MAX[0.5, height/2];
 rotate: Vec = Complex.Exp[[0,-(slant*pi/180)]];
 pen ← NEW[PolygonPen.PenRec[4]];
 pen[0] ← Complex.Mul[[halfWidth, halfHeight], rotate];
 pen[1] ← Complex.Mul[[halfWidth, -halfHeight], rotate];
 pen[2] ← Complex.Mul[[-halfWidth, -halfHeight], rotate];
 pen[3] ← Complex.Mul[[-halfWidth, halfHeight], rotate];
 RETURN[pen];
 };

JItalicPen: PROC = {
 slant: REAL ← JaMFnsDefs.PopReal[];
 length: REAL ← JaMFnsDefs.PopReal[];
 pen ← ItalicPen[length, slant]};

ItalicPen: PROC[length, slant: REAL] RETURNS[pen: PolygonPen.Pen] = {
 pen ← NEW[PolygonPen.PenRec[2]];
 pen[0] ← [0,0];
 pen[1] ← Complex.Mul[[0, -MAX[1.0,length]], Complex.Exp[[0,-(slant*pi/180)]]];
 RETURN[pen];
 };

JEllipticalPen: PROC = {
 slant: REAL ← JaMFnsDefs.PopReal[];
 height: REAL ← JaMFnsDefs.PopReal[];
 width: REAL ← JaMFnsDefs.PopReal[];
 pen ← EllipticalPen[width, height, slant]};

EllipticalPen: PROC[width, height, slant: REAL] RETURNS[pen: PolygonPen.Pen] = {
 a: REAL = MAX[0.5, width/2];
 b: REAL = MAX[0.5, height/2];
 nCorners: CARDINAL = Real.RoundC[0.5+(pi*RealFns.SqRt[2*MIN[a,b]])];
 theta: REAL = 2*pi/nCorners;
 cosTheta: REAL = RealFns.Cos[theta];
 sinTheta: REAL = RealFns.Sin[theta];
 cosSlant: REAL = RealFns.CosDeg[slant];
 sinSlant: REAL = RealFns.SinDeg[slant];
 cosAccum: REAL ← 1;
 sinAccum: REAL ← 0;
 x,y,t: REAL;
 pen ← NEW[PolygonPen.PenRec[nCorners]];
 FOR i: CARDINAL IN [0 .. nCorners) DO
  x ← a*cosAccum;
  y ← b*sinAccum;
  pen[i] ← [x*cosSlant-y*sinSlant, x*sinSlant+y*cosSlant];
  t ← cosAccum*cosTheta-sinAccum*sinTheta;
  sinAccum ← sinAccum*cosTheta+cosAccum*sinTheta;
  cosAccum ← t;
  ENDLOOP;
 RETURN[pen];
 };

JDrawDot: PROC = {
 point: Vec ← PopVec[];
 IF press THEN SirPress.StartOutline[p];
 PolygonPen.Dot[pen,point,PenMoveTo,PenLineTo,PenCurveTo];
 IF press THEN SirPress.EndOutline[p]
 ELSE {TJaMGraphics.Painter[PaintPath]; Graphics.FlushPath[path]};
 };

JDrawLine: PROC = {
 point: Vec ← PopVec[];
 t: Vec ← PopVec[];
 s: Vec ← PopVec[];
 IF press THEN SirPress.StartOutline[p];
 PolygonPen.Line[pen,s,t,PenMoveTo,PenLineTo,PenCurveTo];
 IF press THEN SirPress.EndOutline[p]
 ELSE {TJaMGraphics.Painter[PaintPath]; Graphics.FlushPath[path]};
 };

JDrawBezier: PROC = {
 b3: Vec ← PopVec[];
 b2: Vec ← PopVec[];
 b1: Vec ← PopVec[];
 b0: Vec ← PopVec[];
 IF press THEN SirPress.StartOutline[p];
 PolygonPen.Stroke[pen,[b0,b1,b2,b3],PenMoveTo,PenLineTo,PenCurveTo];
 IF press THEN SirPress.EndOutline[p]
 ELSE {TJaMGraphics.Painter[PaintPath]; Graphics.FlushPath[path]};
 };

JDrawText: PROC = {
 paint: PROC [context: Graphics.Context] = {
  Graphics.SetCP[context,loc.x,loc.y];
  Graphics.DrawRope[self: context, rope: LOOPHOLE[s], font: font];
  };
 s: REF TEXT ← PopText[];
 loc: Vec ← PopVec[];
 IF press THEN {
  tloc: Vec = Transform[loc]; SirPress.PutText[p,LOOPHOLE[s],Mica[tloc.x],Mica[tloc.y]]}
 ELSE TJaMGraphics.Painter[paint];
 };

font: Graphics.FontRef ← NIL;
JSetFont: PROC = {
 fontName: ROPE ← Rope.FromRefText[PopText[]];
 IF press THEN {
  len: INTEGER ← Rope.Length[fontName]-1;
  family: ROPE;
  face, size: INTEGER ← 0;
  units: INTEGER ← 1;
  DO SELECT Rope.Fetch[fontName, len] FROM
   'B => {face ← face + 1; len ← len - 1};
   'I => {face ← face + 2; len ← len - 1};
   ENDCASE => EXIT;
   ENDLOOP;
  WHILE Rope.Digit[Rope.Fetch[fontName, len]] DO
   size ← size+(Rope.Fetch[fontName, len]-'0)*units;
   len ← len-1;
   units ← units*10;
   ENDLOOP;
  family ← Rope.Substr[fontName, 0, len+1];
  SirPress.SetFont[p,LOOPHOLE[family],size,face]}
 ELSE font ← Graphics.MakeFont[fontName];
 };

JPressHue: PROC = {
 IF press THEN SirPress.SetHue[p,JaMFnsDefs.PopInteger[]]};

JPressSaturation: PROC = {
 IF press THEN SirPress.SetSaturation[p,JaMFnsDefs.PopInteger[]]};

JPressBrightness: PROC = {
 IF press THEN SirPress.SetBrightness[p,JaMFnsDefs.PopInteger[]]};

JPressHSB: PROC = {
 IF press THEN {
  SirPress.SetBrightness[p,JaMFnsDefs.PopInteger[]];
  SirPress.SetSaturation[p,JaMFnsDefs.PopInteger[]];
  SirPress.SetHue[p,JaMFnsDefs.PopInteger[]]};
 };

JaMFnsDefs.Register[".openpress"L,JOpenPress]; -- filename .openpress
JaMFnsDefs.Register[".closepress"L,JClosePress]; -- .closepress
JaMFnsDefs.Register[".pressnewpage"L,JNewPage]; -- .pressnewpage
JaMFnsDefs.Register[".beginpressobject"L,JBeginObject]; -- .beginpressobject
JaMFnsDefs.Register[".endpressobject"L,JEndObject]; -- .endpressobject
JaMFnsDefs.Register[".calligmoveto"L,JMoveTo]; -- x y .calligmoveto
JaMFnsDefs.Register[".calliglineto"L,JLineTo]; -- x y .calliglineto
JaMFnsDefs.Register[".calligcurveto"L,JCurveTo]; -- b1.x b1.y b2.x b2.y b3.x b3.y .calligcurveto
JaMFnsDefs.Register[".calligdrawdot"L,JDrawDot]; -- x y .calligdrawdot
JaMFnsDefs.Register[".calligdrawline"L,JDrawLine]; -- sx sy tx ty .calligdrawline
JaMFnsDefs.Register[".calligdrawbezier"L,JDrawBezier]; -- b0.x b0.y b1.x b1.y b2.x b2.y b3.x b3.y .calligdrawbezier
JaMFnsDefs.Register[".calligdrawpath"L,JDrawPath]; -- width .calligdrawpath
JaMFnsDefs.Register[".calligoutlinepath"L,JOutlinePath]; -- .calligdrawpath, assumes pen
JaMFnsDefs.Register[".calligdrawarea"L,JDrawArea]; -- .calligdrawarea
JaMFnsDefs.Register[".calligpen"L,JPen]; -- x1 y1 . . . xn yn n .calligpen
JaMFnsDefs.Register[".calligroundpen"L,JRoundPen]; -- diameter .calligroundpen
JaMFnsDefs.Register[".calligrectangularpen"L,JRectangularPen]; -- width height slant .calligrectangularpen
JaMFnsDefs.Register[".calligitalicpen"L,JItalicPen]; -- length slant .calligitalicpen
JaMFnsDefs.Register[".calligellipticalpen"L,JEllipticalPen]; -- width height slant .calligellipticalpen
JaMFnsDefs.Register[".presshue"L,JPressHue]; -- hue[0-255] .presshue
JaMFnsDefs.Register[".presssaturation"L,JPressSaturation]; -- saturation[0-255] .presssaturation
JaMFnsDefs.Register[".pressbrightness"L,JPressBrightness]; -- brightness[0-255] .pressbrightness 
JaMFnsDefs.Register[".presshsb"L,JPressHSB]; -- hue[0-255] saturation[0-255] brightness[0-255] .presshsb 
JaMFnsDefs.Register[".calligtext"L,JDrawText]; -- string .calligtext
JaMFnsDefs.Register[".presssetfont"L,JSetFont]; -- fontname .presssetfont

JaMFnsDefs.Register[".calligshadowpen"L,JShadowPen]; -- some-pen-definition .calligshadowpen
JaMFnsDefs.Register[".calligshadowpath"L,JShadowPath]; -- .calligshadowpath, assumes shadow pen

pen ← NEW[PolygonPen.PenRec[2]];
pen[0] ← [-2,-2];
pen[1] ← [2,2];

}.