%!PS-Adobe-3.1 % JPG tracing utility JPG_trace1.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 % A "three level" tracing program that accepts a .JPG file, overlays it % with a newly improved and numbered grid, and overlays that with a % compact and efficient PostScript curvetracing. % A gonzo tutorial is found at https://www.tinaja.com/glib/gonzotut.pdf % A PostScript Reference Manual at % % https://www.adobe.com/content/dam/acom/en/devnet/actionscript/articles/PLRM.pdf % A PostScript Video at https://www.youtube.com/watch?v=C_tWW560tAE % Fancy apps may require Distiller command line run as //acrodist /F . % .JPG portion of the code is not yet Google Drive compatible. % IMPORTANT: Change these two lines to switch betweeen tracing code and any result! % At present, the result can be viewed on Google Drive if want_to_trace % is false. /want_to_trace { true } store /want_to_see_grid {true} store %%////// Extracted Gonzo Utilities ////// /mt {moveto} def /li {lineto} def /rm {rmoveto} def /rl {rlineto} def /ct {curveto} def /cp {closepath} def /f {fill} 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 30 setwebtint /vblocks exch def /hblocks exch def thingridlines setlinewidth [{0 0 moveto 0 vblocks rlineto stroke} 1 hblocks] xrpt [{0 0 moveto hblocks 0 rlineto stroke} 1 vblocks] yrpt fatterborder { gsave 198 setwebtint newpath 0 0.96 blocksize div setlinewidth pop 2 setlinecap 0 0 moveto hblocks 0 rlineto 0 vblocks rlineto hblocks neg 0 rlineto closepath stroke grestore} if fat5 { gsave 64 setwebtint newpath 0 0.96 blocksize div setlinewidth pop mark {5 0 moveto 0 vblocks rlineto stroke} 5 hblocks 5 div cvi 0 sub] xrpt mark {0 5 moveto hblocks 0 rlineto stroke} 5 vblocks 5 div cvi 0 sub ] yrpt grestore} if fatter10 { gsave 198 setwebtint % emphasize here newpath 0 0.96 blocksize div setlinewidth pop mark {10 0 moveto 0 vblocks rlineto stroke} 10 hblocks 10 div cvi 0 sub ] xrpt mark {0 10 moveto hblocks 0 rlineto stroke} 10 vblocks 10 div cvi 0 sub ] yrpt grestore} if grestore} def /fatterborder {true } store /fat5 {true} store /fatter10 { true} store /showdots { true } 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 % curvetrace - 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 /curvetrace {/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.83301 def % default value for best fit SLIGHTLY REVISED! /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 % This alternate method usually uses a .JPG rather than a PS show. % insert image proc /jpegimageprocwithlink { % hoffset voffset hres vres urlfrom urlto save /snap2 exch def /inurllink exch store % grab link filename /infilename exch store % grab passed pix file /photoscale exch store /vpixels exch store /hpixels exch store % (\nvpixels = )print vpixels == % (\nhpixels = )print hpixels == % (\photoscale = ) print photoscale == % (\ninurllink = ) print inurllink == % (\ninfilemane = ) print infilename == translate % adjust position for final figure ??? inurllink setareaurl % autolink sizing /DeviceRGB setcolorspace % pick color model 0 0 translate % set page position hpixels vpixels scale % magnify unit square photoscale dup scale /infile infilename (r) file def % establish input read file /Data {infile /DCTDecode filter} def % define a data source << % start image dicationary /ImageType 1 % always one /Width hpixels % JPEG width in pixels /Height vpixels % JPEG height in pixels /ImageMatrix [hpixels 0 0 vpixels neg 0 vpixels ] /DataSource Data % proc to get filtered JPEG /BitsPerComponent 8 % color resolution /Decode [0 1 0 1 0 1] % per red book 4.10 >> image % call the image operator ypos snap2 restore /ypos exch def } def /setareaurl { % for auto include routine /cururlname exch store mark % start pdfmark /Rect [ 0 0 hpixels photoscale mul vpixels photoscale mul ] /Border [ 0 0 0] % [0 0 0 ] = none; [0 0 2] = debug /Color [ .7 0 0 ] /Action <> /Subtype /Link /ANN % annotation type pdfmark % call pdf operators } def % ///////// (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 % ///////////// DEMO OF PS SHOW STYLE CHARACTER CAPTURE /////////////// /wanttoviewjpg true store % can also use a PS proc here /wanttoviewgrid true store /wanttoviewnums true store % show nums on grid? %% set a 10x layout grid 50 50 10 setgrid /ypos 0 store % huh? %% put down jpg image or ps routine to be traced ... wanttoviewjpg { save /ssnap exch store %% IMPORTANT: Change absolute links to suit your host or project!! /imageurl (snorf) store /imagelocalsource (C:/Users/don/Desktop/google_drive/JPG_Trace/cap2x.jpg) store gsave -8 -3 % page translate ( data for jpegimageprocwithlink ) 202 185 % hpixels and vpixels 0.32 % photoscale imagelocalsource % local jpg source imageurl % image url on clickthru jpegimageprocwithlink grestore ssnap restore } if %% optionally put down an overlay layout grid here... wanttoviewgrid { 50 50 showgrid wanttoviewnums {gsave 43 pop 5 setwebtint /Arial-BoldMT findfont 0.8 scalefont setfont 0 10 vblocks {/ypos exch store 0 10 hblocks {/xpos exch store xpos 1 sub ypos 0.7 sub moveto xpos 20 string cvs show } for } for 0 10 hblocks {/xpos exch store 0 10 vblocks {/ypos exch store xpos 0.15 add ypos 0.3 add moveto ypos 20 string cvs show } for } for grestore } if } if % no nums if no grid! %% and then manually enter your curvetrace data here... /tracejpg { % YOUR TRACING ROUTINE SUBSTITUTES HERE % top 7.6 30.6 mt 20 42.7 lineto 42 39 lineto 31.5 26 lineto 7.6 30.6 lineto gsave 215 setwebtint fill grestore 0 setwebtint line1 stroke /circ [ 12 32 % rectangle defines perspective circle 21 41 38.4 37.6 30.4 28.6 ] store 130 setwebtint % unpop to view circle bounding box { circ 0 get circ 1 get mt % bounding box circ 2 get circ 3 get lineto circ 4 get circ 5 get lineto circ 6 get circ 7 get lineto circ 0 get circ 1 get lineto} pop circ 2 get circ 0 get add 2 div /x0 exch store % midpoints circ 3 get circ 1 get add 2 div /y0 exch store circ 4 get circ 2 get add 2 div /x1 exch store circ 5 get circ 3 get add 2 div /y1 exch store circ 6 get circ 4 get add 2 div /x2 exch store circ 7 get circ 5 get add 2 div /y2 exch store circ 6 get circ 0 get add 2 div /x3 exch store circ 1 get circ 7 get add 2 div /y3 exch store 0 setwebtint 0.4 setlinewidth % temp markers {x0 y0 mt 0 2 rlineto stroke x1 y1 mt 0 2 rlineto stroke x2 y2 mt 0 2 rlineto stroke x3 y3 mt 0 2 rlineto stroke} pop /tension 2.83301 def % best circle fit - slightly less may be better /ang0 {circ 3 get circ 1 get sub circ 2 get circ 0 get sub atan} store /ang1 {circ 5 get circ 3 get sub circ 4 get circ 2 get sub atan} store /ang2 {circ 7 get circ 5 get sub circ 6 get circ 4 get sub atan} store /ang3 {circ 1 get circ 7 get sub circ 0 get circ 6 get sub atan} store [ % draw top circle x0 y0 ang0 x1 y1 ang1 x2 y2 ang2 x3 y3 ang3 x0 y0 ang0 ] curvetrace gsave clip 0 -2 translate [ % draw bottom circle note eofill! x0 y0 ang0 x1 y1 ang1 x2 y2 ang2 x3 y3 ang3 x0 y0 ang0 ] curvetrace gsave 129 setwebtint eofill grestore line1 stroke grestore newpath % draw phillips gsave 86 setwebtint 1 setlinecap 1.8 setlinewidth 22.2 35.2 mt 7.2 -2.3 rlineto stroke 23 31.5 mt 5 4.5 rlineto stroke grestore 0 setwebtint line1 stroke 130 setwebtint % right side 42 39 mt 42 24 lineto 31.4 9.5 lineto 31.5 26 lineto 42 39 lineto gsave 129 setwebtint fill grestore 0 setwebtint line1 stroke % left side 7.6 30.6 mt 31.5 26 lineto 31.4 9.5 lineto 7.6 15 lineto 7.6 30.6 lineto gsave 172 setwebtint fill grestore 0 setwebtint line1 stroke % flange gsave 1 setlinecap 1 setlinejoin /tension 1.7 store % special agressive tension [ 16 16.5 -12 21.5 15.5 -12 21.5 15.5 -90 19 8 -120 19 8 170 12.5 9.5 170 12.0 9.5 60 15.4 16.5 90 ] curvetrace 29 setwebtint fill grestore /tension 1.7 store [ 16 16.5 -12 21.5 15.5 -12 21.5 15.5 -90 19 8 -120 19 8 170 12.5 9.5 170 ] curvetrace 1 setlinecap 1 setlinejoin 1 setlinewidth 51 setwebtint stroke [15.5 16.5 -90 % leftside of flange 12.0 9.5 -120 ] curvetrace line3 stroke 15.1 12.6 mt 4.8 -0.9 rlineto stroke % highlight } store %% and display tracejpg showpage % EOF