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