home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol11n01.zip / LN1101.ZIP / TICTACTO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-10  |  13KB  |  397 lines
  1. PROGRAM TicTacTo;
  2. Uses WinTypes, WinProcs, WObjects;
  3. {$R TicTacTo}
  4. {$D Copyright (c) 1991 by Neil J. Rubenking}
  5. CONST
  6.   AppName : PChar = 'TicTacTo';
  7.   cm_CCs  = 102;
  8.   cm_CPs  = 103;
  9.   cm_PXs  = 104;
  10.   cm_POs  = 105;
  11.   cm_Help = 106;
  12.   Xv      = 1;    X2 = 2*Xv;
  13.   Ov      = 4;    O2 = 2*Ov;
  14.   Draw    = 255;
  15.  
  16. TYPE
  17.   TMyApplication = object(TApplication)
  18.     PROCEDURE InitMainWindow; virtual;
  19.   END;
  20.  
  21.   PTicWindow = ^TTicWindow;
  22.   TTicWindow = OBJECT(TWindow)
  23.     Rects         : ARRAY[0..8] OF TRect;
  24.     Plays         : ARRAY[0..9] OF Byte;
  25.     IsX, UseComp  : Boolean;
  26.     Moves, PenWid : Word;
  27.     CONSTRUCTOR Init(AParent : PWindowsObject; AName : PChar);
  28.     FUNCTION GetClassName : PChar; Virtual;
  29.     PROCEDURE GetWindowClass(var AWndClass: TWndClass); Virtual;
  30.     PROCEDURE Paint(pDC : hDC; VAR PS : TPaintStruct); Virtual;
  31.     PROCEDURE NewGame(XStart, vsComp : Boolean);
  32.     PROCEDURE PlayAndCheck(NewSpot : Word);
  33.     PROCEDURE ProgPlay;
  34.     PROCEDURE wmLButtonDown(VAR Msg : TMessage);
  35.       Virtual wm_First + wm_LButtonDown;
  36.     PROCEDURE WMKeyDown(VAR Msg : TMessage);
  37.       Virtual wm_First + wm_KeyDown;
  38.     PROCEDURE wmNCHitTest(VAR Msg : TMessage);
  39.        Virtual wm_First + wm_NCHitTest;
  40.     PROCEDURE DefCommandProc(VAR Msg : TMessage); Virtual;
  41.   END;
  42.  
  43. {--------------------------------------------------}
  44. { TTicWindow's methods                            }
  45. {--------------------------------------------------}
  46.   CONSTRUCTOR TTicWindow.Init(AParent : PWindowsObject; AName : PChar);
  47.   BEGIN
  48.     TWindow.Init(AParent, AName);
  49.     Attr.Menu := LoadMenu(hInstance, AppName);
  50.     NewGame(TRUE, TRUE);
  51.     Randomize;
  52.   END;
  53.  
  54.   FUNCTION TTicWindow.GetClassName;
  55.   BEGIN GetClassName := AppName; END;
  56.  
  57.   PROCEDURE TTicWindow.GetWindowClass(VAR AWndClass : TWndClass);
  58.   BEGIN
  59.     TWindow.GetWindowClass(AWndClass);
  60.     AWndClass.hIcon := LoadIcon(HInstance, AppName);
  61.     AWndClass.hCursor := 0;
  62.   END;
  63.  
  64. {x$DEFINE ShowSlow}
  65.   PROCEDURE TTicWindow.Paint(pDC : hDC; VAR PS : TPaintStruct);
  66.   VAR X, Y, X3, Y3, X16, Y16, N  : Integer;
  67.       hp, oldp                   : hPen;
  68.       TR                         : TRect;
  69.   CONST Blue  = $00FF0000;
  70.         Red   = $000000FF;
  71.  
  72.     PROCEDURE OneSquare(N : Integer);
  73. {$IFDEF ShowSlow}
  74.     VAR Slow : LongInt;
  75.     {100000 is for 486/33 - reduce for slower machines}
  76.     CONST Factor = 100000;
  77. {$ENDIF}
  78.     BEGIN
  79. {$IFDEF ShowSlow}
  80.       FOR Slow := 1 to Factor DO N := N;
  81. {$ENDIF}
  82.       CASE Plays[N] OF
  83.         Xv: BEGIN
  84.           hp := CreatePen(ps_Solid, PenWid, Red);
  85.           oldp := SelectObject(pDC, hp);
  86.           WITH Rects[N] DO
  87.             BEGIN
  88.               MoveTo(pDC, Left, Top);  LineTo(pDC, Right, Bottom);
  89.               MoveTo(pDC, Right, Top); LineTo(pDC, Left, Bottom);
  90.             END;
  91.           SelectObject(pDC, OldP);
  92.           DeleteObject(hP);
  93.         END;
  94.         Ov: BEGIN
  95.           hp := CreatePen(ps_Solid, PenWid, blue);
  96.           oldp := SelectObject(pDC, hp);
  97.           WITH Rects[N] DO Ellipse(pDC, Left, Top, RIght, Bottom);
  98.           SelectObject(pDC, OldP);
  99.           DeleteObject(hP);
  100.         END;
  101.       END;
  102.     END;
  103.  
  104.   BEGIN
  105.     GetClientRect(hWindow, TR);
  106.     X   := TR.Right;  Y   := TR.Bottom;
  107.     X3  := X DIV 3;   Y3  := Y DIV 3;
  108.     X16 := X DIV 16;  Y16 := Y DIV 16;
  109.     IF X16 < Y16 THEN PenWid := 2*X16 DIV 3
  110.     ELSE PenWid := 2*Y16 DIV 3;
  111.     IF EqualRect(TR, PS.rcPaint) THEN {paint whole window}
  112.       BEGIN
  113.         {draw the # diagram}
  114.         hp   := CreatePen(ps_Solid, PenWid, 0);
  115.         oldp := SelectObject(pDC, hp);
  116.         MoveTo(pDC, X3,   Y16);   LineTo(pDC, X3,    Y-Y16);
  117.         MoveTo(pDC, 2*X3, Y16);   LineTo(pDC, 2*X3,  Y-Y16);
  118.         MoveTo(pDC, X16,  Y3);    LineTo(pDC, X-X16, Y3);
  119.         MoveTo(pDC, X16,  2*Y3);  LineTo(pDC, X-X16, 2*Y3);
  120.         SelectObject(pDC, OldP);
  121.         DeleteObject(hP);
  122.         {establish the "control" rectangles}
  123.         FOR N := 0 to 8 DO
  124.           BEGIN
  125.             SetRect(Rects[N], (N MOD 3)*X3, (N DIV 3)*Y3,
  126.               Succ(N MOD 3)*X3, Succ(N DIV 3)*Y3);
  127.             InflateRect(Rects[N], -X16, -Y16);
  128.           END;
  129.         {draw the X's and O's}
  130.         FOR N := 0 to 8 DO OneSquare(N);
  131.       END
  132.     ELSE {just paint the necessary areas}
  133.       BEGIN
  134.         {paint squares that need it}
  135.         FOR N := 0 to 8 DO
  136.           IF IntersectRect(TR,Rects[N],PS.rcPaint)<>0 THEN
  137.             OneSquare(N);
  138.         {paint lines of the # diagram that need it}
  139.         hp   := CreatePen(ps_Solid, PenWid, 0);
  140.         oldp := SelectObject(pDC, hp);
  141.         SetRect(TR, X3-X16, Y16, X3+X16, Y-Y16);
  142.         IF IntersectRect(TR, TR, PS.rcPaint) <> 0 THEN
  143.           BEGIN
  144.             MoveTo(pDC, X3, Y16);
  145.             LineTo(pDC, X3, Y-Y16);
  146.           END;
  147.         SetRect(TR, 2*X3-X16, Y16, 2*X3+X16, Y-Y16);
  148.         IF IntersectRect(TR, TR, PS.rcPaint) <> 0 THEN
  149.           BEGIN
  150.             MoveTo(pDC, 2*X3, Y16);
  151.             LineTo(pDC, 2*X3, Y-Y16);
  152.           END;
  153.         SetRect(TR, X16, Y3-Y16, X-X16, Y3+Y16);
  154.         IF IntersectRect(TR, TR, PS.rcPaint) <> 0 THEN
  155.           BEGIN
  156.             MoveTo(pDC, X16, Y3);
  157.             LineTo(pDC, X-X16, Y3);
  158.           END;
  159.         SetRect(TR, X16, 2*Y3-Y16, X-X16, 2*Y3+Y16);
  160.         IF IntersectRect(TR, TR, PS.rcPaint) <> 0 THEN
  161.           BEGIN
  162.             MoveTo(pDC, X16, 2*Y3);
  163.             LineTo(pDC, X-X16, 2*Y3);
  164.           END;
  165.         SelectObject(pDC, OldP);
  166.         DeleteObject(hP);
  167.       END;
  168.   END;
  169.  
  170.   PROCEDURE TTicWindow.NewGame(XStart, vsComp : Boolean);
  171.   BEGIN
  172.     IsX := XStart; UseComp := vsComp;
  173.     FillChar(Plays, SizeOf(Plays), 0);
  174.     Plays[9] := 127; Moves := 0;
  175.     InvalidateRect(hWindow, NIL, TRUE);
  176.     IF UseCOMP AND (NOT IsX) THEN ProgPlay;
  177.   END;
  178.  
  179.   PROCEDURE TTicWindow.PlayAndCheck(NewSpot : Word);
  180.   VAR TR : TRect;
  181.  
  182.     FUNCTION Won : Byte;
  183.     VAR N : Word;
  184.     BEGIN
  185.       FOR N := 0 to 2 DO
  186.         CASE Plays[N*3+0] + Plays[N*3+1] + Plays[N*3+2] OF
  187.           3*Xv: BEGIN Won := Xv; Exit; END;
  188.           3*Ov: BEGIN Won := Ov; Exit; END;
  189.         END;
  190.       FOR N := 0 to 2 DO
  191.         CASE Plays[N+0] + Plays[N+3] + Plays[N+6] OF
  192.           3*Xv: BEGIN Won := Xv; Exit; END;
  193.           3*Ov: BEGIN Won := Ov; Exit; END;
  194.         END;
  195.       CASE Plays[0] + Plays[4] + Plays[8] OF
  196.         3*Xv: BEGIN Won := Xv; Exit; END;
  197.         3*Ov: BEGIN Won := Ov; Exit; END;
  198.       END;
  199.       CASE Plays[2] + Plays[4] + Plays[6] OF
  200.         3*Xv: BEGIN Won := Xv; Exit; END;
  201.         3*Ov: BEGIN Won := Ov; Exit; END;
  202.       END;
  203.       IF Moves = 9 THEN
  204.         BEGIN Won := Draw; Exit; END;
  205.       Won := 0;
  206.     END;
  207.  
  208.   BEGIN
  209.     IF Plays[NewSpot] <> 0 THEN
  210.       BEGIN MessageBeep(0); Exit; END;
  211.     IF IsX THEN Plays[NewSpot] := Xv ELSE Plays[NewSpot] := Ov;
  212.     Inc(Moves);
  213.     IsX := NOT IsX;
  214.     TR  := Rects[NewSpot];
  215.     InflateRect(TR, PenWid, PenWid);
  216.     InvalidateRect(hWindow, @Tr, FALSE);
  217.     CASE Won OF
  218.       Xv   : BEGIN
  219.         MessageBox(hWindow,'X wins!','A WINNER!', mb_Ok);
  220.         NewGame(IsX XOR Odd(Moves), UseComp);
  221.       END;
  222.       Ov   : BEGIN
  223.         MessageBox(hWindow,'O wins!','A WINNER!', mb_Ok);
  224.         NewGame(IsX XOR Odd(Moves), UseComp);
  225.       END;
  226.       Draw : BEGIN
  227.         MessageBox(hWindow,'A Draw!','NO WINNER!', mb_Ok);
  228.         NewGame(NOT IsX, UseComp);
  229.       END;
  230.       ELSE IF UseCOMP AND (NOT IsX) THEN ProgPlay;
  231.     END;
  232.   END;
  233.  
  234.   PROCEDURE TTicWIndow.ProgPlay;
  235.   VAR spot : Word;
  236.       TR   : TRect;
  237.   CONST Corners : ARRAY[0..3] OF Byte = (0, 2, 6, 8);
  238.  
  239.     FUNCTION RateThem : Word;
  240.     {NEVER called 'til after middle square (#4) is used}
  241.     VAR N, Best, BestRate, a1, a2, d1, d2,
  242.         g1, g2, ac, dn, dg : Word;
  243.         Ratings            : ARRAY[0..8] OF Byte;
  244.  
  245.       PROCEDURE UpdateBest(Num, Value : Word);
  246.       BEGIN
  247.         Ratings[Num] := Value;
  248.         IF Value > BestRate THEN
  249.           BEGIN BestRate := Value; Best := Num; END;
  250.       END;
  251.  
  252.     BEGIN
  253.       Best := 0; BestRate := 0;
  254.       FOR N := 0 to 8 DO
  255.         BEGIN
  256.           IF Plays[N] <> 0 THEN Ratings[N] := 0
  257.           ELSE
  258.             BEGIN
  259.               a1 := (N DIV 3) * 3; a2 := succ(a1);
  260.               IF a1 = N THEN Inc(a1, 2);
  261.               IF a2 = N THEN Inc(a2);
  262.               d1 := N MOD 3; d2 := d1 + 3;
  263.               IF d1 = N THEN Inc(D1, 6);
  264.               IF d2 = N THEN Inc(D2, 3);
  265.               g1 := 4;
  266.               IF Odd(N) THEN
  267.                 BEGIN g1 := 9; g2 := 9; END
  268.               ELSE
  269.                 CASE N OF
  270.                   0 : g2 := 8;
  271.                   2 : g2 := 6;
  272.                   6 : g2 := 2;
  273.                   8 : g2 := 0;
  274.                 END;
  275.               ac := Plays[a1] + Plays[a2];
  276.               dn := Plays[d1] + Plays[d2];
  277.               dg := Plays[g1] + Plays[g2];
  278.               IF (ac=O2) OR (dn=O2) OR (dg=O2) THEN
  279.                 UpdateBest(N, 5)
  280.               ELSE IF (ac=X2) OR (dn=X2) OR (dg=X2) THEN
  281.                 UpdateBest(N, 4)
  282.               ELSE IF (ac+dn=O2) OR (ac+dg=O2) OR (dn+dg=O2) THEN
  283.                 UpdateBest(N, 3)
  284.               ELSE IF (ac=Ov) OR (dn=Ov) OR (dg=Ov) THEN
  285.                 UpdateBest(N, 2)
  286.               ELSE UpdateBest(N, 1);
  287.             END;
  288.         END;
  289.       RateThem := Best;
  290.     END;
  291.  
  292.   BEGIN
  293.     CASE Moves OF
  294.       0 : Spot := 4;
  295.       1 : BEGIN
  296.             IF Plays[4] = 0 THEN Spot := 4
  297.             ELSE Spot := Corners[Random(4)];
  298.           END;
  299.       ELSE Spot := RateThem;
  300.     END;
  301.     PlayAndCheck(Spot);
  302.   END;
  303.  
  304.   PROCEDURE TTicWindow.WmLButtonDown(VAR Msg : TMessage);
  305.   VAR N  : Word;
  306.   BEGIN
  307.     N := 0;
  308.     {determine if the mouse is in any of our rectangles}
  309.     WHILE (N < 9) AND (NOT PtInRect(Rects[N], TPoint(Msg.LParam))) DO
  310.       Inc(N);
  311.     IF N < 9 THEN PlayAndCheck(N);
  312.   END;
  313.  
  314.   PROCEDURE TTicWindow.WMKeyDown(VAR Msg : TMessage);
  315.   VAR T : TPoint;
  316.       N : Integer;
  317.   BEGIN
  318.     GetCursorPos(T);
  319.     ScreenToClient(hWindow, T);
  320.     N := 0;
  321.     {determine if the mouse is in any of our rectangles}
  322.     WHILE (N < 9) AND (NOT PtInRect(Rects[N], T)) DO Inc(N);
  323.     IF N = 9 THEN N := 0
  324.     ELSE
  325.       CASE Msg.wParam OF
  326.         vk_Tab   : N := Succ(N) MOD 9;
  327.         vk_Right : IF (N MOD 3) = 2 THEN Dec(N,2) ELSE Inc(N);
  328.         vk_Left  : IF (N MOD 3) = 0 THEN Inc(N,2) ELSE Dec(N);
  329.         vk_Down  : IF (N DIV 3) = 2 THEN Dec(N, 6) ELSE Inc(N, 3);
  330.         vk_Up    : IF (N DIV 3) = 0 THEN Inc(N, 6) ELSE Dec(N, 3);
  331.         vk_Space,
  332.         vk_Return: PlayAndCheck(N);
  333.       END;
  334.     WITH Rects[N] DO
  335.       BEGIN
  336.         T.X := (Right + Left) DIV 2;
  337.         T.Y := (Bottom + Top) DIV 2;
  338.       END;
  339.     ClientToScreen(hWindow, T);
  340.     SetCursorPos(T.X, T.Y);
  341.     DefWndProc(Msg);
  342.   END;
  343.  
  344.   PROCEDURE TTicWindow.WmNCHitTest(VAR Msg : TMessage);
  345.   VAR N    : Word;
  346.       Pt   : TPoint;
  347.       CurA : hCursor;
  348.   BEGIN
  349.     Move(Msg.Lparam, Pt, 4);
  350.     ScreenToClient(hWindow, Pt);
  351.     N := 0;
  352.     WHILE (N < 9) AND (NOT PtInRect(Rects[N], Pt)) DO
  353.       Inc(N);
  354.     IF N < 9  THEN
  355.       BEGIN
  356.         IF Plays[N] <> 0 THEN CurA := LoadCursor(hInstance, 'CurNO')
  357.         ELSE IF IsX THEN CurA := LoadCursor(hInstance, 'CurX')
  358.         ELSE CurA := LoadCursor(hInstance, 'CurO');
  359.       END
  360.     ELSE CurA := LoadCursor(0, idc_Arrow);
  361.     SetCursor(CurA);
  362.     DefWndProc(Msg);
  363.   END;
  364.  
  365.   PROCEDURE TTicWindow.DefCommandProc(VAR Msg : TMessage);
  366.   VAR PD : PDialog;
  367.   BEGIN
  368.     IF Msg.WParamHi = 0 THEN
  369.       CASE Msg.WParamLo OF
  370.         cm_CCs  : NewGame(FALSE, TRUE);
  371.         cm_CPs  : NewGame(TRUE, TRUE);
  372.         cm_PXs  : NewGame(TRUE, FALSE);
  373.         cm_POs  : NewGame(FALSE, FALSE);
  374.         cm_Help : BEGIN
  375.           New(PD, Init(@Self, 'TicHelp'));
  376.           Application^.ExecDialog(PD);
  377.         END;
  378.         ELSE TWindow.DefCommandProc(Msg);
  379.       END;
  380.   END;
  381.  
  382. {--------------------------------------------------}
  383. { TMyApplication's method implementations:         }
  384. {--------------------------------------------------}
  385.   PROCEDURE TMyApplication.InitMainWindow;
  386.   BEGIN MainWindow := New(PTicWindow, Init(Nil, AppName)); END;
  387.  
  388. {--------------------------------------------------}
  389. { Main program:                                    }
  390. {--------------------------------------------------}
  391. VAR MyApp: TMyApplication;
  392. BEGIN
  393.   MyApp.Init(AppName);
  394.   MyApp.Run;
  395.   MyApp.Done;
  396. END.
  397.