%!PS % Exploratory airbrush demo % ================================ % Copyright c 2008 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 1.1 % IMPORTANT NOTE: Don Lancaster's file gonzo.ps is required for this program. % After obvious location mods, uncomment ONE of the following two lines: (C:/Users/don/Desktop/gonzo/gonzo.psl) run % use internal gonzo % (A:\\gonzo.ps) run % use external 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. %%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%% service routines % PS LINEAR EQUATION SOLVER FOR N=4 LINEQ04.PS % ============================================ % Copyright c 1999 by Don Lancaster and Synergetics, Box 809, Thatcher, AZ, 85552 % (520) 428-4073 don@tinaja.com http://www.tinaja.com % Consulting services available per http://www.tinaja.com/info01.html % All commercial rights and all electronic media rights fully reserved. % Personal use permitted provided header and entire file remains intact. % Linking is welcome. Reposting expressly forbidden. % This utility demo shows how to use PostScript to solve linear algabraic equations % by use of Gaussian elimination. It is easily extended to higher orders. % Additional details in http://www.tinaja.com/glib/muse142.pdf % This code currently includes temporary test and reporting utils. % temp report utility /aaa {20 string cvs print ( ) print} def /rrr {(\n\n) print w0 aaa x0 aaa y0 aaa z0 aaa ( ) print a0 aaa (\n) print w1 aaa x1 aaa y1 aaa z1 aaa ( ) print a1 aaa (\n) print w2 aaa x2 aaa y2 aaa z2 aaa ( ) print a2 aaa (\n) print w3 aaa x3 aaa y3 aaa z3 aaa ( ) print a3 aaa (\n) print } def % Define or capture your data. To avoid any div0 problems, preplace your largest % absolute values on your principle diagonals... { /w0 -3.997 store /x0 2.075 store /y0 -0.997 store /z0 1.436 store /a0 29.223 store /w1 2.345 store /x1 -0.654 store /y1 -8.231 store /z1 1.234 store /a1 -13.491 store /w2 -3.224 store /x2 12.223 store /y2 -1.06 store /z2 4.987 store /a2 1.342 store /w3 0.334 store /x3 -1.653 store /y3 2.724 store /z3 -7.003 store /a3 -13.365 store } pop /solven04 { (\n\nraw equations) == rrr % normalize w0 to unity... /a0 a0 w0 div store /z0 z0 w0 div store /y0 y0 w0 div store /x0 x0 w0 div store /w0 w0 w0 div store % /w0 1.000 store (\n\nforcew0 to unity) == rrr % force w1 to zero... /a1 a1 a0 w1 mul sub store /z1 z1 z0 w1 mul sub store /y1 y1 y0 w1 mul sub store /x1 x1 x0 w1 mul sub store /w1 w1 w0 w1 mul sub store % check % /w1 0 store (\n\nforce w1 to zero)== rrr % normalize x1 to unity... /a1 a1 x1 div store /z1 z1 x1 div store /y1 y1 x1 div store /x1 x1 x1 div store % /x1 1.000 store (\n\nnormalize x1 to zero) == rrr % force w2 to zero /a2 a2 w2 a0 mul sub store /z2 z2 w2 z0 mul sub store /y2 y2 w2 y0 mul sub store /x2 x2 w2 x0 mul sub store /w2 w2 w2 w0 mul sub store % /w2 0 store (\n\nforce w2 to zero) == rrr % force x2 to zero... /a2 a2 a1 x2 mul sub store /z2 z2 z1 x2 mul sub store /y2 y2 y1 x2 mul sub store /x2 x2 x1 x2 mul sub store % /x2 0 store (\n\nforce x2 to zero) == rrr % normalize y2 to unity... /a2 a2 y2 div store /z2 z2 y2 div store /y2 y2 y2 div store % /y2 1.000 store (\n\nnormalize y2 to unity) == rrr % force w3 to zero (w3 - w0/w3) /a3 a3 a0 w3 mul sub store /z3 z3 z0 w3 mul sub store /y3 y3 y0 w3 mul sub store /x3 x3 x0 w3 mul sub store /w3 w3 w0 w3 mul sub store % /w3 0 store (\n\n force w3 to zero) == rrr % force x3 to zero /a3 a3 a1 x3 mul sub store /z3 z3 z1 x3 mul sub store /y3 y3 y1 x3 mul sub store /x3 x3 x1 x3 mul sub store % /x3 0 store (\n\nforce x3 to zero) == rrr % force y3 to zero /a3 a3 a2 y3 mul sub store /z3 z3 z2 y3 mul sub store /y3 y3 y2 y3 mul sub store % /y3 0 store (\n\nforce y3 to zero) == rrr % normalize y3 to unity (solving for z) /z a3 z3 div store % solve for y by back substitution... /y a2 z2 z mul sub store % solve for x by back substitution... /x a1 z1 z mul sub y1 y mul sub store % solve for w by back substitution... /w a0 z0 z mul sub y0 y mul sub x0 x mul sub store % report the results (w = ) print w 20 string print (\n) print (x = ) print x 20 string cvs print (\n) print (y = ) print y 20 string cvs print (\n) print (z = ) print z 20 string cvs print (\n) print % check results {/w0 -3.997 store /x0 2.075 store /y0 -0.997 store /z0 1.436 store /a0 29.223 store /w1 2.345 store /x1 -0.654 store /y1 -8.231 store /z1 1.234 store /a1 -13.491 store /w2 -3.224 store /x2 12.223 store /y2 -1.06 store /z2 4.987 store /a2 1.342 store /w3 0.334 store /x3 -1.653 store /y3 2.724 store /z3 -7.003 store /a3 -13.365 store} pop -3.997 w mul 2.075 x mul add -0.997 y mul add 1.436 z mul add == 29.223 == 2.345 w mul -0.654 x mul add -8.231 y mul add 1.234 z mul add == -13.491 == -3.224 w mul 12.223 x mul add -1.06 y mul add 4.987 z mul add == 1.342 == 0.334 w mul -1.653 x mul add 2.724 y mul add -7.003 z mul add == -13.365 == } def %% solven04 %%%%%%%%%%%%% % original bilineal code (use for derivation and analysis only) % f(x,y) = f(0,0)(1-x)(1-y) + f(1,0)(x)(1-y) + % f(0,1)(1-x)(y) + f(1,1)(x)(y) % faster bileneal code enter with x.fract y.fract in yn array [(x0)(x1)(x2).. ] /dobilin { dup cvi dup /yi exch store sub /yr exch store dup cvi dup /xi exch store sub /xr exch store data yi get dup xi get 1 xr sub mul exch xi 1 add get xr mul add 1 yr sub mul data yi 1 add get dup xi get 1 xr sub mul exch xi 1 add get xr mul add yr mul add } store %%%%%%%%%%%%%% %%%%%%%%%%%%%% new stuff starts here % attempt to create an airbrush fill of a quadralateral area by finding % slightly larger bounding box, finding corner values, and then interpolating % infill pixels. %%%%%%%%%%%%%%%%%%%%%%%% % (A) Create a 50x50 pixel workspace as PS array of strings... /airimage [ 50 { (..................................................) 50 string cvs } repeat ] store airimage == (\n\n\n) print %%%%%%%%%%%%%%% % (B) place four data points /cornerdat [ (a) 3 7 (h) 13 45 (p) 40 42 (z) 26 6 ] store % temp revised /cornerdat [ (a) 3 3 (h) 39 4 (p) 8 41 (z) 46 46 ] store /placecornerdat { cornerdat aload pop 4 { airimage exch get 3 1 roll exch 0 get put} repeat } store placecornerdat airimage == (\n\n\n) print %%%%%%%%%%%%%%%%%%%%% % (C) find oversize bounding box and temporarily mark /xboxmin { cornerdat 1 get cornerdat 4 get 2 copy gt {exch} if pop cornerdat 7 get cornerdat 10 get 2 copy gt {exch} if pop 2 copy gt {exch} if pop 1 sub % make oversize } store /xboxmax { cornerdat 1 get cornerdat 4 get 2 copy lt {exch} if pop cornerdat 7 get cornerdat 10 get 2 copy lt {exch} if pop 2 copy lt {exch} if pop 1 add % make oversize } store /yboxmin { cornerdat 2 get cornerdat 5 get 2 copy gt {exch} if pop cornerdat 8 get cornerdat 11 get 2 copy gt {exch} if pop 2 copy gt {exch} if pop 1 sub % make oversize } store /yboxmax { cornerdat 2 get cornerdat 5 get 2 copy lt {exch} if pop cornerdat 8 get cornerdat 11 get 2 copy lt {exch} if pop 2 copy lt {exch} if pop 1 add % make oversize } store xboxmin == xboxmax == yboxmin == yboxmax == /tempmarkcorners { airimage yboxmin get xboxmin (o) 0 get put airimage yboxmin get xboxmax (o) 0 get put airimage yboxmax get xboxmin (o) 0 get put airimage yboxmax get xboxmax (o) 0 get put } store tempmarkcorners airimage == %%%%%%%%%%%%%%% % (D) Calculate corner values from inverse transform % repeating bilin... % f(x,y) = f(0,0)(1-x)(1-y) + f(1,0)(x)(1-y) + % f(0,1)(1-x)(y) + f(1,1)(x)(y) /findcornervalues { /xdel xboxmax xboxmin sub store % needed to normalize /ydel yboxmax yboxmin sub store /a0 cornerdat 0 get 0 get store % known point values as integers /a1 cornerdat 3 get 0 get store /a2 cornerdat 6 get 0 get store /a3 cornerdat 9 get 0 get store cornerdat 1 get xboxmin sub xdel div % find ll x and y cornerdat 2 get yboxmin sub ydel div 2 copy 1 exch sub exch 1 exch sub mul % (1-x)(1-y) /w0 exch store 2 copy 1 exch sub mul % (x)(1-y) /x0 exch store 2 copy exch 1 exch sub mul % (1-x)(y) /y0 exch store mul /z0 exch store % (x)(y) cornerdat 4 get xboxmin sub xdel div % find ll x and y cornerdat 5 get yboxmin sub ydel div 2 copy 1 exch sub exch 1 exch sub mul % (1-x)(1-y) /w1 exch store 2 copy 1 exch sub mul % (x)(1-y) /x1 exch store 2 copy exch 1 exch sub mul % (1-x)(y) /y1 exch store mul /z1 exch store % (x)(y) cornerdat 7 get xboxmin sub xdel div % find ll x and y cornerdat 8 get yboxmin sub ydel div 2 copy 1 exch sub exch 1 exch sub mul % (1-x)(1-y) /w2 exch store 2 copy 1 exch sub mul % (x)(1-y) /x2 exch store 2 copy exch 1 exch sub mul % (1-x)(y) /y2 exch store mul /z2 exch store % (x)(y) cornerdat 10 get xboxmin sub xdel div % find ll x and y cornerdat 11 get yboxmin sub ydel div 2 copy 1 exch sub exch 1 exch sub mul % (1-x)(1-y) /w3 exch store 2 copy 1 exch sub mul % (x)(1-y) /x3 exch store 2 copy exch 1 exch sub mul % (1-x)(y) /y3 exch store mul /z3 exch store % (x)(y) [xboxmin xboxmax yboxmin yboxmax xdel ydel a0 a1 a2 a3 (wx ---) w0 w1 w2 w3(xx ---) x0 x1 x2 x3 (yx ---) y0 y1 y2 y3 (zx ---) z0 z1 z2 z3] {==} forall solven04 % find w,x,y,z } store findcornervalues % report the results (w = ) print w 20 string cvs print (\n) print (x = ) print x 20 string cvs print (\n) print (y = ) print y 20 string cvs print (\n) print (z = ) print z 20 string cvs print (\n) print (a) 0 get == (h) 0 get == (p) 0 get == (z) 0 get == (\n\n\nbeginning infill mapping\n\n\n) print flush %%%%%%%%%%%%%%% % (E) Demo an infill mapping... /demomap { { /w w round cvi store /x x round cvi store /y y round cvi store /z z round cvi store } pop cornerdat 1 get cornerdat 2 get mt % make paint clipping path cornerdat 4 get cornerdat 5 get lineto cornerdat 10 get cornerdat 11 get lineto cornerdat 7 get cornerdat 8 get lineto closepath yboxmin 1 yboxmax {/cury exch store xboxmin 1 xboxmax {/curx exch store curx cury infill { airimage cury get curx (X) 0 get put } if } for } for } store demomap airimage == %%%%%%%%%%%%%%% % (F) Demo a real infill mapping... /realmap { /data [(w x)(y z)] store % normalize to unit square { /w w round cvi store /x x round cvi store /y y round cvi store /z z round cvi store } pop cornerdat 1 get cornerdat 2 get mt % make paint clipping path cornerdat 4 get cornerdat 5 get lineto cornerdat 10 get cornerdat 11 get lineto cornerdat 7 get cornerdat 8 get lineto closepath yboxmin 1 yboxmax {/cury exch store xboxmin 1 xboxmax {/curx exch store curx cury infill { findpaintvalue airimage cury get curx paintvalue put } if } for } for } bind store % /findpaintvalue treats the system as a unit square and interpolates /findpaintvalue { curx xboxmin sub xdel div cury yboxmin sub ydel div dobilin1 dup == round cvi /paintvalue exch store } store % new mapper /dobilin1 { /yfract exch store /xfract exch store 1 yfract sub 1 xfract sub mul w mul 1 yfract sub xfract mul x mul add yfract 1 xfract sub mul y mul add yfract xfract mul z mul add } bind store stopwatchon realmap stopwatchoff airimage == % check mapping (w = ) print w 20 string cvs print (\n) print (x = ) print x 20 string cvs print (\n) print (y = ) print y 20 string cvs print (\n) print (z = ) print z 20 string cvs print (\n) print /data [(w x)(y z)] store 0.000 0.000 dobilin1 == 0.9999 0.000 dobilin1 == 0.000 0.9999 dobilin1 == 0.9999 0.9999 dobilin1 == %% EOF % interpolation does not work. % premise: new interpolation code is sick % try old interpolation as a check