%!PS % Constant spaced spline segments conspline1a.psl % ============================================================== % Copyright c 2019 by Don Lancaster & Synergetics, Box 809, Thatcher, AZ, 85552 % (928) 428-4073 Email: don@tinaja.com Website: http://www.tinaja.com % Consulting services available http://www.tinaja.com/info01.html % All commercial rights and all electronic media rights ~fully~ reserved. % Linking usually welcome. Reposting expressly forbidden. Version 1.1 % This attempts to create equally spaced cubic spline segments. % It should work with most "gentle" splines and should be fully % triply Acrobat-GoogleDrive-GhostScript compatible. %%////// Extracted Gonzo Utilities ////// /mt {moveto} store /rm {rmoveto} def /rl {rlineto} def /pd {0 exch neg rl} def /pr { 0 rl} def /pu {0 exch rl} def /pl {neg 0 rl} def /line1 {.06 dup setlinewidth 5 mul /erase exch def} def /line2 {.12 dup setlinewidth 5 mul /erase exch def} def /line3 {.18 dup setlinewidth 5 mul /erase exch def} def /thingridlines {0} def /setgrid { /blocksize exch def translate % simplified blocksize dup scale} def /showgrid {gsave /vblocks exch def /hblocks exch def thingridlines setlinewidth [{0 0 moveto 0 vblocks rlineto stroke} 1 hblocks 1 add] xrpt [{0 0 moveto hblocks 0 rlineto stroke} 1 vblocks 1 add] yrpt fatterborder { gsave newpath 0 0.96 blocksize div dtransform round idtransform setlinewidth pop 2 setlinecap 0 0 moveto hblocks 0 rlineto 0 vblocks rlineto hblocks neg 0 rlineto closepath stroke grestore} if fat5 { gsave newpath 0 0.48 blocksize div dtransform round idtransform setlinewidth pop mark {5 0 moveto 0 vblocks rlineto stroke} 5 hblocks 5 div cvi] xrpt mark {0 5 moveto hblocks 0 rlineto stroke} 5 vblocks 5 div cvi] yrpt grestore} if fatter10 { gsave newpath 0 0.96 blocksize div dtransform round idtransform setlinewidth pop mark {10 0 moveto 0 vblocks rlineto stroke} 10 hblocks 10 div cvi] xrpt mark {0 10 moveto hblocks 0 rlineto stroke} 10 vblocks 10 div cvi] yrpt grestore} if grestore} def /fatterborder {true } store /fat5 {false} store /fatter10 { false} store /showdots { false } store /dot { showdots { currentpoint newpath 0.150 0 360 arc fill }if} def /mdot { mt dot} def /random {rand 65536 div 32768 div mul cvi} def % as in -- 6 random -- /gonzofont {dup type cvlit /arraytype eq {exch findfont exch makefont} {exch findfont exch scalefont} ifelse setfont mark /spacewidth ( ) stringwidth pop /cstretch cvx /add cvx /sstretch cvx /add cvx /def cvx currentfont dup backcdict exch (F?) dup 1 14 index (xxxxx) cvs 4 get put put /setfont cvx ] cvx def} def 50 dict /backcdict exch def % used "backwards" during compiling to get % fontname given the "made" font dictionary /cstretch 0 store /sstretch 0 store % repeats [ proc distance trips] xrpt /xrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def trips { gsave rproc grestore dist 0 translate } repeat grestore} def /yrpt{gsave aload pop /trips exch def /dist exch def /rproc exch def trips { gsave rproc grestore 0 dist translate } repeat grestore} def % timing utilities. use stopwatchon and stopwatchoff for simple % one shot timing. For multiple time totals, use resettimer % starttimer stoptimer ... starttimer stoptimer reporttimer /mergestr {2 copy length exch length add string dup dup 4 3 roll 4 index length exch putinterval 3 1 roll exch 0 exch putinterval} def /stopwatchoff {stoptimer reporttimer} def % for single shots /stopwatchon {resettimer starttimer} def % for single shots /reporttimer {mytime 1000 div (\rElapsed time: ) print 20 string cvs print ( seconds.\r) print flush} def % to host /resettimer {/mytime 0 def} def % reset timer /starttimer {usertime /mytimenow exch def} def % add to time so far /stoptimer {usertime mytimenow sub /mytime exch mytime add def} def % for multiple timing intervals /black {0 setwebtint} store % ///////// (A) WEB FRIENDLY COLOR UTILITIES ///////////// % tintmat is a self-generating list of 216 triple color values /webtintmat [ 0 1 5 { /a exch store 0 1 5 { /b exch store 0 1 5 { 5 div b 5 div a 5 div }for } for } for ] def % setwebtint accepts a color number 0 to 215 and then % sets the PostScript color generator for later use... /setwebtint { abs cvi 216 cvi mod % restrict range webtintmat exch 3 mul 3 getinterval % get values from table aload pop setrgbcolor} def % and set them % The blocks are arranged as red to the right, green % up in order of increasing blue. % Some "pure color" sequences are % red: 0 1 2 3 4 5 % orange: 0 7 8 15 16 23 (sort of) % yellow: 0 7 14 21 28 35 % green: 0 6 12 18 24 30 % aqua: 0 42 84 126 168 210 % blue: 0 36 72 108 144 180 % magenta: 0 37 74 111 148 185 % purple 0 73 73 110 147 183 (sort of) % gray 0 43 86 129 172 215 % ////// sleezoid and spline specific code /////// /pcurveto1 {6 copy /y3 exch def /x3 exch def /y2 exch def /x2 exch def /y1 exch def /x1 exch def currentpoint /y0 exch def /x0 exch def curveto} def % this finds x(t) given t in the range of 0 to 1... /xtt {x3 x2 3 mul sub x1 3 mul add x0 sub tt 3 exp mul x2 3 mul x1 6 mul neg add x0 3 mul add tt dup mul mul add x1 3 mul x0 3 mul neg add tt mul add x0 add } def % this finds y(t) given t in the range of 0 to 1... /ytt {y3 y2 3 mul sub y1 3 mul add y0 sub tt 3 exp mul y2 3 mul y1 6 mul neg add y0 3 mul add tt dup mul mul add y1 3 mul y0 3 mul neg add tt mul add y0 add } def % pcurveto2 does the same thing for a second separate curve... /pcurveto2 {6 copy /yy3 exch def /xx3 exch def /yy2 exch def /xx2 exch def /yy1 exch def /xx1 exch def currentpoint /yy0 exch def /xx0 exch def curveto } def /xxtt {xx3 xx2 3 mul sub xx1 3 mul add xx0 sub tt 3 exp mul xx2 3 mul xx1 6 mul neg add xx0 3 mul add tt dup mul mul add xx1 3 mul xx0 3 mul neg add tt mul add xx0 add} def /yytt {yy3 yy2 3 mul sub yy1 3 mul add yy0 sub tt 3 exp mul yy2 3 mul yy1 6 mul neg add yy0 3 mul add tt dup mul mul add yy1 3 mul yy0 3 mul neg add tt mul add yy0 add} def % if you want more curves, use pcurveto3, etc... /dot { currentpoint newpath 0.150 0 360 arc fill } def % from GUTILITY.PTL /plotdots {0 1 numpoints div 1 {/tt exch def xtt ytt moveto dot} for }def % /////////// Constant spline spacing code goes here //////////// /showregspline { 18 37 translate % move to top of page 32 setwebtint 20 20 showgrid % green grid 192 setwebtint % blue border 0 0 mt line3 20 pu 20 pr 20 pd 20 % outline pl closepath stroke 210 setwebtint % light blue 0 0 mt 5 25 15 -5 20 20 pcurveto1 % set the curveto line3 stroke % and draw it } store /makeconttarray {/z1 [ 0 20 { dup 1 intervals % original equal tt space array div add} repeat ] store } store /makeconssarray {/prevx 0 store % new equal ss space array /prevy 0 store /z1 mark 0 0 1 numsamps div 1 { /curtry exch store /tt curtry store xtt prevx sub dup mul ytt prevy sub dup mul add sqrt % find current length so far % dup /mmm exch store % consistency check increase numsamps for more subwidth gt { % have we filled next interval? curtry % yes - enter into array /prevx xtt store % start search for next interval /prevy ytt store % mmm == % consistency check but Google does not like == } if } for ] store } store /normalizessarray { /adj z1 dup length 1 sub get store % make sure last dot is correct /z1 mark z1 {adj div} forall ] store } store /showdots { 5 setwebtint % red dots 0 1 z1 length 1 sub { % show on original z1 exch get /tt exch store xtt ytt mdot } for } store /showconspline { 18 10 translate % move to top of page 32 setwebtint 20 20 showgrid % green grid 192 setwebtint % blue border 0 0 mt line3 20 pu 20 pr 20 pd 20 % outline pl closepath stroke 210 setwebtint % light blue 0 0 mt 5 25 15 -5 20 20 pcurveto1 % set the curveto line3 stroke % and draw it } store % /////////// Constant spline spacing demo goes here //////////// /intervals 20 store % number of subdivisions /numsamps 10000 store % number of tt samples /subwidth 1.702 store % good value for n=20 32 setwebtint % use full page grid, then retranslate 50 50 10 setgrid gsave % upper plot variable spacing showregspline % create background graphic makeconttarray % make dot array showdots grestore gsave % lower plot variable spacing showconspline % create background graphic makeconssarray % make constant spaceddot array stopwatchon normalizessarray % normalize array from 0 to 1 stopwatchoff showdots grestore showpage % EOF