🚀 go-pugleaf

Here is HexSweeper 1.66.  It's a lot faster than 1.0 at many things,
and somewhat more playable as a game.

HexSweeper is a game a bit like the VMS (or Microsoft Windows) minesweeper
game, except that instead of a rectangular grid there's a grid of hexagons.

Known problems:
    * There's no high score yet, and no Properties window.
    * Do not go directly from Texas Scale to Welsh Cottage Scale!
      (perhaps the program should prevent this)
 
If you do get a problem, press L1 (STOP) if the mouse stops working, and
then either use pskill or pam to get rid of the Hex ps processes.  I can
mail you an effective pskill if you don't have it.

Don't be discouraged by that warning - HexSweeper is fun to play with,
and it works in both colour and mono.  It uses your Window colour, so if
you want, bring up props (Workspace menu->Properties) and change the colours!

Please tell me if you try HexSweeper.

Lee
lee@sq.com

#! /bin/sh
: To unbundle, sh this file
echo x - hexsweeper 1>&2
sed 's/^X//' >hexsweeper <<'@@@End of hexsweeper'
X#! /usr/openwin/bin/psh -i
X
X% $Id: hexsweeper,v 1.67 92/08/29 00:59:56 lee Exp $
X/MyName (HexSweeper 1.66) def
X
X/NeWS 3 0 findpackage beginpackage
X/TNTCore 3 0 findpackage beginpackage
X/TNT 3 0 findpackage beginpackage
X% /debug 1 0 findpackage beginpackage
X
Xstatusdict begin 1200 setjobtimeout end
X
Xtrue setpacking
X
X/MineDict 20 dict dup begin
X    /SecondsSoFar 0 def
X    /Counting false def
X    /MineCount 0 def
X    /MineRows -1 def
X    /MineCols -1 def
Xend def
X
X/HexTimerProcess {
X    currentprocess /ProcessName (HexTimer) put
X    MineDict begin
X    [3 0] sleep
X    {
X	pause [1 0] sleep
X	Counting
X	{
X	    createevent dup begin
X		/Name /HexTimerEvent def
X		/Action (HexTimerEvent) def
X	    end
X	    sendevent
X	} if
X	pause
X    } loop
X} fork def
X
X/sqrt3 3 sqrt def
X
X/Hex3DDict 12 dict def
X/Hex3DInnerDict 12 dict def
X
X/SetHexSizeFromFlat {
X    /HexHWidth exch def
X    /HexDWidth HexHWidth 2 div def
X    /HexDHeight HexHWidth sqrt3 mul 2 div def
X    /HexHDelta HexDWidth HexHWidth add def
X    /HexWidth HexDWidth 2 mul HexHWidth add def
X    /HexHeight HexDHeight 2 mul def
X    /HexDepth HexHWidth 7 div cvi dup 0 eq { pop 1 } if def
X    MakeGlyphs
X} def
X
X/HexFont { /GillSans } def
X/HexBoldFont { /Rockwell-Bold } def
X
X% TNT display items for glyphs:
X/MakeGlyphs {
X    /BombGlyph [ (\154) ] def
X    /SetBombFont { /ZapfDingbats findfont HexHWidth scalefont setfont } def
X    /WrongMarkGlyph [
X	(\067)
X	/ZapfDingbats findfont HexWidth scalefont % pretty huge...
X	1 0 0 rgbcolor
X    ] def
X    /MarkGlyph [(\076) /ZapfDingbats findfont HexWidth scalefont ] def
X
X    framebuffer /Color get {
X	/0Glyph ( ) def %% actually never used
X	/1Glyph [(1) HexFont findfont HexWidth 1.5 div scalefont
X	    0 0 1 rgbcolor ] def
X	/2Glyph [(2) HexFont findfont HexWidth scalefont
X	    0 1 0 rgbcolor ] def
X	/3Glyph [(3) HexFont findfont HexWidth scalefont
X	    0 1 1 rgbcolor ] def
X	/4Glyph [(4) HexBoldFont findfont HexWidth scalefont
X	    1 0 1 rgbcolor ] def
X	/5Glyph [(5) HexBoldFont findfont HexWidth scalefont
X	    1 .9 0 rgbcolor ] def
X	/6Glyph [(6) HexBoldFont  findfont HexWidth 1.5 mul scalefont
X	    0.8 0 0 rgbcolor ] def
X    } {
X	/0Glyph ( ) def
X	/Black 0 0 0 rgbcolor def
X	/1Glyph [(1) HexFont findfont HexWidth 1.5 div scalefont Black ] def
X	/2Glyph [(2) HexFont findfont HexWidth scalefont Black ] def
X	/3Glyph [(3) HexFont findfont HexWidth scalefont Black ] def
X	/4Glyph [(4) HexBoldFont findfont HexWidth scalefont Black ] def
X	/5Glyph [(5) HexBoldFont findfont HexWidth scalefont Black ] def
X	/6Glyph [(6) HexBoldFont findfont HexWidth 1.5 mul scalefont Black ] def
X    } ifelse
X
X    /GlyphArray [ 0Glyph 1Glyph 2Glyph 3Glyph 4Glyph 5Glyph 6Glyph ] def
X} def
X
X%%%% Default hex size
X
X25 SetHexSizeFromFlat
X
X/FindHexWestPoint { % x y FindHexWestPoint -> x y of p0
X    12 dict begin
X	% transform coordinates so the centre of hex 0,0 is at 0,0:
X	/y exch HexDHeight sub def
X	/x exch HexWidth 2 div sub def
X
X	% find a 60 degree line to the left of (x, y)
X	% that intersects the x axis at a multiple of HWidth units
X
X	%		+
X	%	       /|
X	%	      / |	 Angle t is 60 degrees, so
X	%	     /  | y	 x - x1 = y/sqrt3
X	%	    /t) |
X	%	   +----+ . . .+
X	%	   x1	x 	x2 [see below]
X
X	% (calculate x1 and round down to a multiple of HexHWidth)
X	/x1 x y sqrt3 div sub HexHWidth div dup 0 lt {
X	    /a exch def 
X	    a cvi dup a eq not {
X		1 sub
X	    } if
X	} {
X	    cvi
X	} ifelse def
X
X	% Now we do the same in the other direction:
X	/x2 y sqrt3 div x add HexHWidth div dup 0 lt {
X	    /a exch def 
X	    a cvi dup a eq not {
X		1 sub
X	    } if
X	} {
X	    cvi
X	} ifelse def
X
X	% intersect the two lines:
X	/x3 x2 x1 add 2 div HexHWidth mul def
X	/y3 x2 HexHWidth mul x3 sub sqrt3 mul def
X
X	% A debugging triangle:
X	% 2 setlinewidth 0 setgray x1 HexHWidth mul 0 moveto x3 y3 lineto stroke
X	% 1 setgray x2 HexHWidth mul 0 moveto x3 y3 lineto stroke
X	% x 0 moveto x y lineto stroke
X
X	% Now we check that the intersection will be a West point:
X	x1 x2 add 3 mod 3 add 3 mod {
X	    0 { % found a centre
X		/x1 x1 1 sub def
X		/x2 x2 1 sub def
X	    }
X	    1 {
X		% it's perfect!
X	    }
X	    2 {
X		% found a top left or bottom left corner.
X		% intersect the two lines:
X		y3 y lt {
X		    /x1 x1 1 sub def
X		} {
X		    /x2 x2 1 sub def
X		} ifelse
X	    }
X	} case
X
X	/x3 x2 x1 add 2 div HexHWidth mul def
X	/y3 x2 HexHWidth mul x3 sub sqrt3 mul def
X
X	% Another debugging triangle:
X	% 0 setlinewidth 0 setgray x1 HexHWidth mul 0 moveto x3 y3 lineto stroke
X	% 1 setgray x2 HexHWidth mul 0 moveto x3 y3 lineto stroke
X
X	x3 HexWidth 2 div add
X	y3 HexDHeight add
X    end
X} def
X
X/MakeHex {
X    /p0y exch def
X    /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} def
X
X/Draw2DHexAt {
X    Hex3DDict begin
X	% x y of Western (leftmost) point
X
X	canvas1 setcanvas
X	2 copy moveto % p0
X	/p0y exch def
X	/p0x exch def
X
X	HexDWidth HexDHeight rlineto % p1
X	HexHWidth 0 rlineto % p2
X	HexDWidth HexDHeight neg rlineto % p3
X	p0x HexHDelta add  p0y HexDHeight sub lineto % p4
X	p0x HexDWidth add  p0y HexDHeight sub lineto
X	gsave
X	    clip
X
X	    pause pause pause
X	    clippath BG2 setcolor fill
X	grestore
X	% pause pause pause
X	    % gsave
X	    % 1 setlinewidth FG setcolor stroke 
X	    % pause pause pause
X	% grestore
X    end
X} def
X
X/OldDraw2DHexAt {
X    Hex3DDict begin
X	MakeHex
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	    BG2 setcolor fill
X	grestore
X	gsave
X	    1.2 setlinewidth FG setcolor closepath stroke 
X	grestore
X% gsave % 
X% p0x p0y
X% SetBombFont exch HexWidth 2 div add exch % x y of centre of hex
X% FG setcolor (X) DisplayItemSize % x y w h
X% 2 div neg exch 2 div neg exch xyadd moveto (X) DisplayItemPaint
X% grestore
X    end
X} def
X
X/Draw3DHexAt {
X    Hex3DDict begin
X	MakeHex
X
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	clip
X	clippath BG setcolor fill
X
X 	HexDepth 2 mul setlinewidth
X
X	p0x p0y moveto 
X	p1x p1y lineto
X	p2x p2y lineto
X	BG0 setcolor stroke
X
X	p2x p2y moveto
X	p3x p3y lineto
X	p5x p5y moveto
X	p0x p0y lineto
X	BG2 setcolor stroke
X
X	p3x p3y moveto
X	p4x p4y lineto
X	p5x p5y lineto
X	BG3 setcolor stroke
X	initclip
X	HexHWidth 30 gt {
X	    gsave
X		0 setlinewidth
X		FG setcolor stroke
X	    grestore
X	} if
X    end
X} def
X
X
X/ClearMines { % rows cols ClearMines -
X    /MineBoard growabledict def
X    /PlacesBeen growabledict def
X    % Rows Cols
X    mul dup array % n array
X    MineDict exch % n Dict array
X    /NearbyMines exch put
X    % n 
X    1 sub -1 0 {
X	MineDict /NearbyMines get exch 0 put
X    } for
X} def
X
X/RecomputeNeighbours {
X    % (Computing neighbours for % by %)[MineDict /MineRows get 1 sub MineDict /MineCols get 1 sub]sprintf ==
X    /NeighboursDict growabledict def
X
X    8 dict begin
X	gsave
X	    canvas1 setcanvas
X	    bbox /ht exch def /wd exch def pop pop
X	    
X	    /Rockwell-Bold findfont 70 scalefont setfont
X	    /s (HEXSWEEPER!) def
X	    s DisplayItemSize 2 div neg exch 2 div neg exch 
X	    wd 2 div ht 2 div xyadd moveto
X	    s DisplayItemPaint
X
X	    /MaxCol MineDict /MineCols get 1 sub def
X	    /MaxRow MineDict /MineRows get 1 sub def
X
X	    % Do edges, but not the corners:
X	    1 1 MaxRow 1 sub {
X		/Row exch def
X		% Left edge:
X		NeighboursDict 0 Row (%-%) sprintf
X		[ null		[ Row 1 add  0] [Row 1]
X		  [Row 1 sub 1]	[ Row 1 sub  0] null ] put
X		% Right edge:
X		NeighboursDict MaxCol Row (%-%) sprintf
X		MaxCol 2 mod 0 eq {
X		    % even
X		    [ [Row MaxCol 1 sub] [Row 1 add MaxCol] null
X		      null [Row 1 sub MaxCol] [Row 1 sub MaxCol 1 sub]
X		    ]
X		} {
X		    % odd
X		    [ [Row 1 add MaxCol 1 sub] [Row 1 add MaxCol] null
X		      null  [Row 1 sub MaxCol] [Row MaxCol 1 sub]
X		    ]
X		} ifelse put
X
X		% now the intermediate columns:
X		1 1 MaxCol 1 sub {
X		    /Col exch def
X		    NeighboursDict
X			Col Row (%-%) sprintf
X			Col 2 mod 0 eq {
X			    [
X				[Row Col 1 sub] [Row 1 add Col]
X				[Row  Col 1 add] [Row 1 sub Col 1 add]
X				[Row 1 sub Col] [Row 1 sub Col 1 sub]
X			    ]
X			} {
X			    [
X				[Row 1 add  Col 1 sub] [Row 1 add  Col]
X				[Row 1 add  Col 1 add] [Row  Col 1 add]
X				[Row 1 sub Col] [Row Col 1 sub]
X			    ]
X			} ifelse
X		    put
X		} for
X
X		pause
X		random 0.2 ge {
X		    random Rows 1 add mul cvi
X		    random Cols 1 add mul cvi
X		    CoordsToPoint Draw3DHexAt
X		} if
X	    } for
X
X	    % now do the corners and top and bottom rows:
X	    0 1 MaxCol {
X		/Col exch def
X		NeighboursDict dup
X		    Col 0 (%-%) sprintf
X		    0 Col FindNeighbours
X		put
X		    Col MaxRow (%-%) sprintf
X		    MaxRow Col FindNeighbours
X		put
X	    } for
X
X	grestore
X    end
X} def
X
X/GetNearbyMines { % Row Col GetNearbyMines n
X    6 dict begin
X	/Col exch def
X	/Row exch def
X	/Rows MineDict /MineRows get def
X	/Cols MineDict /MineCols get def
X	    Col Cols ge Row Rows ge or
X	    Col 0 lt Row 0 lt or
X	or {
X	    (Tried to look at Row % Col %, max is Row % Col %)
X	    [Row Col Rows Cols] sprintf ==
X	    0
X	} {
X	    MineDict /NearbyMines get % array
X	    Row  Col Rows mul add  get % int or null
X	} ifelse
X    end
X} def
X
X/AddNearbyMine { % Row Col -
X    4 dict begin
X	/Col exch def
X	/Row exch def
X	/Rows MineDict /MineRows get def
X	/Cols MineDict /MineCols get def
X	MineDict /NearbyMines get dup % array
X	Row  Col Rows mul add  get % array int or null
X	dup null eq {
X	    pop 1
X	} {
X	    1 add
X	} ifelse
X	% Array value
X	Row  Col Rows mul add exch % Array index value
X	put % int or null
X    end
X} def
X
X/GetNeighbours {
X    exch (%-%) sprintf dup % name name
X    NeighboursDict exch known { % name 
X	NeighboursDict exch get
X    } {
X	pop [null null null null null null]
X    } ifelse
X} def
X
X/CheckInRange { % x y -> bool
X    4 dict begin
X	FindHexWestPoint % x' y'
X	PointToCoords
X	/Col exch def
X	/Row exch def
X
X	/Rows MineDict /MineRows get def
X	/Cols MineDict /MineCols get def
X
X	Col Cols ge Row Rows ge or    Col 0 lt Row 0 lt or
X	or % true if out or range
X	not % true iff in range
X    end
X} def
X
X/PointToCoords { % x y PointToCoords Row Col
X    % Note: the point must be the Westernmost corner of the Hex
X    exch % y x
X    HexHDelta div cvi % y y Col
X    dup 2 mod 1 eq { % y Col
X	exch % Col y
X	HexDWidth sub
X    } {
X	exch % Col y
X    } ifelse % Col y
X    HexDWidth sub
X    HexHeight div
X    dup 0 lt { 1 sub } if
X    cvi
X    exch
X} def
X
X/DoAutoWalk { % Row Col DoAutoWalk -
X    %%
X    %% Called when we find that we have landed on a hexagon with no
X    %% nearby mines (GetNearbyMines returned 0).  We have already been
X    %% drawn flat at this point.
X    %%
X    %% We flatten each of the neighbours.  If any neighbour has
X    %% no nearby mines, we repeat the process for that neighbour.
X    %%
X    /busy /setcursor window1 send
X    7 dict begin
X	/OnStack growabledict def
X
X	mark
X	3 1 roll % mark Row Col
X
X	{
X
X	    dup mark eq { pop exit } if
X
X	    % mark Row Col (and maybe Row Col Row Col...)
X	    2 copy (%-%) sprintf /NAME exch def
X	    PlacesBeen NAME true put
X
X% gsave
X% 6 setrasteropcode
X% SetBombFont
X% 2 copy CoordsToPoint % x y
X% exch HexWidth 2 div add exch % x y of centre of hex
X% (X) DisplayItemSize % x y w h
X% 2 div neg exch 2 div neg exch xyadd moveto (X) DisplayItemPaint
X% grestore
X
X	    % Row Col
X	    /C exch def
X	    /R exch def
X	    R C GetNeighbours % Array
X	    0.5 random gt { arrayreverse } if
X	    {
X		dup null eq {
X		    pop
X		} {
X		    aload pop
X		    % Try to reject as many neighbours as possible as soon as
X		    % possible...
X
X		    % Row Col
X		    2 copy (%-%) sprintf dup dup
X		    % Row Col name name name
X		    OnStack exch known % Row Col name name bool
X		    exch PlacesBeen exch known % Row Col name bool bool
X		    or {
X			%% Either already decided to look here, or already
X			%% visited here...
X			% Row Col name
X			pop pop pop
X		    } {
X			% Row Col Name
X			/N exch def
X
X			% Row Col
X			2 copy GetNearbyMines % Row Col n
X			/n exch def
X			2 copy CoordsToPoint % Row Col x y
X
X			n 0 eq {
X			    % Row Col x y
X			    Draw2DHexAt
X			    % Row Col
X			    /Needed true def
X
X			    % If there is a neighbour of this hex that
X			    % has zero nearby mines and is on the stack,
X			    % and is not (R, C), we don't need to
X			    % put _this_ one on the stack
X			    2 copy GetNeighbours {
X				dup null eq {
X				    pop
X				} {
X				    aload pop % row col
X				    % check it's not the starting hex:
X				    2 copy C ne exch R ne or
X				    % row col bool
X				    3 1 roll (%-%) sprintf % bool name
X				    OnStack exch known % bool bool
X				    and {
X					/Needed false def
X					exit
X				    } if
X				} ifelse
X				pause
X			    } forall
X			    Needed {
X				OnStack N true put
X			    } {
X				pop pop
X			    } ifelse
X			} {
X			    n DrawHexGlyphAt
X			    PlacesBeen N true put
X			    pop pop
X			} ifelse
X		    } ifelse
X		} ifelse
X	    } forall
X
X	    OnStack NAME undef
X	    pause pause pause
X
X	} loop
X    end
X    /basic /setcursor window1 send
X} def
X
X/FlattenHex { % x y n FlattenHex -
X    3 1 roll % n x y
X    2 copy Draw2DHexAt % -
X    % n x y 
X    3 -1 roll dup 0 eq {
X	pop pop pop
X    } {
X	% x y n
X	DrawHexGlyphAt
X    } ifelse
X} def
X
X/DrawHexGlyphAt { % x y n -
X    GlyphArray exch get % x y DisplayItem
X    3 1 roll % DI x y
X    2 copy OldDraw2DHexAt % DI x y
X    exch HexWidth 2 div add exch % (N) x' y
X    moveto % (n)
X    dup DisplayItemSize 2 div neg exch 2 div neg exch rmoveto
X    DisplayItemPaint
X} def
X
X/FindNeighbours { % row col FindNeighbours [ [x y] null null null null null ]
X    6 dict begin
X	/Col exch def
X	/Row exch def
X	/Z Col 2 mod def
X	/Neighbours [ null null null null null null ] def
X	Col 0 gt {
X	    Neighbours 0 [ Row Z add 	Col 1 sub ] put
X	    Neighbours 5 [ Row 1 sub Z add	Col 1 sub ] put
X	} if
X	Col MineDict /MineCols get 1 sub lt {
X	    Neighbours 2 [ Row Z add	Col 1 add ] put
X	    Neighbours 3 [ Row Z add 1 sub	Col 1 add ] put
X	} if
X	Row 0 gt {
X	    Neighbours 4 [ Row 1 sub	Col ] put
X	} {
X	    Z 0 eq {
X		Neighbours 3 null put
X		Neighbours 5 null put
X	    } if
X	} ifelse
X	Row MineDict /MineRows get 1 sub lt {
X	    Neighbours 1 [ Row 1 add	Col ] put
X	} {
X	    Z 1 eq {
X		Neighbours 0 null put
X		Neighbours 2 null put
X	    } if
X	} ifelse
X	Neighbours
X    end
X} def
X
X/CoordsToPoint {
X    dup 2 mod 0 eq {
X	HexDHeight
X    } {
X	HexHeight
X    } ifelse
X    3 1 roll % offset Row Col
X
X    HexHDelta mul % offset Row x
X    exch HexHeight mul % x bottom-of-hex-if-odd
X
X    3 -1 roll add % x y
X} def
X
X/VisualEffectForWinning {
X    gsave
X	6 setrasteropcode
X	Color { 2 } { 5 } ifelse % it's faster in mono!
X	{
X	    clippath fill
X	    pause
X	    [0 1000000 20 div cvi] sleep
X	    clippath fill
X	} repeat
X    grestore
X} def
X
X/VisualEffectForLosing {
X    gsave
X	6 setrasteropcode
X	Color { 2 } { 5 } ifelse % it's faster in mono!
X	{
X	    clippath fill
X	    pause
X	    [0 1000000 20 div cvi] sleep
X	    clippath fill
X	} repeat
X    grestore
X    % I don't think I like the fissures very much:
X    % gsave
X	% newpath
X	% DrawFissures
X    % grestore
X} def
X
X/MakeFissure { % x y length angle thickness -> -
X    MineDict begin 
X	/FissureCount FissureCount 1 add def
X	FissureCount (F%) sprintf % construct a key
X    end % key
X    FissureDict exch 6 dict dup % + dict key value value
X    4 1 roll % value dict key value
X    put
X    % value
X    begin % x y length angle thickness
X	/Thickness exch def
X	/Angle exch def
X	/Length exch def
X	/y exch def
X	/x exch def
X    end
X} def
X
X/DrawFissures { % x y -
X    % initialise
X    /FissureDict growabledict def
X    MineDict /FissureCount 0 put
X
X    % Makefissures
X    4 {
X	% x y
X	2 copy
X	75 random mul random mul % length
X	360 random mul
X	HexDepth 2 mul 1 random random mul sub mul
X	MakeFissure
X    } repeat
X
X    pop pop
X
X    % draw the fissures spreading out
X    {
X	MineDict /FissureCount get 0 le { exit } if
X
X	FissureDict {
X	    % name dict
X	    begin
X		% name
X		Thickness setlinewidth
X		x y moveto
X		/x Length  Angle cos  mul x add def
X		/y Length  Angle sin  mul y add def
X		x y lineto stroke
X		/Angle Angle 90 random mul 45 sub add def
X		/Thickness Thickness 1 random random mul sub mul def
X		/Length Length 1 random random mul sub def
X		% name
X		mark exch
X		Length 5 lt   Thickness 0.1 le  or
X	    end % name bool
X
X	    {
X		% name
X		FissureDict exch undef
X		MineDict /FissureCount get 1 sub % n
X		MineDict /FissureCount 3 -1 roll put
X	    } {
X		pop % don't care about the the name
X	    } ifelse
X	    [ 0 50000 ] sleep
X	    pause pause pause
X	    mark ne {
X		deary me
X	    } if
X	} forall
X
X	MineDict /FissureCount get 0 le { exit } if
X
X	0.01 random lt {
X	    FissureDict dup
X	    MineDict /FissureCount get 1 add random mul cvi
X	    (F%) sprintf dup
X	    % dict dict key key
X	    3 1 roll known {
X		% dict key
X		get begin
X		    x y
X		    Length .75 mul
X		    Angle 90 random mul 45 sub add
X		    Thickness
X		end
X		MakeFissure
X	    } {
X		pop pop
X	    } ifelse
X	} if
X
X    } loop
X} def
X
X/ShowMines {
X    gsave
X	SetBombFont
X	MineBoard {
X	    % /Key Value
X	    aload pop
X	    CoordsToPoint
X	    % /Key x y
X	    exch HexWidth 2 div add exch 
X	    % x y of centre of hex
X	    BombGlyph DisplayItemSize % x y w h
X		2 div neg exch 2 div neg exch
X	    xyadd moveto
X	    BombGlyph DisplayItemPaint
X	    pop % get rid of /Key
X	} forall
X    grestore
X} def
X
X/IsThereAMineHere? { % Row Col -> bool
X    (%-%) sprintf
X    % name 
X    MineBoard exch known
X    % bool
X} def
X
X/LayMines { % rows cols n_mines LayMines -
X    10 dict begin
X	/n exch def
X	n 0 le {
X	    /n 1 def
X	} if
X	/Rows MineDict /MineRows get def
X	/Cols MineDict /MineCols get def
X
X	(New Game...) (%...)[n] sprintf /setfooter window1 send
X
X	/MineCount n def
X	{
X	    n 0 eq { exit } if
X
X	    % Lay one mine
X	    random Rows mul  cvi
X	    random Cols mul  cvi
X	    2 copy % Row Col Row Col
X	    2 copy % Row Col Row Col Row Col
X	    (%-%) sprintf dup % Row Col name name
X
X	    MineBoard exch known {
X		% It's already there...
X
X		% Row Col Row Col name
X
X		pop pop pop pop pop
X		% let other things run if we're checking the same cell a lot:
X		pause pause pause
X	    } {
X		% Row Col Row Col name
X		3 1 roll % row col name row col
X		2 array astore % row col name [row col]
X		MineBoard 3 1 roll % row col dict name [row col]
X		put % Row Col
X		GetNeighbours {
X		    dup null eq {
X			pop
X		    } {
X			aload pop
X			% AddNearbyMine:
X			2 copy Rows mul add % index
X			MineDict /NearbyMines get exch get
X			1 add
X			% Row Col value
X			3 1 roll % value Row Col
X			Rows mul add % value index
X			exch % index value
X			MineDict /NearbyMines get % index value array
X			3 1 roll
X			% Array index value
X			put
X		    } ifelse
X		} forall
X		/n n 1 sub def
X		n 16 mod 2 eq {
X    (New Game...) (Laying % Mines)[n] sprintf /setfooter window1 send
X		} if
X		pause 
X	    } ifelse
X	} loop
X
X	MineDict /MineCount MineCount put
X    end
X} def
X
X/HelpCanvas ClassCanvas
Xdictbegin
X    /vspace 18 def
X    /textsize 16 def
Xdictend
Xclassbegin
X    % stolen shamelessly from $OPENWINHOME/demo/fontview
X    /minsize {
X	300 385
X    } def
X
X    /firstline {
X	10 354 moveto
X    } def
X
X    /nextline {
X	currentpoint exch pop
X	vspace sub 10 exch moveto
X    } def
X
X    /BackgroundColor {
X	Color {
X	    BG
X	} {
X	    1 1 1 rgbcolor
X	} ifelse
X	dup /BackgroundColor exch promote
X    } def
X
X    /Paint {
X	BackgroundColor FillCanvas
X
X	ForegroundColor setcolor
X	/Palatino-Roman findfont textsize scalefont setfont
X
X	firstline (HexSweeper) show
X	nextline (Copyright )
X	/Symbol findfont textsize scalefont setfont (\343) show
X	/Palatino-Roman findfont textsize scalefont setfont
X	( Liam Quin, 1992) show
X
X	nextline ( ) show
X	nextline (HexSweeper is a version of the VMS) show
X	nextline (minesweeper game for OpenWindows 3.) show
X	nextline ( ) show
X
X	nextline (The game window shows a number of) show
X	nextline (hexagons.  There are explosive mines) show
X	nextline (under some of them.  You must put a) show
X	nextline (Mark \(with the `m' key\) over every) show
X	nextline (mine, but ) show
X	currentfont
X	/Palatino-Italic findfont textsize scalefont setfont
X	(not) show
X	setfont
X	( over any empty hexagons.) show
X	nextline (In order to help you, when you step on) show
X	nextline (a hexagon \(press the left mouse buttom) show
X	nextline (over a it, or press the space bar\) the) show
X	nextline (number of mines under the adjoning) show
X	nextline (hexagons will be shown.  If there are no) show
X	nextline (nearby mines, you could step safely on) show
X	nextline (all of the nearby hexagons, but that) show
X	nextline (would be tedious, so HexSweeper does) show
X	nextline (it for you.) show
X    } def
Xclassend def
X
X/ShowHelp {
X    /reshaped? help_win send not {
X	/place help_win send
X    } if
X    /pin help_win send
X    /totop help_win send
X    /map help_win send
X} def
X
X/HexCanvas ClassCanvas
Xdictbegin
X    /canvasWidth HexHDelta 6 mul def
X    /canvasHeight HexHeight 6 mul def
X    /Difficulty 1 6 div def
X
X    /MineFont /Palatino-Roman findfont HexHWidth 1.5 div scalefont def
X    /OldX -20000 def
X    /OldY -30000 def
Xdictend
Xclassbegin
X    %% default window size
X
X    /preferredsize {
X	550 300
X	% HexHDelta 10 mul HexDWidth add 2 add
X	% HexHeight 6 mul HexDHeight add 2 add
X    } def
X
X    /minsize {
X	HexWidth 5 mul
X	HexHeight 4 mul
X    } def
X
X    /SetDifficulty {
X	/Difficulty exch promote
X	Difficulty 1.0 gt Difficulty 0 le {
X	    /Difficulty 1 6 div def
X	} if
X    } def
X
X    /SetOldXY {
X	self begin
X	    /OldY exch def /OldY OldY promote
X	    /OldX exch def /OldX OldX promote
X	end
X    } def
X
X    /ChangeFont {
X	/item exch send
X	aload pop   % this seems to be a bug work around 
X
X	/HexFont exch 1 array astore cvx def
X	/HexBoldFont HexFont def
X	MakeGlyphs
X	/PaintAll self send
X    } def
X
X    /StopTimer {
X	MineDict /GameInProgress false put
X	MineDict /TimerInterest known {
X	    MineDict begin
X		/Counting false def % stop the timer!
X		TimerInterest null ne {
X		    TimerInterest revokeinterest
X		    /TimerInterest null def
X		} if
X	    end
X	} {
X	    MineDict /Counting false put
X	} ifelse
X    } def
X
X    /EndTimer {
X	HexTimerProcess killprocess
X	StopTimer
X    } def
X
X    /StartTimer {
X	MineDict /Counting get {
X	    StopTimer
X	} if
X	MineDict begin
X	    /Counting true def
X	    /SecondsSoFar 0 def
X	    /TimerInterest createevent dup begin
X		/Name 1 dict dup begin
X		    /HexTimerEvent {
X			/HexTimer canvas1 send
X		    } def
X		end def
X		/Action (HexTimerEvent) def
X	    end def
X	    TimerInterest expressinterest
X	end
X    } def
X
X    /HexTimer {
X	MineDict begin
X	    Counting {
X		/SecondsSoFar SecondsSoFar 1 add def
X
X		    (% Mines left)[MineCount] sprintf
X		    (% seconds)[SecondsSoFar] sprintf
X		/setfooter window1 send
X	    } if
X	end
X	pop
X    } def
X
X
X    /MarkHex { % x y MarkHex
X	% x y
X	gsave
X	    2 copy Draw3DHexAt
X	    2 copy exch % x' y' y' x'
X	    HexWidth 2 div add exch % x' y' x+ y'
X	    MarkGlyph DisplayItemSize % x y x' y' w h
X		2 div neg exch 2 div neg exch
X	    % x y x y w h
X	    xyadd moveto
X	    % x y of leftmost corner
X	    FG setcolor
X	    MarkGlyph DisplayItemPaint
X	    % x y
X	    2 copy PointToCoords IsThereAMineHere? {
X		%  x y
X		2 copy
X		PointToCoords (%-%) sprintf PlacesBeen exch true put % -
X		MineDict begin
X		    /MineCount MineCount 1 sub def
X		    MineCount 0 eq {
X			StopTimer
X			() (You Won in only % seconds!) [SecondsSoFar] sprintf
X						    /setfooter window1 send
X			VisualEffectForWinning
X		    } {
X			pop pop
X		    } ifelse
X		end % MineDict
X	    } {
X		2 copy % x y
X		WrongMarkGlyph DisplayItemSize % x y x y w h
X		    2 div neg exch 2 div neg HexWidth 2 div add exch
X		xyadd moveto
X		WrongMarkGlyph DisplayItemPaint
X		StopTimer
X		% x y
X		VisualEffectForLosing
X		% -
X		ShowMines
X	    } ifelse
X	grestore
X    } def
X
X    /DrawBoard { % width height DrawBoard -
X	18 dict begin
X	    /BoardHeight exch def
X	    /BoardWidth exch def
X	    % We will use an off-screen canvas to hold two columns of hexes -
X	    % actually from the middle of one through all of another and on to
X	    % the middle of a third.  We can then repeat this canvas to draw the
X	    % game board quickly.
X
X	    /TmpCan canvas1 newcanvas def
X	    /TmpWid HexWidth HexHWidth add def
X
X	    /TinyCan canvas1 newcanvas def
X	    TinyCan 0 0 HexWidth 2 mul HexHWidth add HexHeight rectpath reshapecanvas
X	    TmpCan 0 0
X	    % width:
X	    TmpWid
X	    % height:
X	    MineDict /MineRows get HexHeight mul HexDHeight add
X	    rectpath reshapecanvas
X
X	    % TmpCan /Mapped true put % for debugging
X	    % TinyCan /Mapped true put
X
X	    TinyCan setcanvas
X	    gsave
X		BG FillCanvas
X		% Draw things HexDHeight "too low"...
X
X		0 0 Draw3DHexAt
X		0 HexHeight Draw3DHexAt
X		HexHDelta HexDHeight Draw3DHexAt
X		HexHDelta HexHeight HexDHeight add Draw3DHexAt % off the top?
X		HexHDelta 2 mul dup
X		% x
X		0 Draw3DHexAt
X		% x
X		HexHeight Draw3DHexAt
X	    grestore
X
X	    % draw Col 0 on the main canvas:
X	    canvas1 setcanvas
X	    gsave
X		BG FillCanvas
X
X		0 HexDHeight translate
X		% row 0 on the main screen:
X		0 1 MineDict /MineRows get 2 sub {
X		    TinyCan imagecanvas
X		    pop 0 HexHeight translate
X		} for
X	    grestore
X
X	    % have to do the corners ourselves:
X	    gsave
X		% bottom corners of cols 0 and 2:
X		0 HexDHeight Draw3DHexAt
X		HexWidth HexHWidth add HexDHeight Draw3DHexAt
X		% top corners of cols 0 and 2:
X		MineDict /MineRows get HexHeight mul HexDHeight sub
X		% y
X		dup
X		0 exch Draw3DHexAt
X		dup HexWidth HexHWidth add exch Draw3DHexAt
X		% the top middle one:
X		HexDHeight add HexHDelta exch Draw3DHexAt
X	    grestore
X
X	    % copy that to the off-screen canvas:
X	    gsave
X		TmpCan setcanvas
X		BG FillCanvas
X
X		HexWidth 2 div neg 0 translate
X		canvas1 imagecanvas
X
X	    grestore
X
X	    canvas1 setcanvas
X
X	    gsave
X
X		% draw central columns:
X		HexWidth 2 div 0 translate
X		/Col 1 def
X		1 2 MineDict /MineCols get 2 sub {
X		    pop
X		    TmpCan imagecanvas
X		    TmpWid 0 translate
X		    /Col Col 2 add def
X		} for
X
X	    grestore
X
X	    gsave
X		% draw rightmost column or two
X		/Col Col 1 sub def
X		/x Col HexHDelta mul def
X		x 0 moveto
X		/Indent HexDHeight def
X		Col 1 MineDict /MineCols get 1 sub {
X		    /Col exch def
X		    /y Indent def
X		    0 1 MineDict /MineRows get 1 sub {
X			/Row exch def
X			x y Draw3DHexAt
X
X			x HexDWidth add y moveto
X			% (%,%) [Row Col] sprintf show
X
X			/y y HexHeight add def
X		    } for
X		    /x x HexHDelta add def
X		    /Indent
X			Indent HexDHeight eq {
X			    HexHeight
X			} {
X			    HexDHeight
X			} ifelse
X		    def
X		} for
X	    grestore
X
X	end
X    } def
X
X    /NewGame {
X	MineDict /GameInProgress false put
X	/Busy /setvisualstate window1 send
X
X	% set the cursor to a stopwatch:
X	/busy /setcursor window1 send
X
X	(New Game...) (Stopping timer) /setfooter window1 send
X
X	MineDict /Counting get {
X	    StopTimer
X	} if
X	MineDict /MineCount 0 put
X
X	2 copy % Rows Cols Rows Cols
X
X	2 copy MineDict /MineCols get ne
X	exch MineDict /MineRows get ne or {
X	    (New Game...) (recomputing) /setfooter window1 send
X	    MineDict begin
X		/MineCols exch def
X		/MineRows exch def
X	    end
X	    RecomputeNeighbours
X	} {
X	    pop pop
X	} ifelse
X
X	(New Game...) (Clearing Board...) /setfooter window1 send
X	MineDict /MineRows get MineDict /MineCols get ClearMines
X	% Row Col
X	mul Difficulty mul cvi LayMines
X
X	MineDict /MineCols get HexHDelta mul
X	MineDict /MineRows get HexHeight mul
X	(New Game...) (Drawing new Board...) /setfooter window1 send
X	DrawBoard
X
X	/basic /setcursor window1 send
X	MineDict /GameInProgress true put
X	/Active /setvisualstate window1 send
X	-10000 -10003 /SetOldXY canvas1 send
X	(Ready!)() /setfooter window1 send
X    } def
X
X    /StepGingerly {  % x y StepGingerly -
X	self setcanvas
X	% Draw a flat (2D) hex here:
X	FindHexWestPoint
X	2 copy % x y x y 
X	PreviewFootstep % side effect: flattens the hex (but no glyph drawn)
X	OldX OldY PointToCoords % x y r c
X	2 copy IsThereAMineHere? { % x y r c
X	    StopTimer
X	    pop pop % x y
X	    2 copy moveto (bang!) show
X	    VisualEffectForLosing
X	    ShowMines
X	    % Start New Game...
X	} {
X	    % x y r c
X	    2 copy % x y r c r c
X	    GetNearbyMines % x y r c n
X	    dup 0 eq {
X		% x y r c n
X		pop 4 2 roll pop pop
X		% r c
X		unblockinputqueue
X		DoAutoWalk
X	    } {
X		% x y r c n
X		5 1 roll pop pop
X		% n x y
X		2 copy 5 -1 roll % x y x y n
X		DrawHexGlyphAt
X		% x y
X		PointToCoords (%-%) sprintf PlacesBeen exch true put % -
X	    } ifelse
X
X	    MineDict /Counting get not {
X		StartTimer
X	    } if
X
X	} ifelse
X	-10000 -10003 /SetOldXY self send
X    } readonly def
X
X    /CancelPreviewFootstep { % - -> -
X	OldX -1000 ge {
X	    OldX OldY PointToCoords (%-%) sprintf
X	    PlacesBeen exch known not {
X		OldX OldY Draw3DHexAt % restore old hex
X	    } if
X	} if
X	-10000 -10000 /SetOldXY self send
X    } def
X
X    /PreviewFootstep {  % x y PreviewFootstep -
X	% x y
X	2 copy PointToCoords (%-%) sprintf
X	% x y name
X	PlacesBeen exch known not {
X	    2 copy Draw2DHexAt
X	} if
X	% x y
X	2 copy % x y x y
X	OldY ne % x y x bool
X	exch OldX ne % x y bool bool
X	or { % x y
X	    CancelPreviewFootstep
X	    % x y
X	    /SetOldXY self send
X	} {
X	    pop pop
X	} ifelse
X    } def
X
X    /TrackStart {
X	/E exch def
X	self setcanvas
X	E /Name get dup (LeftMouseButton) eq exch (MiddleMouseButton) eq or {
X	    -10001 -10002 /SetOldXY self send
X	    MineDict /GameInProgress get {
X		E /Coordinates get aload pop CheckInRange {
X		    E /Coordinates get aload pop
X		    FindHexWestPoint PreviewFootstep
X		    [/TrackCrossing /TrackMotion /TrackStop] true
X		} {
X		    nullarray true
X		} ifelse
X	    } {
X		(Use n to start a new game)() /setfooter window1 send
X		nullarray true
X	    } ifelse
X	} {
X	    false
X	} ifelse
X    } def
X
X    /TrackCrossing {
X	/TrackCancel self send
X    } def
X
X    /TrackMotion {
X	dup /E exch def begin
X	    E /Coordinates get aload pop
X	    2 copy CheckInRange {
X		FindHexWestPoint PreviewFootstep
X	    } {
X		CancelPreviewFootstep
X	    } ifelse
X	end
X	% /TrackMotion super send
X    } def
X
X    /TrackStop {
X	/E exch def
X	mark
X	self setcanvas
X	E /Coordinates get aload pop CheckInRange {
X	    E /Name get (LeftMouseButton) eq {
X		E /Coordinates get aload pop
X		    FindHexWestPoint
X		    2 copy PointToCoords (%-%) sprintf
X		    PlacesBeen exch known {
X			pop pop %% beep % bebop pebop bepop
X		    } {
X			StepGingerly
X		    } ifelse
X	    } {
X		E /Name get (MiddleMouseButton) eq {
X		    E /Coordinates get aload pop 2 copy CheckInRange {
X			FindHexWestPoint
X			2 copy PointToCoords (%-%) sprintf
X			PlacesBeen exch known {
X			    beep pop pop
X			} {
X			    MarkHex
X			} ifelse
X		    } {
X			pop pop
X		    } ifelse
X		} {
X		    (Unknown Event) E /Name get /setfooter window1 send
X		} ifelse
X	    } ifelse
X	} {
X	    CancelPreviewFootstep
X	} ifelse
X	E /TrackStop super send
X	cleartomark
X    } def
X
X    /TrackCancel {
X	/E exch def
X	CancelPreviewFootstep
X	E /TrackCancel super send
X    } def
X
X    %% Input events (key presses):
X    /StandardKeyUp {
X	/E exch def
X	self setcanvas
X	E /Name get {
X	    12 18 {  % control-L, control-R --> redraw
X		/Paint self send
X	    }
X	    8 72 104 56 77 28 { % h, ? = help
X		ShowHelp
X	    }
X	    77 109 { % M, m = mark
X		E /Coordinates get aload pop
X		FindHexWestPoint
X		2 copy PointToCoords (%-%) sprintf PlacesBeen exch known {
X		    beep pop pop
X		} {
X		    MineDict /GameInProgress get {
X			MarkHex
X		    } {
X			pop pop beep
X		    } ifelse
X		} ifelse
X	    }
X	    78 110 { % N, n - new game
X		MineDict /MineRows get
X		MineDict /MineCols get
X		NewGame
X	    }
X	    17 81 113 { % ^Q, Q, q --> quit
X		/QuitFromUser window1 send
X	    }
X	    19 { % ^S - show mines and give up
X		ShowMines % this lets you cheat...
X		% later, this will show the scores..
X	    }
X	    % p, properties
X	    32 { % space --> StepGingerly
X		E /Coordinates get aload pop
X		FindHexWestPoint 2 copy
X		PointToCoords (%-%) sprintf PlacesBeen exch known {
X		    beep pop pop
X		} {
X		    MineDict /GameInProgress get {
X			StepGingerly
X		    } {
X			pop pop beep
X		    } ifelse
X		} ifelse
X	    }
X	    /Default {
X		beep
X	    }
X	} case
X    } def
X    
X    /FunctionKeyUp {
X	/Name get /FunctionL3 eq {
X	    % Props. I wish I got a "Properties" event instead, though.
X	    % But you need to have selections if you do that.
X	    /ShowProps self send
X	} if
X    } def
X
X    /KeyStart { pop [ /StandardKeyUp /FunctionKeyUp ] true} def
X
X    %% Startup code:
X    /NewInit {
X	/OldX -10341 promote
X	/OldY -10342 promote % unusual numbers for easy spotting...
X
X	% Arrange to be allowed focus:
X	MineFont /setfont self send
X
X        /NewInit super send
X    } def
X
X    %% The hexes...
X    /Paint {
X	gsave
X	BG FillCanvas
X	grestore
X
X	(Drawing...) ( ) /setfooter window1 send
X	/Busy /setvisualstate window1 send
X
X	% canvas size -- TNT 3.0 Ref. p. 49
X	bbox /canvasHeight exch def /canvasWidth exch def pop pop
X	/Rows canvasHeight HexDHeight 2 div sub HexHeight div cvi def
X	/Cols canvasWidth HexHDelta div cvi def
X	Rows Cols NewGame
X	(Type h for help...) ( ) /setfooter window1 send
X
X	% ShowMines % for cheating
X
X	/Active /setvisualstate window1 send
X    } def
X
Xclassend def
X
X/canvas1 framebuffer /new HexCanvas send def
X/window1 canvas1 framebuffer /new ClassBaseWindow send def
XMyName /setlabel window1 send
X{
X    /PaintIcon {
X	20 dict begin
X	    gsave
X		IconFont setfont
X		/OldSize HexHWidth def
X		25 SetHexSizeFromFlat
X
X		0 0 moveto
X		/s (SWEEPER) def
X		/t [
X		    (HEX)
X		    IconFont 2 scalefont
X		    0 0.5 0.5 rgbcolor
X		] def
X		s show
X		t DisplayItemSize /ty exch def /tx exch def
X
X		% Move above the icon name
X		0
X		s DisplayItemSize exch pop % y
X		translate
X
X		% Draw a hex
X		0 HexDHeight Draw3DHexAt
X
X		% move to middle of bottom left diagonal:
X		HexDWidth 2 div HexDHeight 2 div translate
X
X		% draw the word HEX
X
X		30 rotate
X		
X		0 0 moveto
X		% centre of the hex is at (HexHWidth) * sqrt3 / 2, 0
X		HexHWidth sqrt3 mul 2 div  0
X
X		% centre of hex on stack...
X		tx 2 div neg  ty 2 div neg xyadd
X
X		moveto
X		t DisplayItemPaint
X		OldSize SetHexSizeFromFlat
X	    grestore
X	end
X    } def
X
X    /QuitFromUser {
X	/EndTimer canvas1 send
X	currentprocess killprocess
X    } def
X
X} window1 send
X
X/new ClassEventMgr send dup /ProcessName (Hex) put
X
X/help_can framebuffer /new HelpCanvas send def
X/help_win help_can framebuffer /new ClassPopupWindow send def
Xhelp_win /addsubwindow window1 send
X  
X
X(HexSweeper Help) /setlabel help_win send
X 
X/nFonts 0 def
X
X/menu /Grid framebuffer /new ClassMenu send def
X[
X    [
X	(New game) {
X	    pop pop
X	    /PaintAll canvas1 send
X	}
X    ]
X    [ (Properties...) { pop pop beep } ]
X
X    [
X	(Difficulty)
X
X	/Grid framebuffer /new ClassMenu send
X	dup
X	[
X	    [
X		(Suicide) {
X		    pop pop
X		    .5 /SetDifficulty canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Very Difficult) {
X		    pop pop
X		    .3 /SetDifficulty canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Normal) {
X		    pop pop
X		    1 6 div /SetDifficulty canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Easy) {
X		    pop pop
X		    1 12 div /SetDifficulty canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Dan Quayle) {
X		    pop pop
X		    1 100 div /SetDifficulty canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	]
X	exch /setitemlist exch send
X    ]
X
X    [
X	(HexFont)
X	/Grid framebuffer /new ClassMenu send
X	[
X	    FontDirectory {
X		type /nametype eq {
X		    pop
X		} {
X		    255 string cvs
X		    % exclude this font if it has OpenLook in the name.
X		    (OpenLook) search { pop pop pop } {
X			% or if it is the olgx font.
X			(olglyph) search { pop pop pop } {
X			    % or if it is a bogus Xt+ font.
X			    (12) search { pop pop pop } {
X				% or if it has an XLFD long name.
X				dup length 30 gt { pop } {
X				    /nFonts nFonts 1 add store
X				} ifelse
X			    } ifelse
X			} ifelse
X		    } ifelse
X		} ifelse
X	    } forall
X	] /gt quicksort /setitemlist 2 index send
X	/ChangeFont /setnotifier 2 index send
X	[ true nFonts 3 add 4 idiv 4 ] /setlayoutparameters 2 index send
X	/textfont 1 index send /FontName get
X	findfont 11 scalefont /settextfont 2 index send
X	true /setpinnable 2 index send
X    % @@
X    ]
X
X    [
X	(Scale)
X
X	/Grid framebuffer /new ClassMenu send
X	dup [
X	    [
X		(Texas) {
X		    pop pop % 300 was too big...
X		    200 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Huge) {
X		    pop pop % 300 was too big...
X		    60 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Big) {
X		    pop pop 40 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Large) {
X		    pop pop 30 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Normal) {
X		    pop pop 25 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Smallish) {
X		    pop pop 20 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Tiny) {
X		    pop pop 14 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	    [
X		(Welsh Cottage) {
X		    pop pop 7 /SetHexSizeFromFlat canvas1 send
X		    /PaintAll canvas1 send
X		}
X	    ]
X	] exch /setitemlist exch send
X    ]
X    [ (Quit) { pop pop /QuitFromUser window1 send } ]
X] /setitemlist menu send
Xtrue /setpinnable menu send
Xmenu /setmenu canvas1 send
Xtrue /setmenuable canvas1 send
Xtrue /setkeyable canvas1 send
Xtrue /settrackable canvas1 send
X
X/activate window1 send
Xwindow1 /Retained true put
X/place window1 send
X/map window1 send
Xpause pause pause
X
@@@End of hexsweeper
chmod +x hexsweeper
echo end of archive from:

cat # print .signature...

-- 
Liam Quin, lee@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer
  lq-text (Unix text retrieval package) 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?