HTBasic Help
×
Menu
Index

Example: Tic-Tac-Toe

 
10     ! *********************************************************************
20     ! Example: Tic-Tac-Toe
30     !
40     ! This example program plays tic-tac-toe.
50     ! It illustrates the use of STRING widgets with different fonts, and
60     ! shows how attribute arrays can be used. The PUSHBUTTON object
70     ! is used to initiate an action. Each of the squares is a pushbutton.
80     ! When a button is clicked it is given to a player and deactivated.
90     !
100   ! The arrays Attr_n$ and Attr are used to program six numeric attributes
110   ! at once. The arrays Attr_s$ and Attr_sv$ are used to program three
120   ! string attributes.
130   !
140   ! ************************************************************
150   !
160   DIM Attr_n$(5)[11],Attr_s$(2)[10],Attr(5),Attr_sv$(2)[10],Xo$(1)[1]
170   DIM Sel$(4)[1],Grid$(1)[10],Buttons$(2)[5]
180   DIM Xo(3,3)
190   Dims=4
200   Attr_n$(0)="X"
210   Attr_n$(1)="Y"
220   Attr_n$(2)="WIDTH"
230   Attr_n$(3)="HEIGHT"
240   Attr_n$(4)="RESIZABLE"
250   Attr_n$(5)="MAXIMIZABLE"
260   Attr(0)=100                                                ! x position
270   Attr(1)=20                                                                ! y position
280   Attr(2)=50                                                                ! width
290   Attr(3)=50                                                                ! height
300   Attr(4)=0                                                                ! not resizable
310   Attr(5)=0                                                                ! not maximizable
320   Attr_s$(0)="FONT"
330   Attr_s$(1)="TITLE"
340   Attr_s$(2)="LABEL"
350   Attr_sv$(0)="20 BY 30"                                ! A large font
360   Attr_sv$(1)=""                                                ! Makes the title area disappear
370   Attr_sv$(2)=""                                                ! Use a blank label to start
380   Sel$(0)="0"
390   Sel$(1)="1"
400   Sel$(2)="2"
410   Sel$(3)="3"
420   Sel$(4)="4"
430   Grid$(0)="3 BY 3"
440   Grid$(1)="4 BY 4"
450   Buttons$(0)="1"
460   Buttons$(1)="2"
470   Buttons$(2)="Quit"
480   DIALOG "QUESTION","How many players?",Button;SET ("DIALOG BUTTONS":Buttons$(*))
490   IF Button=2 THEN STOP
500   Players=Button+1
510   DIALOG "LIST","Select Playing Grid",Button;SET ("ITEMS":Grid$(*),"SELECTED ITEM":0),RETURN ("SELECTED ITEM":Grid)
520   Dims=3
530   IF Grid=1 THEN Dims=4
540   IF Button=1 THEN STOP
550   DIALOG "LIST","Select Level of Difficulty",Button;SET ("ITEMS":Sel$(*),"SELECTED ITEM":1),RETURN ("SELECTED ITEM":Level)
560   IF Button=1 THEN STOP
570   !
580   ! Nine pushbutton widgets are created in three rows and three columns.
590   ! The use of the attribute arrays allows all the widgets to be changed
600   ! easily and yet have them still be aligned.
610   !
620   ASSIGN @Box11 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
630   Attr(0)=Attr(0)+Attr(2)                                ! x position moved one button width right
640   !
650   ASSIGN @Box12 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
660   Attr(0)=Attr(0)+Attr(2)                                ! x position moved one button width right
670   !
680   ASSIGN @Box13 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
690   Attr(0)=Attr(0)+Attr(2)
700   !
710   ASSIGN @Box14 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
720   Attr(0)=Attr(0)-3*Attr(2)                                ! x position moved two button widths left
730   Attr(1)=Attr(1)+Attr(3)                                ! y position moved one button height down
740   !
750   ASSIGN @Box21 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
760   Attr(0)=Attr(0)+Attr(2)
770   !
780   ASSIGN @Box22 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
790   Attr(0)=Attr(0)+Attr(2)
800   !
810   ASSIGN @Box23 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
820   Attr(0)=Attr(0)+Attr(2)
830   !
840   ASSIGN @Box24 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
850   Attr(0)=Attr(0)-3*Attr(2)
860   Attr(1)=Attr(1)+Attr(3)
870   !
880   ASSIGN @Box31 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
890   Attr(0)=Attr(0)+Attr(2)
900   !
910   ASSIGN @Box32 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
920   Attr(0)=Attr(0)+Attr(2)
930   !
940   ASSIGN @Box33 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*))
950   Attr(0)=Attr(0)+Attr(2)
960   !
970   ASSIGN @Box34 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
980   Attr(0)=Attr(0)-3*Attr(2)
990   Attr(1)=Attr(1)+Attr(3)
1000  !
1010  ASSIGN @Box41 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
1020  Attr(0)=Attr(0)+Attr(2)
1030  !
1040  ASSIGN @Box42 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
1050  Attr(0)=Attr(0)+Attr(2)
1060  !
1070  ASSIGN @Box43 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
1080  Attr(0)=Attr(0)+Attr(2)
1090  !
1100  ASSIGN @Box44 TO WIDGET "PUSHBUTTON";SET (Attr_n$(*):Attr(*),Attr_s$(*):Attr_sv$(*),"VISIBLE":0)
1110  IF Dims=4 THEN
1120    CONTROL @Box44;SET ("VISIBLE":1)
1130    CONTROL @Box43;SET ("VISIBLE":1)
1140    CONTROL @Box42;SET ("VISIBLE":1)
1150    CONTROL @Box41;SET ("VISIBLE":1)
1160    CONTROL @Box34;SET ("VISIBLE":1)
1170    CONTROL @Box24;SET ("VISIBLE":1)
1180    CONTROL @Box14;SET ("VISIBLE":1)
1190  END IF
1200  ASSIGN @Quit TO WIDGET "PUSHBUTTON"
1210  CONTROL @Quit;SET ("TITLE":"","LABEL":"Quit","X":10,"Y":22)
1220  CONTROL @Quit;SET ("HEIGHT":40,"WIDTH":60)
1230  ON EVENT @Quit,"ACTIVATED" GOTO Finis
1240  !
1250  ! The Turn variable keeps track of whose
1260  ! turn it is. Zero means X, one means O.
1270  !
1280  Turn=0
1290  Xo$(0)="X"
1300  Xo$(1)="O"
1310  !
1320  ! A STRING widget to remind the players whose turn it is
1330  !
1340  Attr(0)=Attr(0)-3*Attr(2)                                                                ! Move x position back to left edge
1350  IF Dims=4 THEN Attr(1)=Attr(1)+Attr(3)                                ! Move y position to bottom
1360  Attr(2)=Dims*Attr(2)                                                                ! Set width to three buttons wide
1370  !
1380  ASSIGN @Who TO WIDGET "STRING";SET (Attr_n$(*):Attr(*),"TITLE":"","VALUE":"It is "&Xo$(Turn)&"'s turn")
1390  !
1400  ! This array records who has which square. It is initialized to values
1410  ! which are unequal and do not correspond to either an X or an O.
1420  !
1430 Start: !
1440  FOR I=0 TO Dims-1
1450    FOR J=0 TO Dims-1
1460      Xo(I,J)=-1-I-2*J
1470    NEXT J
1480  NEXT I
1490  !
1500  ! Each pushbotton calls its own subroutine.
1510  !
1520  ON EVENT @Box11,"ACTIVATED" GOSUB Hit_box11
1530  ON EVENT @Box12,"ACTIVATED" GOSUB Hit_box12
1540  ON EVENT @Box13,"ACTIVATED" GOSUB Hit_box13
1550  ON EVENT @Box14,"ACTIVATED" GOSUB Hit_box14
1560  ON EVENT @Box21,"ACTIVATED" GOSUB Hit_box21
1570  ON EVENT @Box22,"ACTIVATED" GOSUB Hit_box22
1580  ON EVENT @Box23,"ACTIVATED" GOSUB Hit_box23
1590  ON EVENT @Box24,"ACTIVATED" GOSUB Hit_box24
1600  ON EVENT @Box31,"ACTIVATED" GOSUB Hit_box31
1610  ON EVENT @Box32,"ACTIVATED" GOSUB Hit_box32
1620  ON EVENT @Box33,"ACTIVATED" GOSUB Hit_box33
1630  ON EVENT @Box34,"ACTIVATED" GOSUB Hit_box34
1640  ON EVENT @Box41,"ACTIVATED" GOSUB Hit_box41
1650  ON EVENT @Box42,"ACTIVATED" GOSUB Hit_box42
1660  ON EVENT @Box43,"ACTIVATED" GOSUB Hit_box43
1670  ON EVENT @Box44,"ACTIVATED" GOSUB Hit_box44
1680  LOOP
1690    CONTROL @Who;SET ("VALUE":"It is "&Xo$(Turn)&"'s turn")
1700    IF Turn=0 OR Players=2 THEN
1710      WAIT FOR EVENT
1720    ELSE
1730      Computer_play(Xo(*),Turn,Level,Row,Col,Dims)
1740      Set_box(Xo$(Turn),Row,Col,@Box11,@Box12,@Box13,@Box14,@Box21,@Box22,@Box23,@Box24,@Box31,@Box32,@Box33,@Box34,@Box41,@Box42,@Box43,@Box44)
1750      Xo(Row,Col)=Turn
1760      Turn=(Turn=0)
1770    END IF
1780  !
1790  ! These IF statements check if anyone has three in a row
1800  !
1810    Winner=-1
1820    Winner=FNCheck_winner(Xo(*),Dims)
1830    IF Winner>=0 THEN GOTO Win
1840  !
1850  ! Check to see if all the squares have been taken
1860  !
1870    Tie=FNCheck_tie(Xo(*),Dims)
1880    IF Tie THEN GOTO Tie
1890  END LOOP
1900  !
1910  ! Each square has its own subroutine. They are nearly identical.
1920  ! The appropriate square is given to the player whose turn it is.
1930  ! An X or O is in placed in the square. The pushbutton for that
1940  ! square is deactivated. The turn indicator is flipped.
1950  !
1960 Hit_box11: !
1970  Xo(0,0)=Turn
1980  CONTROL @Box11;SET ("LABEL":Xo$(Turn))
1990  Turn=(Turn=0)
2000  OFF EVENT @Box11,"ACTIVATED"
2010  RETURN
2020  !
2030 Hit_box12: !
2040  Xo(0,1)=Turn
2050  CONTROL @Box12;SET ("LABEL":Xo$(Turn))
2060  Turn=(Turn=0)
2070  OFF EVENT @Box12,"ACTIVATED"
2080  RETURN
2090  !
2100 Hit_box13: !
2110  Xo(0,2)=Turn
2120  CONTROL @Box13;SET ("LABEL":Xo$(Turn))
2130  Turn=(Turn=0)
2140  OFF EVENT @Box13,"ACTIVATED"
2150  RETURN
2160  !
2170 Hit_box14: !
2180  Xo(0,3)=Turn
2190  CONTROL @Box14;SET ("LABEL":Xo$(Turn))
2200  Turn=(Turn=0)
2210  OFF EVENT @Box14,"ACTIVATED"
2220  RETURN
2230  !
2240 Hit_box21: !
2250  CONTROL @Box21;SET ("LABEL":Xo$(Turn))
2260  Xo(1,0)=Turn
2270  Turn=(Turn=0)
2280  OFF EVENT @Box21,"ACTIVATED"
2290  RETURN
2300  !
2310 Hit_box22: !
2320  Xo(1,1)=Turn
2330  CONTROL @Box22;SET ("LABEL":Xo$(Turn))
2340  Turn=(Turn=0)
2350  OFF EVENT @Box22,"ACTIVATED"
2360  RETURN
2370  !
2380 Hit_box23: !
2390  Xo(1,2)=Turn
2400  CONTROL @Box23;SET ("LABEL":Xo$(Turn))
2410  Turn=(Turn=0)
2420  OFF EVENT @Box23,"ACTIVATED"
2430  RETURN
2440  !
2450 Hit_box24: !
2460  Xo(1,3)=Turn
2470  CONTROL @Box24;SET ("LABEL":Xo$(Turn))
2480  Turn=(Turn=0)
2490  OFF EVENT @Box24,"ACTIVATED"
2500  RETURN
2510  !
2520 Hit_box31: !
2530  Xo(2,0)=Turn
2540  CONTROL @Box31;SET ("LABEL":Xo$(Turn))
2550  Turn=(Turn=0)
2560  OFF EVENT @Box31,"ACTIVATED"
2570  RETURN
2580  !
2590 Hit_box32: !
2600  Xo(2,1)=Turn
2610  CONTROL @Box32;SET ("LABEL":Xo$(Turn))
2620  Turn=(Turn=0)
2630  OFF EVENT @Box32,"ACTIVATED"
2640  RETURN
2650  !
2660 Hit_box33: !
2670  Xo(2,2)=Turn
2680  CONTROL @Box33;SET ("LABEL":Xo$(Turn))
2690  Turn=(Turn=0)
2700  OFF EVENT @Box33,"ACTIVATED"
2710  RETURN
2720  !
2730 Hit_box34: !
2740  Xo(2,3)=Turn
2750  CONTROL @Box34;SET ("LABEL":Xo$(Turn))
2760  Turn=(Turn=0)
2770  OFF EVENT @Box34,"ACTIVATED"
2780  RETURN
2790  !
2800 Hit_box41: !
2810  Xo(3,0)=Turn
2820  CONTROL @Box41;SET ("LABEL":Xo$(Turn))
2830  Turn=(Turn=0)
2840  OFF EVENT @Box41,"ACTIVATED"
2850  RETURN
2860  !
2870 Hit_box42: !
2880  Xo(3,1)=Turn
2890  CONTROL @Box42;SET ("LABEL":Xo$(Turn))
2900  Turn=(Turn=0)
2910  OFF EVENT @Box42,"ACTIVATED"
2920  RETURN
2930  !
2940 Hit_box43: !
2950  Xo(3,2)=Turn
2960  CONTROL @Box43;SET ("LABEL":Xo$(Turn))
2970  Turn=(Turn=0)
2980  OFF EVENT @Box43,"ACTIVATED"
2990  RETURN
3000  !
3010 Hit_box44: !
3020  Xo(3,3)=Turn
3030  CONTROL @Box44;SET ("LABEL":Xo$(Turn))
3040  Turn=(Turn=0)
3050  OFF EVENT @Box44,"ACTIVATED"
3060  RETURN
3070 Win: !
3080  !
3090  ! Announce the winner
3100  !
3110  DIALOG "INFORMATION",Xo$(Winner)&" wins";SET ("X":50,"Y":0,"WIDTH":300,"HEIGHT":300,"FONT":"20 BY 30")
3120  GOTO Cleanup
3130 Tie:!
3140  !
3150  ! Declare a tie
3160  !
3170  DIALOG "INFORMATION","Tie";SET ("X":50,"Y":0,"WIDTH":300,"HEIGHT":300,"FONT":"20 BY 30")
3180  !
3190  ! Make the labels in all the squares blank
3200  !
3210 Cleanup: !
3220  CONTROL @Box11;SET ("LABEL":"")
3230  CONTROL @Box12;SET ("LABEL":"")
3240  CONTROL @Box13;SET ("LABEL":"")
3250  CONTROL @Box14;SET ("LABEL":"")
3260  CONTROL @Box21;SET ("LABEL":"")
3270  CONTROL @Box22;SET ("LABEL":"")
3280  CONTROL @Box23;SET ("LABEL":"")
3290  CONTROL @Box24;SET ("LABEL":"")
3300  CONTROL @Box31;SET ("LABEL":"")
3310  CONTROL @Box32;SET ("LABEL":"")
3320  CONTROL @Box33;SET ("LABEL":"")
3330  CONTROL @Box34;SET ("LABEL":"")
3340  CONTROL @Box41;SET ("LABEL":"")
3350  CONTROL @Box42;SET ("LABEL":"")
3360  CONTROL @Box43;SET ("LABEL":"")
3370  CONTROL @Box44;SET ("LABEL":"")
3380  !
3390  ! Give the turn indicator to X and start a new game
3400  !
3410  Turn=0
3420  GOTO Start
3430 Finis: END
3440  DEF FNCheck_winner(Xo(*),Dims)
3450    Winner=-1
3460    Fail=0
3470  !
3480  ! Check Rows
3490  !
3500    FOR I=0 TO Dims-1
3510      FOR J=0 TO Dims-2
3520        IF Xo(I,J+1)<>Xo(I,J) THEN
3530          Fail=1
3540          GOTO 3590
3550        END IF
3560        Tmp=Xo(I,J)
3570      NEXT J
3580      IF Fail=0 THEN RETURN Tmp
3590      Fail=0
3600    NEXT I
3610  !
3620  ! Check Columns
3630  !
3640    Fail=0
3650    FOR J=0 TO Dims-1
3660      FOR I=0 TO Dims-2
3670        IF Xo(I+1,J)<>Xo(I,J) THEN
3680          Fail=1
3690          GOTO 3740
3700        END IF
3710        Tmp=Xo(I,J)
3720      NEXT I
3730      IF Fail=0 THEN RETURN Tmp
3740      Fail=0
3750    NEXT J
3760  !
3770  ! Check Diagonals
3780  !
3790    Tmp=Xo(0,0)
3800    Fail=0
3810    FOR J=0 TO Dims-2
3820      IF Xo(J,J)<>Xo(J+1,J+1) THEN
3830        Fail=1
3840        GOTO 3880
3850      END IF
3860    NEXT J
3870    IF Fail=0 THEN RETURN Tmp
3880    Tmp=Xo(Dims-1,0)
3890    Fail=0
3900    FOR J=0 TO Dims-2
3910      IF Xo(Dims-1-J,J)<>Xo(Dims-2-J,J+1) THEN
3920        Fail=1
3930        RETURN -1
3940      END IF
3950    NEXT J
3960    IF Fail=0 THEN RETURN Tmp
3970    RETURN -1
3980  FNEND
3990  DEF FNCheck_tie(Xo(*),Dims)
4000    Tie=1
4010    FOR I=0 TO Dims-1
4020      FOR J=0 TO Dims-1
4030        IF Xo(I,J)<0 THEN Tie=0
4040      NEXT J
4050    NEXT I
4060    RETURN Tie
4070  FNEND
4080  SUB Computer_play(Xo(*),Turn,Level,Row,Col,Dims)
4090 Computer_play: !
4100    DIM Weights(3,3)
4110    REDIM Weights(Dims-1,Dims-1)
4120    Opponent=(Turn+1) MOD 2
4130    MAT Weights=(0)
4140    IF Level>1 THEN ASSIGN @W TO WIDGET "LABEL";SET ("VALUE":"I'm calculating. Please Wait...","COLUMNS":35,"ROWS":2)
4150    Find_weights(Xo(*),Weights(*),Turn,Turn,Level,Dims)
4160    Eval_weights(Xo(*),Weights(*),Row,Col,Dims)
4170    IF Level>1 THEN ASSIGN @W TO *
4180  SUBEND
4190  SUB Find_weights(X(*),Weights(*),Mark,Turn,Level,Dims)
4200 Find_weights: !
4210    DIM X1(3,3)
4220    REDIM X1(Dims-1,Dims-1)
4230    MAT X1=X
4240    REAL Temp
4250    Opponent=(Turn+1) MOD 2
4260    Opp_mark=(Mark+1) MOD 2
4270    FOR I=0 TO Dims-1
4280      FOR J=0 TO Dims-1
4290        IF X1(I,J)<0 THEN
4300          Temp=X1(I,J)
4310          X1(I,J)=Turn
4320          M=FNCheck_winner(X1(*),Dims)
4330          IF M=Mark THEN
4340            Weights(I,J)=Weights(I,J)+1
4350          ELSE
4360            IF M=Opp_mark THEN
4370              Weights(I,J)=Weights(I,J)+1
4380            ELSE
4390              IF Level>0 THEN CALL Find_weights(X1(*),Weights(*),Mark,Opponent,Level-1,Dims)
4400            END IF
4410          END IF
4420          X1(I,J)=Temp
4430        END IF
4440      NEXT J
4450    NEXT I
4460  SUBEND
4470  SUB Eval_weights(X(*),W(*),R,C,Dims)
4480    DIM Opt_rows(16),Opt_cols(16)
4490    Best=MAX(W(*))
4500    Count=0
4510    FOR I=0 TO Dims-1
4520      FOR J=0 TO Dims-1
4530        IF W(I,J)=Best AND X(I,J)<0 THEN
4540          Opt_rows(Count)=I
4550          Opt_cols(Count)=J
4560          Count=Count+1
4570        END IF
4580      NEXT J
4590    NEXT I
4600    Index=MAX(0,PROUND(Count*RND-.5,0))
4610    R=Opt_rows(Index)
4620    C=Opt_cols(Index)
4630  SUBEND
4640  SUB Set_box(X$,Row,Col,@B11,@B12,@B13,@B14,@B21,@B22,@B23,@B24,@B31,@B32,@B33,@B34,@B41,@B42,@B43,@B44)
4650    SELECT 10*Row+Col
4660    CASE 0
4670      CONTROL @B11;SET ("LABEL":X$)
4680    CASE 1
4690      CONTROL @B12;SET ("LABEL":X$)
4700    CASE 2
4710      CONTROL @B13;SET ("LABEL":X$)
4720    CASE 3
4730      CONTROL @B14;SET ("LABEL":X$)
4740    CASE 10
4750      CONTROL @B21;SET ("LABEL":X$)
4760    CASE 11
4770      CONTROL @B22;SET ("LABEL":X$)
4780    CASE 12
4790      CONTROL @B23;SET ("LABEL":X$)
4800    CASE 13
4810      CONTROL @B24;SET ("LABEL":X$)
4820    CASE 20
4830      CONTROL @B31;SET ("LABEL":X$)
4840    CASE 21
4850      CONTROL @B32;SET ("LABEL":X$)
4860    CASE 22
4870      CONTROL @B33;SET ("LABEL":X$)
4880    CASE 23
4890      CONTROL @B34;SET ("LABEL":X$)
4900    CASE 30
4910      CONTROL @B41;SET ("LABEL":X$)
4920    CASE 31
4930      CONTROL @B42;SET ("LABEL":X$)
4940    CASE 32
4950      CONTROL @B43;SET ("LABEL":X$)
4960    CASE 33
4970      CONTROL @B44;SET ("LABEL":X$)
4980    END SELECT
4990  SUBEND