(Fit.JaM) =
(April 7, 1983 3:36 pm) =
(user) .dup .where {.pop .pop}{256 .dict .def}.ifelse .cvx .exec
user .begin

(/run){(Running ).print .dup .print .run (.)=}.cvx .def
(/loadbcd){(Loading ).print .dup .print .loadbcd (.)=}.cvx .def
(util.jam)/run
(errordefs.jam)/run
(Graphics.jam)/run
(Fit.bcd)/loadbcd

(startup) (gets things started) {((/ivy/plass/hacks/cmr30.ac) FitFont 0 128 FitACRange (will fit a whole font and append the results to curve.log)) =
}/xdef

(gs)
(gets the samples for the Garamond 'G')
(155.5 .tvalue (g-g.ais) .setupais .outline .makecontours 0 .setslen 0 .setsa 8 0 scalecontours -130 -130 translatecontours)/xdef

(logContours)
(takes a name and logs the contours from ContourImpl)
(.openlogfile .true .setlog (count) .countContours .def
	0 count (.dup .drawContour 1 .add).cvx .rept
	.closelogfile
	)/xdef

(GetSDSamples)
(gets the samples for the specified timesroman letter)
(noSD {(/indigo/pressfonts/timesroman-mrr.sd) .opensd}/if (noSD) .false .store 1 .setmaxl .setupsdcontour 0 .setslen .sdsetcontours 6 scale)/xdef
(noSD) .true .store

(ds)
(draws the samples)
(.drawsa)/xdef

(dss)
(draws all contours)
{.countcon {ds .nextcon}.cvx .rept}/xdef

(ms)
(marks the samples)
(0.001 .setmarksize .true .setfat .marksa)/xdef

(mss)
(marks all contours)
{.countcon {ms .nextcon}.cvx .rept}/xdef

(dc)
(draws the curve)
(.drawli)/xdef

(dcs)
(draws all curves)
{.countcon {dc .nextcon}.cvx .rept}/xdef

(mc)
(marks the joints along the curve)
(2 .setmarksize .false .setfat .markli)/xdef

(mcs)
(marks the joints along the curves)
{2 .setmarksize .false .setfat .countcon {.markli .nextcon}.cvx .rept}/xdef

(mn)
(marks the nodes with the normal lines)
(2 .setmarksize .marknodes)/xdef

(mns)
(marks all nodes with the normal lines)
(2 .setmarksize .countcon {.marknodes .nextcon}.cvx .rept)/xdef

(settangents)
(Set the tangents for sketched samples)
(4 .01 10 .settangents mn)/xdef

(grow)
(Grow a spline for sketched samples)
(.5 15 .grow cvtempstring .print ( knots) =)/xdef

(getbezierpoints) ((Touch four Bezier control points).print
.touch dot 2 .copy .setcp .touch 2 .copy .drawto .touch 2 .copy .drawto .touch 2 .copy .drawto).cvx .def
(cub) (.lsamples .lunit .lcubicbasis .lsolve .lresults).cvx .def
(cubpiece) (.lsamples .lunit .lcubicpiecebasis .lsolve .lresults).cvx .def
(par) (.lsamples .lunit .lparabolabasis .lsolve .lresults).cvx .def
(cir) (.lsamples .langle .lcirclebasis .lsolve .lresults).cvx .def
(ell) (.lsamples .langle .lellipsebasis .lsolve .lresults).cvx .def
(smc) (.lsamples .larclen .lsmoothbasis .lsolve .lresults).cvx .def
(bsc) (.lsamples .larclen .lbsplinebasis .lsolve .lresults).cvx .def
(pointslopecurve) (.lsamples .larclen .lpointslope 2 .lfree 4 .lfree .lsolve .lresults).cvx .def
(psc) (getbezierpoints pointslopecurve).cvx .def
(ic) ((improvecurve).cvx .rept).cvx .def
(icf) ((improvecurvefast).cvx .rept).cvx .def
(improvecurve) (.ladjust (Max t change = ).print cvtempstring .print ( ).print .lsolve .lresults).cvx .def
(improvecurvefast) (.laccel (r = ).print cvtempstring .print ( Max t change = ).print cvtempstring .print ( ).print .lsolve .lresults).cvx .def

(cirsamples)
(makes samples along a circle. <number of samples> <radius> => .)
(.exch (nc) .exch .store
	0 2 .copy .startsa
	(mult) [ 0 3.1415926 2 .mul nc .div Complex.Exp ] .store
	nc 1 .sub (mult ().cvx .arrayforall Complex.Mul 2 .copy .addsa).cvx .rept)/xdef

(epc) ((n) .countsamples .store .lsamples .larclen 1 .getz n .getz 1 .getz n .getz .lpointslope 2 .lfree 4 .lfree 3 .lfree 5 .lfree .lsolve 3 (.ladjust .lsolve).cvx .rept 5 (.laccel .lsolve).cvx .rept .lresults).cvx .def

(getAIS)
(Loads an AIS file for stroke tracing: takes a file name)
 (.dup .setupais .drawmyais .ctraceopen)/xdef

(da)
(draws the current sampled image)
(.drawmyais)/xdef

(trace)
(Trace a stroke in sampled image: first touch tells start, second indicates initial direction)
 (.resetsa .touch .touch 3 230 1000 .ctrace)/xdef

(resetmouse)
(Resets mouse clicks so they do nothing) (
(.track) {.pop .pop}.cvx .store
(.reddown) {.pop .pop}.cvx .store
(.redup) {.pop .pop}.cvx .store
(.yellowdown) {.pop .pop}.cvx .store
(.yellowup) {.pop .pop}.cvx .store
(.bluedown) {.pop .pop}.cvx .store
(.blueup) {.pop .pop}.cvx .store
)/xdef

(edit)
(Point edit: red inserts, yellow moves, blue deletes) (resetmouse
(Point edit: red inserts, yellow moves, blue deletes
) .print
(.yellowdown) {.selectsa .thetan .deletesa e ms}.cvx .store
(.yellowup) {.insertsa .nodesa .tansa e ms}.cvx .store
(.blueup) {.selectsa .deletesa e ms}.cvx .store
(.reddown) {.selectsa}.cvx .store
(.redup) {.insertbetween e ms}.cvx .store
e ms
)/xdef

(nodes)
(node edit: red sets a node, yellow sets a tangent, blue removes a node) (resetmouse
(node edit: red sets a node, yellow sets a tangent, blue removes a node
) .print
(.redup) (.selectsa .true .nodesa mn).cvx .def
(.yellowdown) (.selectsa).cvx .def
(.yellowup) (.thesa Complex.Sub .tansa noderefresh).cvx .def
(.blueup) (.selectsa .false .nodesa noderefresh).cvx .def
noderefresh
)/xdef

(ht) (make tangent horizontal at the current node)
{1 0 .tansa noderefresh}/xdef

(vt) (make tangent horizontal at the current node)
{0 1 .tansa noderefresh}/xdef

(ft) (make tangent free at the current node)
{0 0 .tansa noderefresh}/xdef

(cusps)
(cusp edit: red sets a cusp, yellow sets a tangent, blue removes a cusp) (resetmouse
(cusp edit: red sets a cusp, yellow sets a tangent, blue removes a cusp
) .print
(.redup) (.selectsa .true .cuspsa mn).cvx .def
(.yellowup) (.selectsa .true .cuspnode mn).cvx .def
(.blueup) (.selectsa .false .cuspsa noderefresh).cvx .def
noderefresh
)/xdef

(noderefresh) (e ms mn).cvx .def

(allnodes)
(makes every sample a node)
(.homesa .countsa {.nextsa .true .nodesa}.cvx .rept noderefresh)/xdef

(nonodes)
(removes all nodes except endpoints)
(.homesa .countsa 2 .sub .nextsa {.nextsa .false .nodesa}.cvx .rept noderefresh)/xdef

(setknots)
(copies the nodes from analyze)
(nonodes .homesa .nextsa .false .nodesa .homesa .prevsa .false .nodesa .mark .pushknots .cnttomrk 2 .div (.selectsa .true .nodesa).cvx .rept .pop .homesa .nextsa .true .nodesa .nextsa .false .nodesa .homesa .prevsa .true .nodesa noderefresh)/xdef 

(setupk) 
(gets the k01 samples)
(110.5 .tvalue (k01.ais) .setupais .outline .makecontours 4 scale)/xdef

(setupg) 
(gets the garamond g samples)
((g-g.ais) .setupais 155.5 .tvalue .outline .makecontours 6 .sascale)/xdef

(setupsf) 
(gets the garamond g samples)
((g-sf.ais) .setupais 113.5 .tvalue .outline .makecontours 6 .sascale)/xdef

(an)
(analyze the specified contour and pick knots based on angle)
(.analyzecontour .dcon 90 psk setknots)/xdef

(ansd)
(analyze the specified contour and pick knots based on angle)
(.analyzesdcontour .dcon 90 psk setknots)/xdef

(sketch)
(Sketches a curve with the mouse) (
(Sketch a curve
) .print
.resetsa resetmouse
(.reddown) {.addsa}.cvx .store
(.track) {.addsa}.cvx .store
)/xdef

(transform)
(Transforms samples: red moves and sets origin, yellow scales and blue rotates) {resetmouse
(Transforms samples: red moves and sets origin, yellow scales and blue rotates
) .print
(.reddown) {}.cvx .store
(.redup) {2 .copy (rotorgy) .exch .store (rotorgx) .exch .store 4 2 .roll Complex.Sub translatecontours e transrefresh}.cvx .store
(.yellowdown) {orgtrans orgrel}.cvx .store
(.yellowup) {orgrel 4 2 .roll Complex.Div Complex.Abs 0 scalecontours unorgtrans e transrefresh}.cvx .store
(.bluedown) {orgtrans orgrel}.cvx .store
(.blueup) {orgrel 4 2 .roll Complex.Div 2 .copy Complex.Abs 0 Complex.Div scalecontours unorgtrans e transrefresh}.cvx .store
(rotorgx) 0 .store 0 (rotorgy)  0 .store
transrefresh}/xdef

(transrefresh) {e dss rotorgx rotorgy dot .pop .pop}.cvx .def

(orgrel) (rotorgx rotorgy 4 2 .roll Complex.Sub).cvx .def
(orgtrans) {rotorgx .neg rotorgy .neg translatecontours}.cvx .def
(unorgtrans) {rotorgx rotorgy translatecontours}.cvx .def
(rotorgx) 0 .def
(rotorgy) 0 .def

(degrees)
(Converts degrees to something the scaler likes)
 (180.0 .div 3.1415926 .mul 0 .exch Complex.Exp)/xdef

(rotate)
(rotates the samples by degrees)
(degrees orgtrans scalecontours unorgtrans e transrefresh)/xdef

(scale)
(Scales the samples)
(0 orgtrans scalecontours unorgtrans e transrefresh)/xdef

(scalecontours)
(Scales/rotates all the contours)
{.countcon {2 .copy .scalesa .nextcon}.cvx .rept .pop .pop}/xdef

(translatecontours)
(Tranlates all the contours)
{.countcon {2 .copy .transa .nextcon}.cvx .rept .pop .pop}/xdef

(setfirst)
(sets the position of the first sample)
{.homesa .nextsa .deletesa .touch .selectsa .makefirstsa .homesa .nextsa .thesa .addsa}/xdef

(corners)
(touch the corners)
{resetmouse e ms
	(.reddown) {.selectsa .cornersa .true .nodesa e ms}.cvx .def
	(.bluedown) {.homesa .nextsa .deletesa .selectsa .makefirstsa .homesa .nextsa .thesa .addsa .homesa .nextsa .true .nodesa .homesa .prevsa .true .nodesa}.cvx .def
	}/xdef

(MoveHomeToLowerLeft)
{.homesa .nextsa .deletesa 0 0 .selectsa .makefirstsa .homesa .nextsa .thesa .addsa .homesa .nextsa .true .nodesa .homesa .prevsa .true .nodesa}.cvx .def

(MoveHomeToACorner)
{.homesa .nextsa .deletesa FindACorner .makefirstsa .homesa .nextsa .thesa .addsa .homesa .nextsa .true .nodesa .homesa .prevsa .true .nodesa}.cvx .def

(FindACorner)
{.homesa .countsa {.nextsa IsCorner {.exit}/if}.cvx .rept}.cvx .def

(IsCorner)
{.thetan .pop Complex.Abs 0 .eq .thetan .exch .pop .exch .pop .and}.cvx .def
 
(nc)
(use next contour)
{.nextcon ms}/xdef

(closeup)
(For taking a close look at the result. Use the mouse to point near the area you are interested in.) {
.initdc resetmouse
0 0 (closey) .exch .store (closex) .exch .store 0 0 showclose 
(.track) {2 .copy showclose closex closey showclose (closey) .exch .store (closex) .exch .store}.cvx .def
}/xdef

(showclose) {.neg .exch .neg .exch .setinvert 10 10 .scale .translate mss dcs mns .initdc}.cvx .def

(insertcorners)
(puts in corners)
{.countsa .homesa {.nextsa 0 0 .insertsa .prevsa .cornersa checkduplicate}.cvx .rept}/xdef

(checkduplicate) {.thesa 0 0 areclose .thesa theprevsa areclose .thesa thenextsa areclose .or .or {.deletesa .prevsa}/if .nextsa}.cvx .def

(areclose) {Complex.Sub Complex.Abs 0.1 .lt}.cvx .def

(theprevsa) {.prevsa .thesa .nextsa}.cvx .def

(thenextsa) {.nextsa .thesa .prevsa}.cvx .def

(sharpencorners)
{.countsa .homesa {.nextsa IsCorner {.cornersa}/if}.cvx .rept}.cvx .def

(FitACContour) {
	MoveHomeToLowerLeft
	5 .dynnodes
	e ms
	55 .squaretangents mn
	MoveHomeToACorner
	.filterbetweencorners
	.filterbetweencorners
	55 .squaretangents e ms mn
	9 1 2 2 .dynspline
	e dc mc
	}.cvx .def

(FitACChar) {
	.countcon
	{.countsa 0 .eq .not {FitACContour}/if .nextcon}.cvx .rept
	e dcs mcs
	.collectgarbage
	}.cvx .def

(FitTheoContour)
{50 50 .transa 20 .interpolatesa e ms 5 .dynnodes 55 .quicktangents MoveHomeToACorner 55 .quicktangents e ms mn 9 1 2 2 .dynspline e dc mc}.cvx .def

(FitTheo) {
	.countcon
	{FitTheoContour .nextcon}.cvx .rept
	e dcs mcs
	}.cvx .def

(GetAISTempContours) {AISisopen {.freeais}/if (AISTemp.ais) getAIS 0.02 .tvalue e .outline .makecontours 0 .setslen (AISisopen) .true .store}.cvx .def

(k?) (counts the knots)
{ 0 (8 {.pop}.cvx .rept 1 .add).cvx .foralllinks cvtempstring .print ( knots) =}/xdef

(printpoint) {.exch cvtempstring .print ( ).print cvtempstring .print ( ).print}.cvx .def

(newcontour) {(initmoveto) {logpoint (.movetonext) .noter (initmoveto) {.pop .pop}.cvx .def}.cvx .def}.cvx .def

(logc) (types the instructions to draw the curve in Curve.Log) {
	newcontour
	{8 6 .roll initmoveto 6 4 .roll logpoint 4 2 .roll logpoint logpoint (.curveto) .noter}.cvx .foralllinks
	}/xdef

(logcs) (types all the contours to Curve.Log or the open log file) {
	(.flushpath) .notes
	.countcon {logc .nextcon}.cvx .rept
	}/xdef

(logpoint) {.exch cvtempstring .notes cvtempstring .notes}.cvx .def

(cvtempstring) (converts to a string, using a temporary string area)
{(                    ) .cvis}/xdef

(FitFont) {PressFont.Open PressFont.AllocateBitmap (Bitmap size = ).print PressFont.BitmapSize .exch cvtempstring .print ( by ).print =}.cvx .def

(GetACChar) {(curChar) .exch .store .initdc 100 0 .setcp
	PressFont.UseBitmap .initdc e BitmapOrigin 1 .add .setcp PressFont.DrawRasterChars PressFont.UseScreen PressFont.DrawBitmap
	PressFont.WriteAISTemp GetAISTempContours e .setcontours 3 scale}.cvx .def

(GetACAsciiChar) {.dup .cviac .exch .cvias (curChar) .exch .store .initdc 100 0 .setcp
	PressFont.UseBitmap .initdc e PressFont.BitmapOrigin 1 .add .setcp PressFont.DrawRasterChars PressFont.UseScreen PressFont.DrawBitmap
	PressFont.WriteAISTemp GetAISTempContours e .setcontours 3 scale}.cvx .def

(AISisopen) .false .def

(GetAISTempContours) {AISisopen {.freeais}/if (AISTemp.ais) getAIS 0 .tvalue e .outlineBlackEdge .makecontours 0 .setslen (AISisopen) .true .store}.cvx .def

(FitContour) {(curContour) .exch .store
	.setsa 3 0 .scalesa .afsa 0 250 .translate ms 2 .subdividespline mc 0 -250 .translate}.cvx .def

(HandFitContour) {.dup (curContour) .exch .store
	.setsa 3 0 .scalesa edit}.cvx .def

(LogChar) {.true .setlog
	(").note curChar .cvaci .cvias .note (" ).note
	[ curChar .cvaci PressFont.CharDimensions ]
	{cvtempstring .note ( ).note}.cvx .arrayforall
	"{setUpTransform" .noter
	logcs
	"}.cvx" .noter
	"WriteSDChar" .noter
	.false .setlog}.cvx .def

(gp) {.touch 2 .copy .exch cvtempstring .print ( ).print cvtempstring .print ( ).print}.cvx .def

(sk) {gp .moveto (.moveto) = {gp gp gp .curveto (.curveto) = .getpos 0 .drawpath .moveto}.cvx .loop}.cvx .def

(FitACRange) (i n -> . Fits n chars, starting at char i.)
{{.dup GetACAsciiChar FitACChar 1 .add}.cvx .rept .pop}/xdef