home *** CD-ROM | disk | FTP | other *** search
/ CICA 1992 November / CICA_MS_Windows_CD-ROM_Walnut_Creek_November_1992.iso / win3 / games / minehlp1 / minehelp.pas < prev    next >
Pascal/Delphi Source File  |  1992-04-26  |  20KB  |  630 lines
  1. PROGRAM MineHelp;
  2.   {Version 1.0
  3.    Peter Karrer
  4.    April 26, 1992}
  5.  
  6.   {$M 40960,8192}
  7.   {$G+}
  8.  
  9.   USES WObjects, WinTypes, WinProcs, Strings;
  10.  
  11.   {$R MINEHELP.RES}
  12.  
  13.   CONST
  14.     appName: PCHAR = 'MineHelp';
  15.     {Child control IDs}
  16.     inactive = 103;
  17.     active = 104;
  18.     automatic = 105;
  19.     basic = 106;
  20.     expert = 107;
  21.     rand = 108;
  22.     id_Animation = 110;
  23.     id_OK = 109;
  24.  
  25.     white = $ffffff;
  26.     {colors masked with $ffc0c0c0}
  27.     blue  = $c00000;
  28.     dblue = $800000;
  29.     red   = $0000c0;
  30.     dred  = $000080;
  31.     dgreen= $008000;
  32.     dcyan = $808000;
  33.     black = 0;
  34.     dgray = $808080;
  35.     gray  = $c0c0c0;
  36.     xOff = -4; { width of left border in Minesweeper window client area - 16}
  37.     yOff = 39; { width of top  border in Minesweeper window client area - 16}
  38.  
  39.   TYPE
  40.  
  41.     TThisApp = OBJECT(TApplication)
  42.       PROCEDURE InitMainWindow; VIRTUAL;
  43.     END;
  44.  
  45.     PThisWindow = ^TThisWindow;
  46.     TThisWindow = OBJECT(TDlgWindow)
  47.       stat: INTEGER; {id of checked "Status" button}
  48.       lev: INTEGER;  {id of checked "Level" button}
  49.       animation: BOOLEAN;
  50.       msWin: HWnd;
  51.       mswX, mswY: INTEGER;
  52.       dimX, dimY: INTEGER;
  53.       busy: BOOLEAN;
  54.       CONSTRUCTOR Init;
  55.       FUNCTION  GetClassName: PCHAR; VIRTUAL;
  56.       PROCEDURE GetWindowClass(VAR c: TWndClass); VIRTUAL;
  57.       PROCEDURE SetupWindow; VIRTUAL;
  58.       PROCEDURE DefChildProc(VAR msg: TMessage); VIRTUAL;
  59.       PROCEDURE WMDestroy(VAR msg: TMessage); VIRTUAL wm_first + wm_Destroy;
  60.       PROCEDURE WMTimer(VAR msg: TMessage); VIRTUAL wm_first + wm_Timer;
  61.       PROCEDURE DoIt;
  62.       FUNCTION  GetMsWin: HWnd;
  63.       PROCEDURE GetBoard(VAR bomb: BOOLEAN);
  64.       PROCEDURE Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  65.       PROCEDURE Mark(x, y: INTEGER);
  66.       PROCEDURE ClearFields(VAR somethingDone: BOOLEAN);
  67.       PROCEDURE MarkFields(VAR somethingDone: BOOLEAN);
  68.       FUNCTION  TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  69.       PROCEDURE TwoFields(VAR success: BOOLEAN);
  70.       PROCEDURE ClearRandom(VAR somethingHappened: BOOLEAN);
  71.     END;
  72.  
  73.   VAR
  74.     thisApp: TThisApp;
  75.     bb: ARRAY [0..25, 0..31] OF INTEGER;
  76.     ee: ARRAY [0..25, 0..31] OF INTEGER;
  77.  
  78.   CONSTRUCTOR TThisWindow.Init;
  79.   BEGIN
  80.     TDlgWindow.Init(NIL, appName);
  81.   END;
  82.  
  83.   FUNCTION TThisWindow.GetClassName;
  84.   BEGIN
  85.     GetClassName := appName;
  86.   END;
  87.  
  88.   PROCEDURE TThisWindow.GetWindowClass(VAR c: TWndClass);
  89.   BEGIN
  90.     TDlgWindow.GetWindowClass(c);
  91.     {c.hIcon := LoadIcon(hInstance, appName); doesn't work?!}
  92.   END;
  93.  
  94.   PROCEDURE TThisWindow.SetupWindow;
  95.     VAR
  96.       i: INTEGER;
  97.   BEGIN
  98.     TDlgWindow.SetupWindow;
  99.     IF SetTimer(hWindow, 1, 1000, NIL) = 0 THEN BEGIN
  100.       MessageBox(HWindow, 'Sorry, no timers', NIL, mb_Ok);
  101.       Destroy;
  102.     END;
  103.     {Setting the icon didn't work in GetWindowClass, dunno why}
  104.     SetClassWord(hWindow, GCW_HICON, LoadIcon(hInstance, appName));
  105.     animation := POS('n', ParamStr(1)) <> 0;
  106.     IF POS('h', ParamStr(1)) <> 0 THEN BEGIN
  107.       cmdShow := sw_Hide;
  108.     END ELSE IF POS('c', ParamStr(1)) <> 0 THEN BEGIN
  109.       cmdShow := sw_Minimize;
  110.     END;
  111.     IF POS('a', ParamStr(1)) <> 0 THEN BEGIN
  112.       stat := active;
  113.     END ELSE IF POS('i', ParamStr(1)) <> 0 THEN BEGIN
  114.       stat := inactive;
  115.     END ELSE BEGIN
  116.       stat := automatic;
  117.     END;
  118.     IF POS('b', ParamStr(1)) <> 0 THEN BEGIN
  119.       lev := basic;
  120.     END ELSE IF POS('r', ParamStr(1)) <> 0 THEN BEGIN
  121.       lev := rand;
  122.     END ELSE BEGIN
  123.       lev := expert;
  124.     END;
  125.     SendDlgItemMsg(stat, bm_SetCheck, 1, 0);
  126.     SendDlgItemMsg(lev, bm_SetCheck, 1, 0);
  127.     SendDlgItemMsg(id_animation, bm_SetCheck, ORD(animation), 0);
  128.     RANDOMIZE;
  129.     busy := FALSE;
  130.   END;
  131.  
  132.   PROCEDURE TThisWindow.Click(x, y: INTEGER; btnDown, btnUp, modifier: WORD);
  133.   BEGIN
  134.     IF animation THEN BEGIN
  135.       SetCursorPos(mswX + xOff + 16*x + 8, mswY + yOff + 16*y + 8);
  136.     END;
  137.     SendMessage(msWin, btnDown, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  138.     SendMessage(msWin, btnUp, modifier, MakeLong(xOff + 16*x, yOff + 16*y));
  139.   END; {Click}
  140.  
  141.   PROCEDURE TThisWindow.GetBoard(VAR bomb: BOOLEAN);
  142.     {Examine the Minesweeper window client area. Get the contents of the
  143.      individual squares by reading pixels at strategic locations. Colors
  144.      are masked with $FFC0C0C0, because not all display drivers use the same
  145.      intensities for colors like dark cyan or dark red}
  146.     VAR
  147.       x, y, v: INTEGER;
  148.       rgb: LONGINT;
  149.       msDC: HDC;
  150.   BEGIN
  151.     bomb := FALSE;
  152.     msDC := GetDC(msWin);
  153.     FOR y := 1 TO dimY DO BEGIN
  154.       FOR x := 1 TO dimX DO BEGIN
  155.         rgb := GetPixel(msDC, xOff + 9 + 16*x, yOff + 12 + 16*y) AND $ffc0c0c0;
  156.         IF rgb = blue THEN BEGIN
  157.           bb[y, x] := 1;
  158.         END ELSE IF rgb = dgreen THEN BEGIN
  159.           bb[y, x] := 2;
  160.         END ELSE IF rgb = red THEN BEGIN
  161.           bb[y, x] := 3;
  162.         END ELSE IF rgb = dblue THEN BEGIN
  163.           bb[y, x] := 4;
  164.         END ELSE IF rgb = dred THEN BEGIN
  165.           bb[y, x] := 5;
  166.         END ELSE IF rgb = dcyan THEN BEGIN
  167.           bb[y, x] := 6;
  168.         END ELSE IF rgb = black THEN BEGIN
  169.           rgb := GetPixel(msDC, xOff + 7 + 16*x, yOff + 6 + 16*y);
  170.           IF rgb = white THEN BEGIN
  171.             bb[y, x] := -2; bomb := TRUE; {mine}
  172.           END ELSE BEGIN
  173.             rgb := rgb AND $ffc0c0c0;
  174.             IF rgb = gray THEN BEGIN
  175.               bb[y, x] := 7;
  176.             END ELSE IF rgb = red THEN BEGIN
  177.               bb[y, x] := 128; {flag}
  178.             END ELSE IF rgb = black THEN BEGIN
  179.               bb[y, x] := 2049; {question mark}
  180.             END ELSE BEGIN
  181.               bb[y, x] := -999; bomb := TRUE; {invisible}
  182.             END;
  183.           END;
  184.         END ELSE IF rgb = dgray THEN BEGIN
  185.           bb[y, x] := 8;
  186.         END ELSE IF rgb = gray THEN BEGIN
  187.           rgb := GetPixel(msDC, xOff + 15 + 16*x, yOff + 1 +16*y) AND $ffc0c0c0;
  188.           IF rgb = gray THEN BEGIN
  189.             bb[y, x] := 0;
  190.           END ELSE IF rgb = dgray THEN BEGIN
  191.             rgb := GetPixel(msDC, xOff + 5 + 16*x, yOff + 5 +16*y) AND $ffc0c0c0;
  192.             IF rgb = black THEN BEGIN
  193.               bb[y,x] := 2049; {question mark}
  194.             END ELSE IF rgb = gray THEN BEGIN
  195.               bb[y, x] := 2048; {covered}
  196.             END ELSE BEGIN
  197.               bb[y, x] := -999; bomb := TRUE;
  198.             END;
  199.           END ELSE BEGIN
  200.             bb[y, x] := -999; bomb := TRUE; {invisible}
  201.           END;
  202.         END ELSE BEGIN
  203.           bb[y, x] := -999; bomb := TRUE; {invisible}
  204.         END;
  205.       END; {FOR x}
  206.     END; {FOR y}
  207.     ReleaseDC(msWin, msDC);
  208.     IF NOT bomb THEN BEGIN
  209.       FOR y := 1 TO dimY DO BEGIN
  210.         FOR x := 1 TO dimX DO BEGIN
  211.           v := bb[y, x];
  212.           IF (v > 0) AND (v <= 8) THEN BEGIN
  213.             ee[y, x] := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  214.                         bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  215.           END ELSE BEGIN
  216.             ee[y, x] := 0;
  217.           END;
  218.         END; {FOR x}
  219.       END; {FOR y}
  220.     END; {NOT bomb}
  221.   END; {GetBoard}
  222.  
  223.   FUNCTION TThisWindow.GetMsWin: HWnd;
  224.     {Find the Minesweeper window and its location on the screen}
  225.     VAR
  226.       w, mW: HWnd;
  227.       st: ARRAY[0..32] OF CHAR;
  228.       rp: RECORD
  229.             CASE INTEGER OF 1: (r: TRect);
  230.                             2: (p: TPoint);
  231.           END;
  232.       i: INTEGER;
  233.   BEGIN
  234.     w := 0;
  235.     mW := 0;
  236.     w := GetWindow(hWindow, gw_HWndFirst);
  237.     WHILE (w <> 0) AND (mW = 0) DO BEGIN
  238.       GetWindowText(w, st, 32);
  239.       IF StrComp(st, 'Minesweeper') = 0 THEN BEGIN
  240.         mW := w;
  241.         GetClientRect(mW, rp.r);
  242.         dimX := (rp.r.right - 24) DIV 16;
  243.         dimY := (rp.r.bottom - 67) DIV 16;
  244.         ClientToScreen(mW, rp.p);
  245.         mswX := rp.p.x;
  246.         mswY := rp.p.y;
  247.       END;
  248.       w := GetNextWindow(w, gw_HWndNext);
  249.     END;
  250.     IF mW <> 0 THEN BEGIN
  251.       FOR i := 0 TO dimX + 1 DO BEGIN
  252.         bb[0, i] := 0;
  253.         ee[0, i] := 0;
  254.         bb[dimY + 1, i] := 0;
  255.         ee[dimY + 1, i] := 0;
  256.       END;
  257.       FOR i:= 1 TO dimY DO BEGIN
  258.         bb[i, 0] := 0;
  259.         ee[i, 0] := 0;
  260.         bb[i, dimX + 1] := 0;
  261.         ee[i, dimX + 1] := 0;
  262.       END;
  263.     END;
  264.     GetMsWin := mW;
  265.   END; {GetMsWin}
  266.  
  267.   PROCEDURE TThisWindow.ClearFields(VAR somethingDone: BOOLEAN);
  268.     VAR
  269.       x, y, v, c: INTEGER;
  270.   BEGIN
  271.     somethingDone := FALSE;
  272.     FOR y := 1 TO dimY DO BEGIN
  273.       FOR x := 1 TO dimX DO BEGIN
  274.         v := bb[y, x];
  275.         IF (v > 0) AND (v <= 8) THEN BEGIN
  276.           c := ee[y, x];
  277.           IF c >= 2048 THEN BEGIN {at least 1 covered field}
  278.             c := c AND 2047 SHR 7; {number of flagged fields}
  279.             IF v = c THEN BEGIN
  280.               Click(x, y, wm_LButtonDown, wm_LButtonUp, mk_RButton);
  281.               somethingDone := TRUE;
  282.               IF stat <> automatic THEN BEGIN
  283.                 EXIT;
  284.               END;
  285.             END;
  286.           END;
  287.         END; {IF (v > 0) ..}
  288.       END; {FOR x}
  289.     END; {FOR y}
  290.   END; {ClearFields}
  291.  
  292.   PROCEDURE TThisWindow.Mark(x, y: INTEGER);
  293.   BEGIN
  294.     Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  295.     IF bb[y, x] = 2049 THEN BEGIN {question mark}
  296.       Click(x, y, wm_RButtonDown, wm_RButtonUp, 0);
  297.     END;
  298.     bb[y, x] := 128; {make it flagged}
  299.   END; {Mark}
  300.  
  301.   PROCEDURE TThisWindow.MarkFields(VAR somethingDone: BOOLEAN);
  302.     VAR
  303.       x, y, v, c, f: INTEGER;
  304.   BEGIN
  305.     somethingDone := FALSE;
  306.     FOR y := 1 TO dimY DO BEGIN
  307.       FOR x := 1 TO dimX DO BEGIN
  308.         v := bb[y, x];
  309.         IF (v > 0) AND (v <= 8) THEN BEGIN
  310.           c := bb[y-1,x-1]+bb[y-1,x]+bb[y-1,x+1]+bb[y,x-1]+
  311.                bb[y,x+1]+bb[y+1,x-1]+bb[y+1,x]+bb[y+1,x+1];
  312.           f := c SHR 11; {number of covered fields}
  313.           IF f <> 0 THEN BEGIN
  314.             c := c AND 2047 SHR 7; {number of flagged fields}
  315.             IF (f + c) = v THEN BEGIN
  316.               IF bb[y-1,x-1] >= 2048 THEN BEGIN Mark(x-1,y-1); END;
  317.               IF bb[y-1,x  ] >= 2048 THEN BEGIN Mark(x,  y-1); END;
  318.               IF bb[y-1,x+1] >= 2048 THEN BEGIN Mark(x+1,y-1); END;
  319.               IF bb[y  ,x-1] >= 2048 THEN BEGIN Mark(x-1,y  ); END;
  320.               IF bb[y,  x+1] >= 2048 THEN BEGIN Mark(x+1,y  ); END;
  321.               IF bb[y+1,x-1] >= 2048 THEN BEGIN Mark(x-1,y+1); END;
  322.               IF bb[y+1,x  ] >= 2048 THEN BEGIN Mark(x,  y+1); END;
  323.               IF bb[y+1,x+1] >= 2048 THEN BEGIN Mark(x+1,y+1); END;
  324.               somethingDone := TRUE;
  325.               IF stat <> automatic THEN BEGIN
  326.                 EXIT;
  327.               END;
  328.             END;
  329.           END;
  330.         END; {IF (v > 0) ..}
  331.       END; {FOR x}
  332.     END; {FOR y}
  333.   END; {MarkFields}
  334.  
  335.   FUNCTION TThisWindow.TwoFieldSearch(x1, y1, x2, y2: INTEGER): BOOLEAN;
  336.     VAR
  337.       a, b, c, x, y, na, nb: INTEGER;
  338.  
  339.     PROCEDURE ClickFields(xx1, yy1, xx2, yy2: INTEGER; marks: BOOLEAN);
  340.       {Click on covered fields in environment of (x1,y1) but not of (x2,y2)}
  341.       VAR
  342.         xx, yy, dbg: INTEGER;
  343.     BEGIN
  344.       FOR yy := yy1 - 1 TO yy1 + 1 DO BEGIN
  345.         FOR xx := xx1 - 1 TO xx1 + 1 DO BEGIN
  346.           IF ((ABS(yy-yy2) > 1) OR (ABS(xx-xx2) > 1)) AND (bb[yy,xx] >= 2048) THEN BEGIN
  347.             IF marks THEN BEGIN
  348.               Mark(xx, yy);
  349.             END ELSE BEGIN
  350.               Click(xx, yy, wm_LButtonDown, wm_LButtonUp, 0);
  351.               bb[yy, xx] := 0; {meaning uncovered with unknown value}
  352.             END;
  353.           END;
  354.         END; {FOR xx}
  355.       END; {FOR yy}
  356.       TwoFieldSearch := TRUE;
  357.     END; {ClickFields}
  358.  
  359.   BEGIN {TwoFieldSearch}
  360.     TwoFieldSearch := FALSE;
  361.     c := ee[y1, x1];
  362.     x := bb[y1, x1] - c AND 2047 SHR 7; {Number of unknown mines around A=(x1,y1)}
  363.     a := c SHR 11; {Number of covered fields around A=(x1,y1)}
  364.     c := ee[y2, x2];
  365.     y := bb[y2, x2] - c AND 2047 SHR 7; {Number of unknown mines around B=(x2,y2)}
  366.     b := c SHR 11; {Number of covered fields around B=(x2,y2)}
  367.     c := 0;
  368.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1+1,x1] >= 2048) THEN c := c + 1;
  369.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1+1,x1+1]>=2048) THEN c := c + 1;
  370.     IF (ABS(y1+1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1+1,x1-1]>=2048) THEN c := c + 1;
  371.     IF (ABS(y1-y2) <= 1) AND (ABS(x1+1-x2)<= 1) AND (bb[y1,x1+1] >= 2048) THEN c := c + 1;
  372.     IF (ABS(y1-y2) <= 1) AND (ABS(x1-1-x2)<= 1) AND (bb[y1,x1-1] >= 2048) THEN c := c + 1;
  373.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-x2) <= 1) AND (bb[y1-1,x1] >= 2048) THEN c := c + 1;
  374.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1+1-x2)<=1) AND (bb[y1-1,x1+1]>=2048) THEN c := c + 1;
  375.     IF (ABS(y1-1-y2) <=1) AND (ABS(x1-1-x2)<=1) AND (bb[y1-1,x1-1]>=2048) THEN c := c + 1;
  376.     {c = number of covered fields common to the environments of A and B}
  377.     a := a - c;
  378.     b := b - c;
  379.     na := -1;
  380.     nb := -1;
  381.     IF a = 0 THEN BEGIN
  382.       na := 0;
  383.     END ELSE IF x + b = y THEN BEGIN
  384.       na := 0;
  385.     END ELSE IF x - a = y THEN BEGIN
  386.       na := a;
  387.     END ELSE IF b = 0 THEN BEGIN
  388.       na := x - y;
  389.     END;
  390.     IF na >= 0 THEN BEGIN
  391.       nb := y - x + na;
  392.     END ELSE IF b = 0 THEN BEGIN
  393.       nb := 0;
  394.     END ELSE IF y - b = x THEN BEGIN
  395.       nb := b;
  396.     END ELSE IF a = 0 THEN BEGIN
  397.       nb := y - x;
  398.     END;
  399.     IF nb >= 0 THEN BEGIN
  400.       na := x - y + nb;
  401.     END;
  402.     IF a <> 0 THEN BEGIN
  403.       IF na = 0 THEN BEGIN
  404.         {Clear all fields in env A but not env B}
  405.         ClickFields(x1, y1, x2, y2, FALSE);
  406.       END ELSE IF na = a THEN BEGIN
  407.         {Mark all those fields}
  408.         ClickFields(x1, y1, x2, y2, TRUE);
  409.       END;
  410.     END;
  411.     IF b <> 0 THEN BEGIN
  412.       IF (nb = 0) AND (b <> 0) THEN BEGIN
  413.         {Clear all fields in env B but not env A}
  414.         ClickFields(x2, y2, x1, y1, FALSE);
  415.       END ELSE IF nb = b THEN BEGIN
  416.         {Mark all those fields}
  417.         ClickFields(x2, y2, x1, y1, TRUE);
  418.       END;
  419.     END;
  420.   END; {TwoFieldSearch}
  421.  
  422.   PROCEDURE TThisWindow.TwoFields(VAR success: BOOLEAN);
  423.  
  424.     PROCEDURE S(x1, y1: INTEGER);
  425.       VAR
  426.         x, y, miny, maxy: INTEGER;
  427.     BEGIN
  428.       IF success AND (stat <> automatic) THEN BEGIN
  429.         EXIT;
  430.       END;
  431.       IF y1 >= 0 THEN BEGIN
  432.         miny := 1;
  433.         maxy := dimY - y1;
  434.       END ELSE BEGIN
  435.         miny := 1 - y1;
  436.         maxy := dimY;
  437.       END;
  438.       FOR y := miny TO maxy DO BEGIN
  439.         FOR x := 1 TO dimX - x1 DO BEGIN
  440.           IF (ee[y, x] >= 2048) AND (ee[y + y1, x + x1] >= 2048) THEN BEGIN
  441.             success := success OR TwoFieldSearch(x, y, x + x1, y + y1);
  442.             IF success AND (stat <> automatic) THEN BEGIN
  443.               EXIT;
  444.             END;
  445.           END;
  446.         END;
  447.       END;
  448.     END; {S}
  449.  
  450.   BEGIN {TwoFields}
  451.     success := FALSE;
  452.     S(1, 0); S(0, -1); S(1, 1); S(1, -1); S(2, -1); S(2, 1);
  453.     S(1, -2); S(1, 2); S(2, 0); S(0, -2); S(2, -2); S(2, 2);
  454.   END; {TwoFields}
  455.  
  456.   PROCEDURE TThisWindow.ClearRandom(VAR somethingHappened: BOOLEAN);
  457.     VAR
  458.       x, y, c, i: INTEGER;
  459.       bomb: BOOLEAN;
  460.   BEGIN
  461.     GetBoard(bomb);
  462.     somethingHappened := FALSE;
  463.     IF NOT bomb THEN BEGIN
  464.       c := 0;
  465.       FOR y := 1 TO dimY DO BEGIN
  466.         FOR x:= 1 TO dimX DO BEGIN
  467.           IF bb[y, x] >= 2048 THEN BEGIN
  468.             c := c + 1;
  469.           END;
  470.         END;
  471.       END;
  472.       IF c <> 0 THEN BEGIN
  473.         i := RANDOM(c);
  474.         c := 0;
  475.         FOR y := 1 TO dimY DO BEGIN
  476.           FOR x := 1 TO dimX DO BEGIN
  477.             IF bb[y, x] >= 2048 THEN BEGIN
  478.               IF c = i THEN BEGIN
  479.                 Click(x, y, wm_LButtonDown, wm_LButtonUp, 0);
  480.                 somethingHappened := TRUE;
  481.                 EXIT;
  482.               END;
  483.               c := c + 1;
  484.             END;
  485.           END; {FOR x}
  486.         END; {FOR y}
  487.       END; {c <> 0}
  488.     END; {NOT bomb}
  489.   END; {ClearRandom}
  490.  
  491.   PROCEDURE WaitIdle;
  492.     {It's impolite to hog the CPU}
  493.     VAR
  494.       m: TMsg;
  495.   BEGIN
  496.     WHILE PeekMessage(m, 0, 0, 0, pm_Remove) DO BEGIN
  497.       IF m.message = wm_Quit THEN BEGIN
  498.         HALT(m.wParam);
  499.       END;
  500.       TranslateMessage(m);
  501.       DispatchMessage(m);
  502.     END;
  503.   END;
  504.  
  505.   PROCEDURE TThisWindow.DefChildProc(VAR msg: TMessage);
  506.     VAR
  507.       i: INTEGER;
  508.   BEGIN
  509.     WITH msg DO BEGIN
  510.       IF (lParamLo <> 0) AND (lParamHi <> 1) THEN BEGIN
  511.         { not menu, not accelerator id }
  512.         IF wParam = inactive THEN BEGIN
  513.           stat := inactive;
  514.         END ELSE IF wParam = active THEN BEGIN
  515.           stat := active;
  516.         END ELSE IF wParam = automatic THEN BEGIN
  517.           stat := automatic;
  518.         END ELSE IF wParam = basic THEN BEGIN
  519.           lev := basic;
  520.         END ELSE IF wParam = expert THEN BEGIN
  521.           lev := expert;
  522.         END ELSE IF wParam = rand THEN BEGIN
  523.           lev := rand;
  524.         END ELSE IF wParam = id_Animation THEN BEGIN
  525.           animation := NOT animation;
  526.           SendDlgItemMsg(id_Animation, bm_SetCheck, ORD(animation), 0);
  527.         END ELSE IF wParam = id_OK THEN BEGIN
  528.           IF stat = active THEN BEGIN
  529.             DoIt;
  530.           END;
  531.         END;
  532.       END; {IF (lParamLo ..}
  533.     END; {WITH msg}
  534.     TDlgWindow.DefChildProc(msg);
  535.   END;
  536.  
  537.   PROCEDURE TThisWindow.DoIt;
  538.     VAR
  539.       bomb, somethingHappened, action: BOOLEAN;
  540.       x, y: INTEGER;
  541.       m: TMsg;
  542.   BEGIN
  543.     IF busy THEN BEGIN
  544.       {avoid reentrancy}
  545.       EXIT;
  546.     END;
  547.     busy := TRUE;
  548.     msWin := GetMsWin;
  549.     IF msWin <> 0 THEN BEGIN
  550.      REPEAT
  551.       REPEAT
  552.         GetBoard(bomb);
  553.         action := FALSE;
  554.         somethingHappened := TRUE;
  555.         WHILE NOT bomb AND somethingHappened DO BEGIN
  556.           MarkFields(somethingHappened);
  557.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  558.             busy := FALSE;
  559.             EXIT;
  560.           END;
  561.           WaitIdle;
  562.           action := action OR somethingHappened;
  563.           {GetBoard(msWin, bomb);}
  564.         END;
  565.         somethingHappened := TRUE;
  566.         WHILE NOT bomb AND somethingHappened DO BEGIN
  567.           ClearFields(somethingHappened);
  568.           IF somethingHappened AND (stat <> automatic) THEN BEGIN
  569.             busy := FALSE;
  570.             EXIT;
  571.           END;
  572.           WaitIdle;
  573.           action := action OR somethingHappened;
  574.           GetBoard(bomb);
  575.         END;
  576.         {action = there were changes in mark and clear phases}
  577.       UNTIL NOT action OR bomb;
  578.       somethingHappened := lev > basic;
  579.       WHILE NOT bomb AND somethingHappened DO BEGIN
  580.         TwoFields(somethingHappened);
  581.         IF somethingHappened AND (stat <> automatic) THEN BEGIN
  582.           busy := FALSE;
  583.           EXIT;
  584.         END;
  585.         WaitIdle;
  586.         action := action OR somethingHappened;
  587.         GetBoard(bomb);
  588.       END;
  589.       IF (lev = rand) AND NOT action THEN BEGIN
  590.         ClearRandom(action);
  591.         IF stat <> automatic THEN BEGIN
  592.           busy := FALSE;
  593.           EXIT;
  594.         END;
  595.       END;
  596.      UNTIL NOT action OR bomb;
  597.     END; {msWin <> 0}
  598.     busy := FALSE;
  599.   END; {DoIt}
  600.  
  601.   PROCEDURE TThisWindow.WMTimer(VAR msg: TMessage);
  602.   BEGIN
  603.     IF stat = automatic THEN BEGIN
  604.       DoIt;
  605.     END;
  606.   END;
  607.  
  608.   PROCEDURE TThisWindow.WMDestroy(VAR msg: TMessage);
  609.   BEGIN
  610.     KillTimer(hWindow, 1);
  611.     TDlgWindow.WMDestroy(msg);
  612.   END;
  613.  
  614.   PROCEDURE TThisApp.InitMainWindow;
  615.   begin
  616.     mainWindow := NEW(PThisWindow, Init);
  617.   end;
  618.  
  619. BEGIN
  620.   {$G-}
  621.   IF (GetWinFlags AND (wf_CPU086 OR wf_CPU186)) <> 0 THEN BEGIN
  622.     MessageBox(0, 'WinHelp needs a 286 or better', NIL, mb_OK);
  623.     HALT(0);
  624.   END;
  625.   {$G+}
  626.   thisApp.Init(appName);
  627.   thisApp.Run;
  628.   thisApp.Done;
  629. END.
  630.