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
l...@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, l...@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer