Thread View: comp.windows.news
3 messages
3 total messages
Started by Liam R. E. Quin
Mon, 07 Sep 1992 22:57
game (src) for OpenWindows 3 - HexSweeper 1.81
Author: Liam R. E. Quin
Date: Mon, 07 Sep 1992 22:57
Date: Mon, 07 Sep 1992 22:57
2189 lines
52492 bytes
52492 bytes
Here is HexSweeper 1.81. It's a little faster than 1.66 at many things,
has a high scorefile, a few bug fixes, a font menu to let you choose the
numbers font, and a picture of a Big Red Bang.
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.
You must have OpenWindows 3.0 or later in order to run HexSweeper.
This program will not run on OpenWindows 2, Microsoft Windows, X Windows
or Greenhouse Windows :-) It uses TNT 3.0, the NeWS Toolkit.
Known problems:
* There's no Properties window yet.
* Do not go directly from Texas Scale to Welsh Cottage Scale!
(perhaps the program should prevent this)
* GreyScale users might not be able to read all the numbers - if this
happens, change "framebuffer /Color get" to "false" at or near line 74.
* The high score file isn't protected against multiple people writing at
once. How do I do that in PostScript??
If you do get a problem, press L1 (STOP) if the mouse stops working, and
then use hexkill (enclosed) to get rid of the Hex NeWs processes.
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 you can
bring up `props' (Workspace menu->Properties) and change the colours!
Please tell me if you like HexSweeper!
Lee
lee@sq.com
#! /bin/sh
: To unbundle, sh this file
echo x - hexsweeper 1>&2
sed 's/^X//' >hexsweeper <<'@@@End of hexsweeper'
X#! /bin/sh
X
X# $Id: hexsweeper,v 1.81 92/09/07 18:54:43 lee Exp $
X
Xpsh << 'barefoot_boy'
X
X/MyName (HexSweeper 1.81) 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 30 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 { /GillSans-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 scalefont
X .2 .2 1 rgbcolor ] def
X /2Glyph [(2) HexFont findfont HexWidth scalefont
X .1 .9 .1 rgbcolor ] def
X /3Glyph [(3) HexFont findfont HexWidth scalefont
X 0 .9 1 rgbcolor ] def
X /4Glyph [(4) HexBoldFont findfont HexWidth scalefont
X .95 0 .8 rgbcolor ] def
X /5Glyph [(5) HexBoldFont findfont HexWidth scalefont
X 1 .9 0 rgbcolor ] def
X /6Glyph [(6) HexBoldFont findfont HexWidth scalefont
X 0.8 .1 .1 rgbcolor ] def
X } {
X /0Glyph ( ) def
X /Black 0 0 0 rgbcolor def
X /1Glyph [(1) HexFont findfont HexWidth 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 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% 30 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 12 setrasteropcode
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 I found a bug if this happens.
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 MineDict /TotalMines MineCount put
X end
X} def
X
X/HighScoreCanvas ClassCanvas
Xdictbegin
X /EntryCount 0 def
X /MyScore 0 def
X /HighScores 0 def
X /f 0 def % file handle
X /FilePath 0 def
X /FileName (hexsweeper.scores) readonly def
X /MyWidth 200 def
X /MyHeight 40 def
X /WidestScore 550 def
X /ScoreTextSize 16 def
X % MyScoreGlyph is a right-pointing arrow:
X /MyScoreGlyph [ (\355) /ZapfDingbats findfont ScoreTextSize scalefont ]
X readonly def
Xdictend
Xclassbegin
X /SetFilePath {
X /FilePath exch promote
X } def
X
X /minsize {
X 100 40
X } def
X
X /ReadScoreFile {
X [
X (/usr/games/lib)
X (/usr/local/games/lib)
X { (HOME) getenv } stopped { (/tmp) } if
X ] /SetFilePath self send
X
X FileName FilePath (r) filepathopen {
X /f exch promote % got a file
X % filepathopen left the correct path on the stack:
X % 1 array astore /SetFilePath self send
X pop
X
X % read the high score table
X
X % first, the number of entries:
X f 20 string readline {
X /EntryCount exch cvi def
X } {
X /EntryCount 0 def
X } ifelse
X
X % Allow a maximum of 30 entries:
X EntryCount 30 gt {
X /EntryCount 30 def
X } if
X
X /EntryCount EntryCount promote
X
X /HighScores EntryCount 1 add array def
X /HighScores HighScores promote
X
X /n 0 def
X % now the actual entries
X
X /GillSans findfont ScoreTextSize scalefont setfont
X
X /WidestScore 0 promote
X
X 0 1 EntryCount 1 sub {
X f 100 string readline {
X % int string
X dup % check to see if the string is wider than the max
X dup stringwidth pop % s s width
X exch cvi log cvi
X 10 exch sub (0) stringwidth pop mul add
X WidestScore max /WidestScore exch def
X HighScores 3 1 roll put
X /n n 1 add def
X } {
X pop pop exit
X } ifelse
X } for
X
X /EntryCount n def
X /EntryCount n promote
X
X f closefile
X /f 0 promote
X /WidestScore
X WidestScore MyScoreGlyph DisplayItemSize pop 1.2 mul add
X promote
X } {
X pop
X /EntryCount 0 promote
X /HighScores 1 array promote
X } ifelse
X } def
X
X /preferredsize {
X WidestScore 20 add
X 31 18 mul 20 add % 32 is max No. of high scores + 1
X } def
X
X /WriteScoreFile {
X FileName FilePath (w) filepathopen {
X /f exch promote
X EntryCount 30 gt {
X /EntryCount 30 promote
X } if
X f EntryCount 10 string cvs writestring
X f (\n) writestring
X 0 1 HighScores length 1 sub {
X HighScores exch get
X dup null ne {
X f exch writestring
X f (\n) writestring
X } if
X } for
X f closefile
X /f 0 promote
X % filepathopen left the correct path on the stack:
X (Wrote score file %) sprintf
X MineDict /Score get (Score: %) sprintf
X /setfooter window1 send
X } {
X (Couldn't write score file %) sprintf (oops)
X 2 copy /setfooter highscore_win send
X /setfooter window1 send
X % handle errors (urp)
X } ifelse
X } def
X
X /SetHighScore {
X ReadScoreFile
X MineDict begin
X %% who am I?
X /UserName
X { (LOGNAME) getenv } stopped {
X { (USER) getenv } stopped {
X (unknown) % unknown user...
X } if
X } if
X def
X
X %% Score:
X %% metric is
X %% Number Of Mines ^ 2/ ( Row * Cols * max(Time, 0.25) )
X /Score
X TotalMines MineRows MineCols mul
X /GetDifficulty canvas1 send mul mul
X SecondsSoFar dup 0 eq { pop 0.25 } if
X div
X 36 mul % well, lots of sixes in Hexsweeper :-)
X cvi
X def
X
X % \320 is an em dash (---)
X (% \320 % \320 Mines: %; Time: %; Grid: % x %) [
X Score
X UserName
X TotalMines
X SecondsSoFar
X MineCols
X MineRows
X ] sprintf % leave the string on the stack
X end % MineDict
X /MyScore exch promote
X /HighScores HighScores dup EntryCount MyScore put promote
X
X /e EntryCount 1 add array def
X
X EntryCount 30 lt {
X /EntryCount EntryCount 1 add promote
X } if
X
X 0 1 e length 1 sub {
X dup HighScores exch get % n score
X dup null eq {
X pop exit
X } {
X % n score
X e 3 1 roll put
X } ifelse
X } for
X
X /HighScores e { cvi exch cvi exch lt } quicksort promote
X
X WriteScoreFile
X ShowHighScores
X } def
X
X /Paint {
X gsave
X Update
X grestore
X } def
X
X /Update { % update high score table on screen
X self setcanvas
X gsave
X BackgroundColor FillCanvas
X
X ReadScoreFile
X
X /GillSans findfont ScoreTextSize scalefont setfont
X FG setcolor
X /bbox self send /MyHeight exch def /MyWidth exch def pop pop
X 10 MyHeight 10 sub moveto
X 0 1 EntryCount 1 sub {
X HighScores exch get % array
X dup null eq { pop pop exit } if
X currentpoint exch pop 10 exch moveto
X 0 -18 rmoveto
X gsave
X currentpoint 3 -1 roll % x y string
X dup MyScore eq {
X MyScoreGlyph DisplayItemPaint
X (You made the high score!) ()
X /setfooter highscore_win send
X pause pause pause
X } if
X 3 1 roll
X MyScoreGlyph DisplayItemSize pop 1.2 mul 0 xyadd moveto
X % allow room for 10 digits
X dup cvi log cvi
X 10 exch sub (0) stringwidth pop mul 0 rmoveto
X show
X pause
X grestore
X } for
X grestore
X } def
Xclassend def
X
X/ShowHighScores {
X /Update highscore_can send
X /reshaped? highscore_win send not {
X /place highscore_win send
X } if
X /pin highscore_win send
X /totop highscore_win send
X /Footer? true /setattribute highscore_win send
X /map highscore_win send
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 425
X } def
X
X /firstline {
X 10 395 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 /Symbol findfont textsize scalefont setfont (\343) show
X /Palatino-Roman findfont textsize scalefont setfont
X ( Liam Quin, 1992 \(lee@sq.com\)) 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 \(`m' or middle button\) 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 nextline (Press `s' to see the high scores, and) show
X nextline (`q' to quit. Oh, and have fun!) 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 /GetDifficulty { Difficulty } 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 MineDict /Counting get not {
X StartTimer
X } if
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 /SetHighScore highscore_can send
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 /DoBang {
X % x y
X {
X % clearsendcontexts
X
X 12 dict begin
X /MakeBangPath {
X newpath
X 296 240 moveto 248 320 lineto 200 232 lineto 144 320 lineto
X 144 232 lineto 56 312 lineto 104 232 lineto 0 200 lineto
X 104 192 lineto 48 64 lineto 136 144 lineto 152 0 lineto
X 176 128 lineto 264 8 lineto 280 120 lineto 392 8 lineto
X 368 120 lineto 488 80 lineto 416 144 lineto 512 224 lineto
X 424 208 lineto 472 272 lineto 360 232 lineto 376 320 lineto
X closepath
X } def
X
X gsave
X newpath
X /TmpCan framebuffer newcanvas def
X
X 0 0 moveto 2 2 scale
X TmpCan MakeBangPath
X reshapecanvas
X
X gsave framebuffer setcanvas
X 50 50 TmpCan movecanvas
X grestore
X
X TmpCan /Retained true put
X TmpCan /Mapped true put
X TmpCan setcanvas
X
X 1 1 1 rgbcolor FillCanvas pause pause pause
X .9 .2 .2 rgbcolor FillCanvas pause pause pause
X 1 1 1 rgbcolor FillCanvas pause pause pause
X .9 .2 .2 rgbcolor FillCanvas pause pause pause
X .9 .9 0 rgbcolor FillCanvas % a strong yellow
X pause pause pause
X % draw a red border
X .9 .2 .2 rgbcolor setcolor 10 setlinewidth
X MakeBangPath stroke
X
X % 120 150 moveto too low
X 110 160 moveto
X /Rockwell-Bold findfont 70 scalefont setfont
X (B A N G !) show
X
X % x y
X pop pop
X [0 500000] sleep
X
X % TmpCan /Mapped false put
X
X pause pause pause
X grestore
X end
X } fork
X % give the child a chance to run:
X pause pause pause
X } def
X
X /StepGingerly { % x y StepGingerly -
X self setcanvas
X gsave
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 VisualEffectForLosing
X pop pop % x y
X DoBang
X ShowMines
X -10000 -10007 /SetOldXY self send
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 grestore
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 -10000 -10000 /SetOldXY self send
X } if
X } def
X
X /PreviewFootstep { % x y PreviewFootstep -
X % x y of western point
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 canvas1 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 self setcanvas
X gsave
X FindHexWestPoint PreviewFootstep
X grestore
X } {
X self setcanvas
X gsave
X CancelPreviewFootstep
X grestore
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 2 copy FindHexWestPoint
X 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 83 115 { % ^S, s, S - show high scores
X ShowHighScores
X % Note: control-s to toggle cheat mode has been removed!
X }
X % p, properties
X 16 {
X pstack
X }
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 % self setcanvas initclip
X
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
X Rows Cols NewGame
X
X (Type h for help...) ( ) /setfooter window1 send
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 HexHWidth % save so we can restore it later...
X
X 25 SetHexSizeFromFlat
X
X 20 dict begin
X gsave
X IconFont setfont
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 grestore
X end
X % used the saved size on the stack:
X SetHexSizeFromFlat
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(HexSweeper Help) /setlabel help_win send
X
X/highscore_can framebuffer /new HighScoreCanvas send def
X/highscore_win highscore_can framebuffer /new ClassPopupWindow send def
Xhighscore_win /addsubwindow window1 send
X(HexSweeper High Scores) /setlabel highscore_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 (Hard) {
X pop pop
X 1 4.5 div /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
Xcanvas1 /Retained true put
Xwindow1 /Retained true put
X
X% .65 1 .1 hsbcolor .65 .3 .9 hsbcolor /setcolors window1 send
X
X/activate window1 send
X/place window1 send
X/map window1 send
Xpause pause pause
X
X
Xbarefoot_boy
@@@End of hexsweeper
chmod +x hexsweeper
echo x - hexkill 1>&2
sed 's/^X//' >hexkill <<'@@@End of hexkill'
X#!/bin/sh
X
X# hexkill
X# modified version of pskill by Liam Quin
X
X# pskill
X#From: ks@cs.tut.fi (Syst{ Kari)
X# Newsgroups: comp.windows.news
X# Subject: A script for killing a ps-process
X# Message-ID: <KS.92May6132749@karikukko.cs.tut.fi>
X# Date: 6 May 92 11:27:49 GMT
X# Organization: Tampere Univ. of Technology, Finland.
X
X
X# If your application leaves looping processes, this is a script for you.
X# First, check the id with 'psps' and give it to this 'pskill' as an
X# argument.
X
Xpsh << %EOF
X%
X% pskill - kills a NeWS process
X% code is based on command 'psps'
X%
X% Kari Systa (ks@cs.tut.fi) 1992
X%
X%
X
X/NeWS 3 0 findpackage beginpackage
X
Xcurrentprocess /ProcessName (psps) put
X
Xdebugdict /getprocesses get exec { % [process ...]
X { % > proc
X dup 100 string cvs
X (Hex) search {
X pop pop pop
X dup killprocess
X (Killed: ) 1 index 100 string cvs append (\n) append print
X } if
X % pause
X } forall
X pop
X} forall
X
Xendpackage
X%EOF
X
Xexit $?
X
X--
X% This article represents my personal views.
X% Kari Systa, Tampere Univ. Technology, Box 553, 33101 Tampere, Finland
X% work: +358 31 162585 fax: +358 31 162913 home: +358 31 177412
X% Internet: ks@cs.tut.fi X.400: C=fi ADMD=fumail O=TUT OU=CS S=ks
X
X
@@@End of hexkill
chmod +x hexkill
echo end of archive
exit 0
--
Liam Quin, lee@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer
lq-text (Unix text retrieval package) mailing list: lq-text-request@sq.com
Re: game (src) for OpenWindows 3 - HexSweeper 1.81
Author: Kristian Jorg TX/DKL
Date: Wed, 09 Sep 1992 13:26
Date: Wed, 09 Sep 1992 13:26
11 lines
880 bytes
880 bytes
I have tried this game and I have read the little help there i, but I still do not understand how to play this game! I think the help page needs some rework. -- ---------------------------------------------------------------------------- Kristian Jorg, Software Design Support and Methods ! I speak for myself and Ericsson Telecom AB, Karlstad, Sweden ! Not for my company! E-mail: etxkrjg@solsta.ericsson.se !
Re: game (src) for OpenWindows 3 - HexSweeper 1.81
Author: Liam R. E. Quin
Date: Wed, 09 Sep 1992 20:47
Date: Wed, 09 Sep 1992 20:47
46 lines
2458 bytes
2458 bytes
>I have tried this game and I have read the little help there i, but I still
>do not understand how to play this game!
>
>I think the help page needs some rework.
I apologise for the poor help. Since I have the only OpenWindows 3 system
in this office at the moment, so I don't have many playtesters...
I append some mail I sent to someone trying to explain things.
Lee
Imagine that you are looking at a map of a minefield.
The map is divided into hexagans, arbitrarily.
Certain hexagons represent areas of the minefield which conceal buried mines.
These would explode if you were to tread on them. Ouch. :-)
When you probe a hexagon (press the left pointer button when the mouse pointer
is somewhere near the centre of hexagon, it doesn't matter exactly),
if there is a mine htere, you'll see an explosion (BANG), and the game will
show where all of the mines were hidden in case you wanted to know.
If there is no mine there, one of two things will happen:
(1) you will see a number, which shows how many mines there are in hexagons
immediately next to this one.
(2) if there are no mines near this one, the hexagon will be drawn blank.
Of course, if there are no mines near this hexagon, you can safely step on it,
and also on all 6 - count them! :-) - beighbouring hexagons. The program doe
this for you, to save time.
When you think you have found a hexagon that must have a mine under it,
press the middle mouse button over it. This will put a cross on the hex to
neutralise the mine under it and to mark it as a no-go area. When you have
marked all the mines, you have won.
Press the right menu button to get a menu that will let you choose an easier
game (e.g. Dan Quayle mode will probably make the numbers clear). Dan Quayle
mode does not indicate any political affiliation on my part :-)
I hope this helps.
--
Liam Quin, lee@sq.com, SoftQuad, Toronto, 416 239-4801; the barefoot programmer
lq-text (Unix text retrieval package) mailing list: lq-text-request@sq.com
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