🚀 go-pugleaf

Here's a little game written in NeWS PostScript.  It's awfully basic,
I'm afraid - no high scores, no Properties sheets, etc.

It's a little similar to the VMS Minesweeper game... but played on a
hexagonal grid.

I'm at least a little interested in fixes, enhancements, etc.

You can alter the line marked DIFFICULTY to make the game easier or harder.

Lee


: 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%!PS
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 500 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%% Random distributions
X/MAX 0 def
X/MIN 0 def
X% min max random
X
X/X currenttime 1 get 12 mul 211 div def
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} bind readonly def
X
X/srand { /X exch def /theSeed X def } bind readonly def
X/newrand {
X    currenttime srand
X} bind readonly def
X
X/randomBetween {
X      /MAX exch 1 add def
X      /MIN exch def
X      random  MAX MIN sub  mul  MIN add  cvi
X} readonly def
X
X
X/sqrt3 3 sqrt def
X
X/Hex3DDict 12 dict def
X/Hex3DInnerDict 12 dict def
X/HexHWidth 20 def
X/HexDWidth HexHWidth 2 div def
X/HexDHeight HexHWidth sqrt3 mul 2 div def
X
X/HexWidth HexDWidth 2 mul HexHWidth add def
X/HexHeight HexDHeight 2 mul def
X
X% TNT display items for glyphs:
X/BombGlyph [ (\154) /ZapfDingbats findfont HexHWidth scalefont ] 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
Xframebuffer /Color get {
X    /0Glyph ( ) def
X    /1Glyph [(1)/Palatino-Roman findfont HexHWidth 1.5 div scalefont
X	0 0 1 rgbcolor ] def
X    /2Glyph [(2)/Palatino-Roman findfont HexHWidth scalefont
X	0 1 0 rgbcolor ] def
X    /3Glyph [(3)/Palatino-Roman findfont HexHWidth scalefont
X	0 1 1 rgbcolor ] def
X    /4Glyph [(4)/Palatino-Bold findfont HexHWidth scalefont
X	1 0 1 rgbcolor ] def
X    /5Glyph [(5)/Palatino-Bold findfont HexHWidth scalefont
X	1 .9 0 rgbcolor ] def
X    /6Glyph [(6) /Palatino-Bold findfont HexHWidth 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)/Palatino-Roman findfont HexHWidth 1.5 div scalefont Black ] def
X    /2Glyph [(2)/Palatino-Roman findfont HexHWidth scalefont Black ] def
X    /3Glyph [(3)/Palatino-Roman findfont HexHWidth scalefont Black ] def
X    /4Glyph [(4)/Palatino-Bold findfont HexHWidth scalefont Black ] def
X    /5Glyph [(5)/Palatino-Bold findfont HexHWidth scalefont Black ] def
X    /6Glyph [(6)/Palatino-Bold findfont HexHWidth 1.5 mul scalefont Black ] def
X} ifelse
X
X/GlyphArray [ 0Glyph 1Glyph 2Glyph 3Glyph 4Glyph 5Glyph 6Glyph ] def
X
X/FindHexWestPoint { % x y FindHexWestPoint -> x y of p0
X    12 dict begin
X	% transform coordinates so the centre of hex ,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	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 setlinewidth FG setcolor stroke % for testing
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	6 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	% gsave
X	    % 0 setlinewidth
X	    % FG setcolor stroke
X	% grestore
X    end
X} def
X
X/NewGame {
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    2 copy % Rows Cols Rows Cols
X    MineDict /Counting get {
X	StopTimer
X    } if
X    MineDict /MineCount 0 put
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    ClearMines
X    MineDict /MineCols get HexHWidth HexDWidth add mul
X    MineDict /MineRows get HexHeight mul
X    (New Game...) (Drawing new Board...) /setfooter window1 send
X    DrawBoard
X
X    % Row Col
X    (Starting New Game...) (Laying Mines) /setfooter window1 send
X
X    mul 4 div cvi LayMines % DIFFICULTY change the 4 to alter the setting...
X
X    (New Game...) (Finding Mines) /setfooter window1 send
X    ComputeNearbyMines
X    /basic /setcursor window1 send
X    /Active /setvisualstate window1 send
X    (Ready!)() /setfooter window1 send
X} def
X
X/DrawBoard { % width height DrawBoard -
X    8 dict begin
X	/BoardHeight exch def
X	/BoardWidth exch def
X	/x 0 def
X	/Indent HexDHeight def
X
X	gsave
X
X	BG FillCanvas
X
X	0 1 MineDict /MineCols get 1 sub {
X	    /Col exch def
X	    /y Indent def
X
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	    pause 
X
X	    /x x HexDWidth HexHWidth add add def
X
X	    /Indent Indent HexDHeight eq {
X		 HexHeight
X	    } {
X		 HexDHeight
X	    } ifelse def
X	} for
X
X	grestore
X    end
X} def
X
X/ClearMines { % rows cols ClearMines -
X    /MineBoard growabledict def
X    /PlacesBeen growabledict def
X} def
X
X/RecomputeNeighbours {
X    (Computing neighbours from % to %)[MineDict /MineRows get 1 sub MineDict /MineCols get 1 sub]sprintf ==
X    /NeighboursDict growabledict def
X    4 dict begin
X	0 1 MineDict /MineRows get 1 sub {
X	    /Row exch def
X	    0 1 MineDict /MineCols get 1 sub {
X		/Col exch def
X		NeighboursDict
X		    Row Col MakeCellName
X		    Row Col FindNeighbours
X		put
X	    } for
X	pause
X	} for
X    end
X} def
X
X% precompute how many mines are adjacent to a given mine, and also
X% the list of neighbours for each mine:
X/ComputeNearbyMines {
X    8 dict begin
X	/Rows MineDict /MineRows get def
X	/Cols MineDict /MineCols get def
X	/NearbyMines Rows Cols mul array def
X
X	0 1 Rows 1 sub {
X	    /CRow exch def
X	    0 1 Cols 1 sub {
X		/CCol exch def
X
X		/N CRow CCol GetNeighbours def
X		% N is [ [r c] null [r c ]...]
X		NearbyMines % bigarray
X		CRow  CCol Rows mul  add  % bigarray index
X		0 % Array index 0
X		N {
X		    % bigarray index [row col] or null
X		    dup null eq { 
X			% array index null
X			pop
X		    } {
X			% array index [row col]
X			aload pop % array index Row Col    
X			% inline expansion of IsThereAMineHeres?...
X			MineBoard 3 1 roll MakeCellName known {
X			    1 add
X			} if
X		    } ifelse
X		} forall
X		% array index total
X		put % -
X	    } for
X	    pause pause pause
X	} for
X	MineDict /NearbyMines NearbyMines put
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]
X	    sprintf == flush
X	    0
X	} {
X	    MineDict /NearbyMines get % array
X	    Row  Col Rows mul add  get % int or null
X	    dup null eq {
X		pop
X	    } if
X	} ifelse
X    end
X} def
X
X/GetNeighbours {
X    MakeCellName 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/PointToCoords { % x y PointToCoords Row Col
X    % Note: the point must be the Westernmost corner of the Hex
X    exch % y x
X    HexHWidth HexDWidth add div cvi % y y Col
X    dup 2 mod 1 eq { % y Col
X	exch
X	HexDWidth sub
X    } {
X	exch
X    } ifelse % Col y
X    HexDWidth sub
X    HexHeight div 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    2 copy CoordsToPoint MakeCellName % Row Col  name
X    PlacesBeen exch known not { % Row Col
X	GetNeighbours {
X	    dup null eq not { % there's a neighbour in this direction
X		% [Row Col]
X		aload pop
X		2 copy CoordsToPoint MakeCellName
X		dup PlacesBeen exch known not {
X		    % Row Col name
X		    PlacesBeen exch true put
X
X		    % Row Col
X
X		    2 copy % Row Col Row Col
X		    GetNearbyMines % Row Col n
X		    /n exch def
X		    2 copy CoordsToPoint % Row Col x y
X		    n FlattenHex
X		    n 0 eq {
X			AutoWalk
X		    } {
X			pop pop
X		    } ifelse
X		} {
X		    pop pop pop
X		} ifelse
X	    } {
X		% null
X		pop
X	    } ifelse
X	} forall
X    } {
X	pop pop
X    } ifelse
X} def
X
X/FlattenHex { % x y n FlattenHex -
X    dup 0 eq {
X	% x y n
X	pop % x y
X	Draw2DHexAt % -
X    } {
X	% x y n
X	GlyphArray exch get
X	% x y DisplayItem
X	3 1 roll % DI x y
X	2 copy Draw2DHexAt % DI x y
X	exch % DI  y x (of westernmost point)
X	HexWidth 2 div add % (n) x y
X	exch % (N) x' y
X	moveto % (n)
X	dup DisplayItemSize 2 div neg exch 2 div neg exch rmoveto
X	DisplayItemPaint
X    } ifelse
X} def
X
X/AutoWalk { % Row Col AutoWoalk -
X    %% Assumtions:
X    %% There are 0 nearby mines
X    %% There is not a mine here (!)
X    %% The hex at (Row Col) has been flattened already.
X    %%
X
X    pause
X
X    % mark this hex as done:
X    2 copy CoordsToPoint MakeCellName % name name
X    PlacesBeen exch true put
X
X    % Row Col
X    GetNeighbours
X
X    % -
X
X    % The following is an unrolled loop to avoid overflowing the
X    % execution stack:
X
X    % array
X    dup 0 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint % Row Col x y
X	MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    % array
X    dup 1 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    % array
X    dup 2 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    % array
X    dup 3 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    % array
X    dup 4 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    % array
X    dup 5 get % array [row,col]  or  array null
X    dup null eq {
X	% array null
X	pop
X    } {
X	% there's a neighbour here.. but have we visited it already?
X	aload pop 2 copy % Row Col Row Col    
X	CoordsToPoint MakeCellName dup % Row Col name name
X	PlacesBeen exch known {
X	    % yes, been here already
X	    % Therefore if there are 0 mines near here, AutoWalk has already
X	    % been called for this hex, so we don't even need to check.
X
X	    % Row Col name
X
X	    pop pop pop
X	} {
X	    % Not been here yet...
X	    % mark the location as visited...
X
X	    % Row Col name
X
X	    PlacesBeen exch true put % Row Col
X
X	    % ... and flatten it:
X	    2 copy % Row Col Row Col
X	    GetNearbyMines % Row Col n
X	    /n exch def
X	    2 copy CoordsToPoint % Row Col x y
X	    n FlattenHex % Row Col
X	    n 0 eq {
X		% Row Col
X		AutoWalk
X	    } {
X		pop pop
X	    } ifelse
X	} ifelse
X    } ifelse
X
X    pause % give peace a chance
X
X    pop
X
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/MaybeLayOneMine { % Row Col LayOneMine -
X    MakeCellName dup % name name
X    MineBoard exch known {
X	pop false
X	pause % let other things run if we're checking the same cell a lot
X    } {
X	MineBoard exch true put
X	true
X    } ifelse
X} def
X
X/CoordsToPoint {
X    3 dict begin
X	/Col exch def /Row exch def
X
X	Col HexHWidth HexDWidth add mul % x
X	Row HexHeight mul % x bottom-of-hex-if-odd
X
X	Col 2 mod 0 eq {
X	    HexDHeight sub
X	} if % x bottom-of-hex
X	HexHeight add % x y
X    end
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} def
X
X/ShowMines {
X    gsave
X	0 1 MineDict /MineRows get 1 sub {
X	    /Row exch def
X	    0 1 MineDict /MineCols get 1 sub {
X		/Col exch def
X		Row Col IsThereAMineHere? {
X		    Row Col CoordsToPoint
X		    % 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		} if
X	    } for
X	} for
X    grestore
X} def
X
X% beware of inline expansion of this in ComputeNearbyMines
X/IsThereAMineHere? {
X    4 dict begin
X	/Col exch def
X	/Row exch def
X	Row Col MakeCellName
X	MineBoard exch known {
X	    true
X	} {
X	    false
X	} ifelse
X    end
X} def
X
X/LayMines { % rows cols n_mines LayMines -
X    /n exch def
X
X    (Laying % Mines...)[n] sprintf ==
X
X    /MineCount n def
X    {
X	n 0 eq { exit } if
X
X	% Lay one mine
X	0 MineDict /MineRows get 1 sub randomBetween 0.5 add cvi
X	0 MineDict /MineCols get 1 sub randomBetween 0.5 add cvi
X	MaybeLayOneMine {
X	    /n n 1 sub def
X	} if
X    } loop
X    MineDict /MineCount MineCount put
X} def
X
X/MakeCellName {
X    cvi exch cvi (X%-%) sprintf
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 HexHWidth HexDWidth add 6 mul def
X    /canvasHeight HexHeight 6 mul 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	% HexDWidth HexHWidth add 10 mul HexDWidth add 2 add
X	% HexHeight 6 mul HexDHeight add 2 add
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    /StopTimer {
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		() (% Mines left, % seconds)[MineCount SecondsSoFar] sprintf /setfooter window1 send
X	    } if
X	end
X    } def
X
X
X    /MarkHex { % x y Markhex
X	FindHexWestPoint % x' y'
X	2 copy /MakeCellName self send % x' y' cell
X	PlacesBeen exch true put % x' y'
X	2 copy
X	exch % x' y' y' x'
X	HexWidth 2 div add % x' y' y' x'+HW/2
X	exch % x' y' x y
X	FG setcolor
X	MarkGlyph DisplayItemSize % x y w h
X	    2 div neg exch 2 div neg exch
X	xyadd moveto
X	MarkGlyph DisplayItemPaint
X	2 copy
X	PointToCoords IsThereAMineHere? {
X	    pop pop
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 send
X		    VisualEffectForWinning
X		} if
X	    end % MineDict
X	} {
X	    WrongMarkGlyph DisplayItemSize % 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	    VisualEffectForLosing
X	    ShowMines
X	} ifelse
X    } def
X
X    /StepGingerly {  % x y StepGingerly -
X	self setcanvas
X	2 copy % x y x y 
X	% Draw a flat (2D) hex here:
X	PreviewFootstep
X	% consumes topmost x and y and unflattens previos previewd hex, if any
X	FindHexWestPoint
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 
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		FlattenHex
X		% x y
X	    } ifelse
X	    % x y
X	    /MakeCellName self send % cell
X	    PlacesBeen exch true put % -
X
X	    MineDict /Counting get not {
X		StartTimer
X	    } if
X
X	} ifelse
X	-10000 -10003 /SetOldXY self send
X    } readonly def
X
X    /PreviewFootstep {  % x y PreviewFootstep -
X	self setcanvas
X	FindHexWestPoint  2 copy
X	OldY ne % x y x bool
X	exch % x y bool x
X	OldX ne % x y bool bool
X	or { % x y
X	    OldX -1000 ge {
X		OldX OldY /MakeCellName self send
X		PlacesBeen exch known not {
X		    OldX OldY Draw3DHexAt % restore old hex
X		} if
X	    } if
X	    % x y
X	    /SetOldXY self send
X	} {
X	    pop pop
X	} ifelse
X	OldX OldY /MakeCellName self send
X	PlacesBeen exch known not {
X	    OldX OldY Draw2DHexAt
X	} if
X    } readonly def
X
X    /TrackStart {
X	/E exch def
X	self setcanvas
X	E /Name get (LeftMouseButton) eq {
X	    -10001 -10002 /SetOldXY self send
X	    E /Coordinates get aload pop PreviewFootstep
X	    [/TrackCrossing /TrackMotion /TrackStop] true
X	} {
X	    E /Name get (MiddleMouseButton) eq {
X		% TODO: preview with count!
X		-10001 -10002 /SetOldXY self send
X		E /Coordinates get aload pop
X		% PreviewFootstep
X		FindHexWestPoint PointToCoords
X		2 copy exch (Row % Col % )sprintf ==
X		GetNeighbours ==
X		% [/TrackMotion /TrackStop] true
X		false
X	    } {
X		false
X	    } ifelse
X	} ifelse
X    } def
X
X    /TrackCrossing {
X	/TrackCancel super send
X    } def
X
X    /TrackMotion {
X	dup /E exch def begin
X	    E /Coordinates get aload pop
X	    PreviewFootstep
X	end
X	% /TrackMotion super send
X    } def
X
X    /TrackStop {
X	/E exch def
X	mark
X	self setcanvas
X	E /Name get (LeftMouseButton) eq {
X	    E /Coordinates get aload pop
X	    StepGingerly
X	} {
X	    E /Name get (NOTDONEMiddleMouseButton) eq {
X		(Middle Button not done) () /setfooter window1 send
X		% NOTDONE ShowObviousSpaces
X	    } {
X		(Unknown Event) E /Name get /setfooter window1 send
X	    } ifelse
X	} ifelse
X	E /TrackStop super send
X	cleartomark
X    } def
X
X    /TrackCancel {
X	(Cancel) == flush
X	dup begin
X	    (Cancel) () /setfooter window1 send
X	end
X	/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		MarkHex
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		EndTimer
X		currentprocess killprocess
X	    }
X	    19 { % ^S - show mines and give up
X		ShowMines % this lets you cheat...
X		% later, this will show the scores..
X	    }
X	    % h and ? - get help
X	    % p, properties
X	    32 { % space --> StepGingerly
X		E /Coordinates get aload pop
X		StepGingerly
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	    /showprops self send
X	} if
X    } def
X
X    /KeyStart { [ /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	true setkeyable
X	true settrackable
X	MineFont /setfont self send
X
X        /NewInit super send
X    } def
X
X    %% The hexes...
X    /Paint {
X	(Drawing...) ( ) /setfooter window1 send
X	/Busy /setvisualstate window1 send
X
X	% canvas size -- TNT 3.0 Ref. p. 49
X	bbox == == == ==
X	bbox /canvasHeight exch def /canvasWidth exch def pop pop
X	/Rows canvasHeight HexDHeight 2 div sub HexHeight div cvi def
X	/Cols canvasWidth HexHWidth HexDWidth add 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
X(HexSweeper 1.0) /setlabel window1 send
X{
X    /PaintIcon {
X	0 30 Draw3DHexAt
X    } def
X} window1 send
X
X
X/new ClassEventMgr send dup /ProcessName (Hex) put
X
X(hexsweeper.info:maincanvas) /sethelpkeyword canvas1 send
Xtrue /sethelpable canvas1 send
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(HexSweeper Help) /setlabel help_win send
X 
Xpause pause pause
X
X/activate window1 send
Xwindow1 /Retained true put
X/place window1 send
X/map window1 send
X
@@@End of hexsweeper
chmod +x hexsweeper
echo 'end of archive, get playing!'
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?