%!PS % Enhanced Fun with Fields Routines % ====================================================================== % by Don Lancaster % Copyright c 2005 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 % Linking welcome. Reposting expressly forbidden. % All commercial rights and all electronic media rights ~fully~ reserved. % Linking usually welcome. Reposting expressly forbidden. Version 3.1 % A series of PostScript utilities that greatly simplifies the generation, % interpretation, and understanding of Laplacian fields. % ========= % 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 % ========== % NOTE THAT ALL PS FILENAME STRINGS !!!DEMAND!!! DOUBLE REVERSE SLASHES. % GONZO20A Guru Gonzo PostScript power tools (Interim release) % Includes gonzo justification and layout utilities. % Copyright c 1990, 1996, 2001 by Don Lancaster and Synergetics, Box 809, % Thatcher Arizona, 5552 (928) 428-4073 don@tinaja.com support % via http://www.tinaja.com All commercial rights and all electronic % media rights **FULLY** reserved. Reposting is expressly forbidden. % Activate the Gonzo utilities /guru { gonzo begin ps.util.1 begin printerror nuisance begin} def % guru % activate gonzo utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /hue2rgb.psl %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Code to convert a hue value into a RGB triad of adjustable % saturation and brightness. %%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Picks one of six color bars based upon dominant primary % service utils... /plotsat 0.8 store % color saturation 0-1 1 = full saturation /plotbrt 1.0 store % color brightness 0-1 1=full brightness /bkg {1 plotsat sub} store /upset { 1 bkg sub % the available total sat shift for this color &cwt mul % the desired shift bkg add % plus the background } store /downset { 1 bkg sub % the available total sat shift for this color 1 &cwt sub mul % the desired shift bkg add % plus the background } store % main hue to RGB routine... /huetorgb {dup /currenttint exch store % save currenttint 5.999 mul dup floor cvi /&cbar exch store % save case 0-5 &cbar floor sub /&cwt exch store % save posn into case [ % array of case cases { 1 upset bkg} % red dominant hue 0 to .166 { downset 1 bkg} % green dominant hue .166 to .333 { bkg 1 upset} % green dominant hue .333 to .500 { bkg downset 1} % blue dominant hue .500 to .666 { upset bkg 1} % blue dominant hue .666 to .833 { 1 bkg downset} % red dominant hue .833 to .999 ] &cbar get exec 255 mul plotbrt mul cvi /curblue exch store 255 mul plotbrt mul cvi /curgreen exch store 255 mul plotbrt mul cvi /curred exch store curred curgreen curblue } def %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /makestring %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Converts an array of 0-255 integers into a string. % Used to get from array to string to image %%%%%%%%%%%%%%%%%%%%%%%%%%%% /makestring {dup length string dup /NullEncode filter 3 -1 roll {1 index exch write} forall pop} def %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /field2image %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Converts a by-columns array of arrays into a series of % row strings as requested by an image proc. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % requires initially zeroed /arraycount pointer /field2image { mark % start row array 0 1 field length 1 sub % get row voltage values {/fcol exch store field fcol get arraycount get} for ] % complete voltage row array /arraycount arraycount % advance pointer 1 add store mark % start scaled hue array exch {1000 sub abs 1667 div % 1000=red 0.000 0=blue 0.667 huetorgb } forall ] % and complete makestring } store % and convert to %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /fieldasimage %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Converts a by-columns array of arrays into an image for % compact storage and fast display. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Assumes a RGB color mode /imgwide {field length} store % find by-columns array width /imghi {field 0 get length} store % fomd bu-collumns array height /fieldasimage { << % begin RGB image dictionary /arraycount 0 store % new counter to deliver row strings /ImageType 1 % usual image stuff /Width imgwide /Height imghi /BitsPerComponent 8 /MultipleDataSources false /Interpolate false /Decode [ 0 1 0 1 0 1] /ImageMatrix [imghi 0 0 imghi 0 0] % work UP from bottom /DataSource {field2image} % MUST be deferred!!! proc >> image } store %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /fieldplot %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Positions and draws a field image at a specified page location. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % requires x and y position on stack top /plotsat 0.8 store % saturation 0-1 1=full saturation /plotbrt 1.0 store % brightness 0-1 1=full brightness /fieldplot { /DeviceRGB setcolorspace % set color mode gsave translate % position on page imghi dup scale % scale to size fieldasimage % place image grestore} store %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /resetbound %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Resets a boundary for the field array mapped into a unit square. %%%%%%%%%%%%%%%%%%%%%%%%%%%% % requires {boundaryproc} boundaryvalue on stack. /resetbound { gsave /boundval exch store % save boundary value to be reset newpath { field length % map reset proc to array space field 0 get length dup scale} pop exec % execute unit square fill proc /fieldhi field 0 get % update field column count length store /fieldwd field % update field row count length store 0 1 fieldhi 1 sub { % scan each array element position /curvpos exch store 0 1 fieldwd 1 sub { % both x and y /curhpos exch store curvpos 0.5 add curhpos 0.5 add infill % does array location need update? { field curvpos get % yes, reset boundary value curhpos boundval put } if } for} for grestore} store %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /initfield %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initializes a field of column arrays %%%%%%%%%%%%%%%%%%%%%%%%%%%% % input with rows columns value on stack /initfield {/mtval exch store % save empty value /ccc exch store % save number of columns /rrr exch store % save number of rows mark % start array rrr { % for rrr arrays mark ccc {mtval} repeat % place ccc data values each ] } repeat ] /field exch store } store %%%%%%%%%%%%%%%%%%%%%%%%%%%% % /quadaverage %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Averages internal field points. Solves Laplacian when repeated. %%%%%%%%%%%%%%%%%%%%%%%%%%%% /quadaverage { 1 1 field length 2 sub { % for each column /hhh exch store 1 1 field 0 get length 2 sub { % for each row /vvv exch store field hhh get vvv 1 add get % two vertical points field hhh get vvv 1 sub get add field hhh 1 sub get vvv get % two horizontal points field hhh 1 add get vvv get add add 4 div % new average field hhh get exch vvv exch put % and replace } for } for % complete loops } bind def %%%%%%%%%%%%%%%%%%%%%%%%%%%% % A boundary proc library %%%%%%%%%%%%%%%%%%%%%%%%%%%% % Example boundary values as unit square fill procs %%%%%%%%%%%%%%%%%%%%%%%%%%%% % areas /cencirc {newpath 0.5 0.5 0.126 0 360 arc} store % a centered circle of 25% volume /lowquart {newpath 0 0 mt 0.25 pu 1 pr 0.25 pd closepath} store % bottom quarter /hiquart {newpath 0 0.75 mt 0.25 pu 1 pr 0.25 pd closepath} store % top quarter % try full size /cencirc {newpath 100 100 25.3 0 360 arc} store % try full size /lowquart {newpath 0 0 mt 50 pu 200 pr 50 pd closepath} store % bottom quarter /hiquart {newpath 0 150 mt 50 pu 200 pr 50 pd closepath} store % top quarter /swcorner {newpath 0 0 mt 100 pu 100 pr 100 pd closepath} store % lines /edgeset1 {mark 50 {0} repeat 100 {dup 10 add} repeat 50 {1000} repeat ]} store %%%%%%%%%%%%% %%%%%%%%%%%%% %%%%%%%%%%%%% % create a 200 x 200 array of data value 500 % 200 200 500 initfield % temporary shading % create a boundary resetter for busbar hole /fixbounds { {lowquart} 0 resetbound % low quarter at blue zero {cencirc} 500 resetbound % mid circle at half amplitude {hiquart} 1000 resetbound % high quarter at red 1000 } store /busbarclip { newpath 100 100 25 0 360 arc 0 50 mt 200 pr 100 pu 200 pl 100 pd } store /pccornerclip {0 100 mt 100 pu 200 pr 200 pd 100 pl 100 pu 100 pl} store /fixbounds { % for printed circuit corner {lowquart} 0 resetbound % low quarter at blue zero {cencirc} 500 resetbound % mid circle at half amplitude {hiquart} 1000 resetbound % high quarter at red 1000 } store /fixbounds { {swcorner} 0 resetbound % zero southeast corner } store % fixbounds { % for busbar field 0 edgeset1 put field dup length 1 sub edgeset1 put } pop % for printed circuit corner /setleftedge1 { field 0 mark 100 {0} repeat 100 {dup 10 add} repeat ] put} store /settopedge1 {0 1 field length 1 sub { /cccc exch store field cccc get 199 1000 put } for } store /setrightedge1 {field 199 mark 200 {1000} repeat ] put } store /setbottomedge1 { /val 0 store 100 1 field length 1 sub {/ccccc exch store field ccccc get 0 val put /val val 10 add store } for } store { setleftedge1 settopedge1 setrightedge1 setbottomedge1 } pop % faster fixbounds? /fixbounds { 0 1 100 {/rr exch store % right field rr get 100 0 put } for 0 1 100 {/cc exch store field 100 get cc 0 put} for } store %%%%%%%%% % begin busbar only code /busbarclip { newpath 100 100 35 0 360 arc 0 50 mt 200 pr 100 pu 200 pl 100 pd } store /setleft {/val 0 store 50 1 150 {field 0 get exch val put /val val 10 add store} for} store /setright {/val 0 store 50 1 150 {field 199 get exch val put /val val 10 add store} for} store /settop {0 1 199 {field exch get 150 1000 put} for } store /setbot {0 1 199 {field exch get 50 0 put} for } store /cencirc {newpath 100 100 35 0 360 arc} store 200 200 500 initfield % temporary shading setleft setright settop setbot {cencirc} 500 resetbound stopwatchon 1000 { % fixbounds settop setbot {cencirc} 500 resetbound quadaverage ( ) print flush field 100 get 140 get == } repeat stopwatchoff % field == gsave 100 100 translate busbarclip closepath gsave eoclip gsave 0 0 fieldplot grestore grestore stroke grestore showpage % EOF