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
