Thread View: comp.windows.news
1 messages
1 total messages
Started by Liam R. E. Quin
Tue, 18 Aug 1992 04:19
src: hexsweeper game for OpenWindows 3
Author: Liam R. E. Quin
Date: Tue, 18 Aug 1992 04:19
Date: Tue, 18 Aug 1992 04:19
1394 lines
33486 bytes
33486 bytes
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?
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads