%!PS
% Revised avuncular sleezoid sleezoid2a.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
% The new Avuncular Sleezoid code is triply Distiller-GhostScript-GoogleEarth
% compatible and fullly exploits hsb color and is otherwise updated.
%%////// 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 { m dot} def
/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
/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 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
/plotsurface {
0.1 setlinewidth
0 1 numpoints div 1.0001 {/tt exch def xtt ytt moveto xxtt yytt
lineto stroke newcolor1} for } def
/newcolor1 { currenthsbcolor
/bb1 exch store
/ss1 exch store
/hh1 exch
hueinc add
dup 1 ge {pop 0}if
store
hh1 ss1 bb1 sethsbcolor
} store
/drawsleezoid {
gsave % save graphics state
45 450 translate % position on page
16 dup scale % set size
-90 rotate % orientatify
0.07 setlinewidth % set thickness
0 0 moveto 1 18 9 -8 10 10 pcurveto1 stroke % draw first spline
-5 9 moveto 20 23 -10 48 10 17 pcurveto2 stroke % draw second spline
0 0 moveto -5 9 rlineto stroke % far edge trim
10 10 moveto 10 17 lineto stroke % near edge trim
0 setlinewidth plotsurface % create the surface
grestore % restore state
} store
% ////// demo - remove or alter before reuse /////
/numpoints 1200 store
196 setwebtint
/hueinc 0.0007 store
drawsleezoid
showpage
% eof