% name of textfile: Improved curvetracing routines (DL/Synergetics Feb 02 v1.0) % .... % ========= % This file requires the previous download of gonzo.psl % available from https://www.tinaja.com/pssamp1.shtml % Make sure the following line agrees with your own gonzo.psl location (C:/Users/don/Desktop/gonzo/gonzo.psl) run % use internal gonzo % ========== gonzo begin gutility begin printerror nuisance begin % (2a) improved gonzo curvetrace % . . . . . % curvetrace2 - creates a smooth curved path from a data point list. % enter with currentpoint set and absolute array. % 0 0 as initial data appends path; any other values % creates new path. A "999" angle of any intermediate points % will be replaced by a good guess. % /fixgusses replaces any intermediate point angle guess of "999" with a best % effort guess of using the tangent angle that results if you draw a circle % through the adjacent two points. /reportnewangles true store /fixguesses {/curvelist exch store 5 3 curvelist length 3 sub { /cptr exch store curvelist cptr get 360 gt { curvelist cptr 5 sub get curvelist cptr 4 sub get curvelist cptr 2 sub get curvelist cptr 1 sub get curvelist cptr 1 add get curvelist cptr 2 add get fixangle curvelist exch cptr exch put } if } for reportnewangles {curvelist == } if % return angles if desired curvelist } def % /fixangle is used by fixguess. Given three points, draw a circle through the % points, then calculate and return the tangent angle of the middle point. /fixangle { /y3 exch store /x3 exch store /y2 exch store /x2 exch store /y1 exch store /x1 exch store y2 y1 sub x2 x1 sub atan 90 sub tan /mm exch store % find first bisector x2 x1 sub 2 div x1 add /px1 exch store y2 y1 sub 2 div y1 add /py1 exch store /bb py1 px1 mm mul sub store y3 y2 sub x3 x2 sub atan 90 sub tan /nn exch store % find second bisector x3 x2 sub 2 div x2 add /px2 exch store y3 y2 sub 2 div y2 add /py2 exch store /cc py2 px2 nn mul sub store /xcen cc bb sub mm nn sub dup 0 eq {pop 0.000001} if div store % find circle /ycen xcen mm mul bb add store /rad x1 xcen sub dup mul y1 ycen sub dup mul add sqrt store % don't really need y2 ycen sub x2 xcen sub atan 90 sub % return best angle guess } def /curvetrace2 {fixguesses /curvelist exch def tension 0 eq {/tension .000001 def} if curvelist length 3 div 1 sub cvi /#triads exch def /ptr 0 def firstpoint morepoint} def /tension 2.83 def % default value for best fit /showtick false def % don't show points /ticklen 15 def % length of ticks /tickhead ticklen 4 div def /prvx { curvelist ptr 3 sub get } def /curx { curvelist ptr get } def /prvy { curvelist ptr 2 sub get } def /cury { curvelist ptr 1 add get } def /prva { curvelist ptr 1 sub get } def /cura { curvelist ptr 2 add get 180 sub} def /showtic1 { showtick true eq {gsave currentpoint newpath translate cura 180 add rotate ticklen neg 2 div 0 moveto ticklen 0 rlineto tickhead neg dup rlineto tickhead dup rlineto tickhead dup neg exch rlineto 0 setlinewidth stroke 0 ticklen neg 2 div moveto 0 ticklen rlineto stroke grestore} if }def /firstpoint { curx cury 2 copy abs exch abs add 0 eq {pop pop currentpoint curvelist exch 1 exch put curvelist exch 0 exch put}{moveto} ifelse showtic1 /ptr ptr 3 add def}def /morepoint {#triads { curx prvx sub dup mul cury prvy sub dup mul add sqrt tension div /zdist exch def prva cos zdist mul prvx add prva sin zdist mul prvy add cura cos zdist mul curx add cura sin zdist mul cury add curx cury curveto showtic1 /ptr ptr 3 add def} repeat} def /showtick false def % //////// demo - remove or alter before reuse /////////// % draw a large "B"... 50 50 10 setgrid 50 50 showgrid black /font1 /StoneSerif-Bold 64 gonzofont 1 1 mt (B) false charpath line1 stroke % put down some known curves 31 45.8 mt dot 44.63 36.3 mt dot 33.4 25.62 mt dot /tension 2.83 def % default value for best fit [ 31 45.8 0 44.63 36.3 999 % guess angle 33.4 25.62 -172] curvetrace2 0 settint 0.31 setgray line1 stroke /tension 2.38 def % try an improved tension for better fit [ 31 45.8 -0.4 44.63 36.3 999 % guess angle 33.4 25.62 -173.1] curvetrace2 0.75 settint 0.31 setgray line1 stroke % note that errors midway between points are adjustable by tension. % errors adjacent to points are adjustable by angle. % minor errors have purposely been left in this example. showpage % eof