🚀 go-pugleaf

A new version of hexroot (draw 3d hexagons on NeWS/OpenWindows root window)...

When Lupe Christoph <lupe@ukw.uucp> reported an error running hexroot,
Mark Smith <smith@canon.co.uk> helpfully suggested adding ClassFramebuffer pop
after the packages are loaded.

In fact there are a couple of other changes, so since it's not all that big,
here's an updated version.  Tested on OpenWindows 3 *and* OpenWindows 2.
The default colours are slightly better in OW3, though.

Also, this version has better-shaped hexagons.

Lee

-- 
Liam Quin, lee@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer
  lq-text (Unix text retrieval pacakge) mailing list: lq-text-request@sq.com
  latest released version: 1.10; ftp: ftp.cs.toronto.edu in directory: pub
  If Adultery is for Adults, is Juvenal for Juveniles?

#! /bin/sh
: To unbundle, sh this file
echo x - hexroot 1>&2
sed 's/^X//' >hexroot <<'@@@End of hexroot'
X#! /bin/sh
X
X
Xpsh "$@" << 'END_OF_FILE'
X
X%!PS
X/V2? version cvi 2 eq def
X 
XV2? not {
X    /NeWS 3 0 findpackage beginpackage
X    /TNTCore 3 0 findpackage beginpackage
X    /TNT 3 0 findpackage beginpackage
X} if
X 
Xtrue setpacking
XClassFramebuffer pop % ensure framebuffer class is autoloaded
X
Xstatusdict begin 500 setjobtimeout end % this is plenty of time...
X
X
X%% Things you can change easily:
X
X% The size of hexagons; change the "40" to another number if you want;
X% it's the width of one flat side of a hex, in approx. 72dpi pixels
X/HexHWidth 40 def
X
X% If you leave the next line in place, the hexes will stay; if you comment
X% it out by putting a % at the start of the line, the next time the screen
X% is redrawn the hexes will vanish; the latter option saves a lot of memory.
Xframebuffer /Retained true put
X
X% HexChance should be between 0 (boring) and 1 (all hexagons drawn):
X/HexChance 0.7 def % the probability of drawing a hexagon
X
X% Colours:
X% we use FG, BG0, BG, BG2, BG3 -- on black & white screens they're dithered.
X% If you want some other set of colours, you can change them here:
X/MakeColours {
X    V2? {
X	% OpenWindows 2 (I have not tested this in colour)
X	/FG   0   0  0   hsbcolor def
X	/BG0  .6  .2 1   hsbcolor def
X	/BG   .6  .3 1   hsbcolor def
X	/BG2  .6  .3 .75 hsbcolor def
X	/BG3  .6  .3 .3  hsbcolor def
X    } {
X	%% OpenWindows 3 and later:
X	% remove the % on the next line if you want to give yor own colours:
X	% .9 .95 .4 rgbcolor  .7 .2 .9 rgbcolor /setcolors framebuffer send
X	% the numbers are red, green, blue
X	% Or this, using hue-saturation-brightness
X	.6 1 .6 hsbcolor  .6 .3 1 hsbcolor /setcolors framebuffer send
X	% see the TNT 3.0 manual p. 41
X    } ifelse
X} def
X
X%% You probably shouldn't change anything below here unless you are know at
X%% least a little about NeWS and Postscript.  But it's your copy :-)
X%%
X%%
X
X
X%% Random distributions
X%% This is because NeWS in OW3 lacks "srand"... and OW2 had 16 bit ints...
X
XV2? {
X    /X currenttime 211 mul 31 div cvi def
X} {
X    /X currenttime 1 get 12 mul 211 div def
X} ifelse
X
X/theSeed X def
X
X/random { %  -  random  number-between-0-and-1
X    % see Knuth _Art of Computer Programming_ vol 2 p. 156
X    /X 32573 X mul 6883 add cvi def
X    /X X 32768 mod def
X    X 32768 div % the result
X} def
X
X/HexDWidth HexHWidth 2 div 3 add def
X/HexDHeight HexHWidth 3 sqrt mul 2 div def
X
X/HexWidth HexDWidth 2 mul HexHWidth add def
X/HexHeight HexDHeight 2 mul def
X
X/Hex3DDict 12 dict def
X
X/MakeHex {
X    Hex3DDict begin
X	/p0y exch def /p0x exch def
X	/p1x HexDWidth p0x add def /p1y  HexDHeight p0y add def
X	/p2x HexHWidth p1x add def /p2y p1y def
X	/p3x HexDWidth p2x add def /p3y p0y def
X	/p4x p2x def /p4y p0y HexDHeight sub def
X	/p5x p1x def /p5y p4y def
X    end
X} def
X
X/Draw3DHex {
X    Hex3DDict begin
X	0 setlinewidth
X	newpath p0x p0y moveto
X	p1x p1y lineto
X	p2x p2y lineto
X	p3x p3y lineto
X	p4x p4y lineto
X	p5x p5y lineto
X	gsave
X	    % the interior of the hexagon:
X	    BG setcolor fill
X	grestore
X	gsave
X	    % Now the borders:
X	    clip % so we don't affect neighbours
X
X	    % reminder: hex points are numbered clockwise starting with
X	    % the left-most one being 0.
X
X	    newpath
X
X	    % the border width - half of this will be clipped.
X	    HexHWidth 4 div setlinewidth
X
X	    % top left highlighted:
X	    p0x p0y moveto 
X	    p1x p1y lineto
X	    p2x p2y lineto
X	    BG0 setcolor stroke
X
X	    % diagonal - BG2
X	    p2x p2y moveto
X	    p3x p3y lineto
X	    p5x p5y moveto
X	    p0x p0y lineto
X	    BG2 setcolor stroke
X
X	    % bottom shadow - BG3
X	    p3x p3y moveto
X	    p4x p4y lineto
X	    p5x p5y lineto
X	    gsave
X		BG3 setcolor stroke
X	    grestore
X	    gsave % on black & white systems, this makes a big improvement:
X		strokepath % stroke the outline of the weak shadow.
X		FG setcolor 1 setlinewidth stroke
X	    grestore
X
X	grestore
X	gsave 
X	    2 setlinewidth
X	    % BG3 setcolor stroke
X	    0 0 0 rgbcolor setcolor stroke
X	grestore
X    end
X} def
X
X/DrawBoard { % width height DrawBoard -
X    6 dict begin
X	/BoardHeight exch def
X	/BoardWidth exch def
X	/x HexDWidth neg def
X	/y HexHeight 2 div neg def
X	/Indent 0 def
X
X	0 HexDWidth HexHWidth add BoardWidth {
X	    pop
X	    /y Indent def
X
X	    0 HexHeight BoardHeight {
X		pop
X		x y MakeHex
X		random HexChance lt {
X		    Draw3DHex
X		} if
X		/y y HexHeight add def
X	    } for
X
X	    /x x HexDWidth HexHWidth add add def
X
X	    Indent 0 eq {
X		/Indent HexDHeight neg def
X	    } {
X		/Indent 0 def
X	    } ifelse
X	} for
X    end
X} def
X
Xframebuffer dup setcanvas begin
X    save % so the colour change doesn't affect other processes...
X	MakeColours
X
X	gsave % fill the background
X	    clippath BG setcolor fill
X	grestore
X
X	% canvas size -- TNT 3.0 Ref. p. 49
X	clippath pathbbox HexDHeight add
X	% exch 2 div exch % only draw half for speed in testing
X	DrawBoard pop pop
X    restore
Xend
X
X% disconnect from the NeWS server:
X
Xnewprocessgroup
XV2? not {
X    endpackage  % TNT
X    endpackage  % TNTCore
X    endpackage  % NeWS
X} if
Xcurrentfile closefile
X
XEND_OF_FILE
X
Xexit $?
@@@End of hexroot
chmod +x hexroot
echo end of archive
exit 0



-- 
Liam Quin, lee@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer
  lq-text (Unix text retrieval pacakge) mailing list: lq-text-request@sq.com
  latest released version: 1.10; ftp: ftp.cs.toronto.edu in directory: pub
  If Adultery is for Adults, is Juvenal for Juveniles?