It is not perfect, but it's free. If it's too big, let me know and I have a have the size - same functionality version.

code:

---

; Naughts and Crosses
; by cj   Version 2.0 
; for my lovely Megan

cls break on

; Random seed for RND based on seconds of current time
; This is used instead of SRND as SRND does not accept a variable input
; and so the numbers that come from RND are the same sequence each time
$seed=val(substr("@time",7,2)) $seed=$seed+1 ; $seed is current seconds +1 incase of 00
do $=rnd(1) $seed=$seed-1 until $seed=0 ; count through $seed iterations so that RND is 
								; essentially random, but actually unknown
; Dimension arrays
dim $on[10]  ; The grid database stores what is where on the grid
dim $xc[10]  dim $yc[10]  ; co-ordinates database for the 0s and Xs on screen
dim $check[10] ; Engine combinations array
dim $score[4] ; scores table

; Starting scores for human, CPU and draw
$score[1]=0  $score[2]=0  $score[3]=0

; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Setup various variables - you can play with these!
$diff="easy"    ; starting difficulty level "hard" or "easy"
$hard=10        ; How much more than CPU score player must be before $diff is set to hard
$easy=10        ; How much less than CPU score for easy...
;$debug="0"      ; display variable processing 0=none, 1=some(faster), 2=all(more detailed)
;$demo="Y"       ; Demo mode.  Press CNTRL+BREAK to exit "Y" or "N"
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

; Game vars
dim $msg1 dim $msg2 dim $status
dim $turn dim $who dim $now dim $pattern
dim $s dim $p dim $p1 dim $p2 dim $p3

; Co-ordinates of grid square centers
; Row      Column
$xc[1]=15 $yc[1]=5
$xc[2]=15 $yc[2]=18
$xc[3]=15 $yc[3]=31
$xc[4]=9  $yc[4]=5
$xc[5]=9  $yc[5]=18
$xc[6]=9  $yc[6]=31
$xc[7]=3  $yc[7]=5
$xc[8]=3  $yc[8]=18
$xc[9]=3  $yc[9]=31

; Engine checks these combinations
$check[1]="123" $check[2]="456"
$check[3]="789" $check[4]="147"
$check[5]="258" $check[6]="369"
$check[7]="159" $check[8]="357"

color w/n
$=setascii(on)

;Start program
goto main

:title ; ------------------------------------------------------------------------------ title screen
" " big color g+/n "noughts" ? color w+/n "     &" ? color b+/n "   crosses" small color w+/n
at(8,0) " Version 2.0" ? " cj 05/06/00" ? ? ? " P - Play the game"
? " D - Demo mode" ? " 0..2 - set Debug level" ? ? "Your choice: "
:menu
get $a
select
	case ucase($a)="P" $demo="N" goto game
	case ucase($a)="D" $demo="Y" goto game 
	case ucase($a)="Q" at(23,0) color w+/n "Bye!" ? quit
	case $a="0" $debug="0"
	case $a="1" $debug="1"
	case $a="2" $debug="2"
	case 1 goto menu
endselect
at(17,0) "Debug level $debug"
goto menu
:game
cls color w/n
return

:drawdebug  ; -------------------------------------------------------------------------- debug
; Draw debug area if required
$dx=3  $dy=58		; screen co-ordinates of debug window
at($dx,$dy+1) "Debug mode $debug"
box($dx+1,$dy,$dx+9,$dy+19,single)
box($dx+6,$dy,$dx+9,$dy+19,single)
box($dx+1,$dy,$dx+5,$dy+4,single)
at($dx+1,$dy+4) chr(194) at($dx+5,$dy) chr(195)
at($dx+6,$dy) chr(195) at($dx+6,$dy+19) chr(180)
at($dx+2,$dy+5) "$on" 
at($dx+2,$dy+10) "turn=" 
at($dx+3,$dy+5) "$$p=" at($dx+3,$dy+12) "$$me="
at($dx+4,$dy+5) "$$s="
at($dx+5,$dy+5) "$$pattern=" 
return

:drawgrid  ; -------------------------------------------------------------------------- draw grid
; Draw Vertical Bars
box(1,11,17,12,full)
box(1,24,17,25,full)

; Draw Horizontal Bars
at(6,1)  "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"
at(12,1) "ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ"

; If you can't use the bars above, use the following code:
;$i=1
;do
;	at(6,$i)  chr(219)
;	at(12,$i) chr(219)
;	$i=$i+1
;until $i=37

; Draw score board
color w/n
at(3,40) "Scores:"
box(4,39,8,54,single) at(5,40) 
if $demo="Y" 
	color g+/n " 0's"
	color b+/n "  X's"
	color r+/n " Draw" 
else 
	color g+/n "You "
	color b+/n " CPU "
	color r+/n " Draw" 
endif  color w/n
$bar=chr(196)+chr(196)+chr(196)+chr(196)
at(6,39) chr(195)"$bar"chr(194)"$bar"chr(194)"$bar"chr(180)
at(7,44) chr(179) at(7,49) chr(179)
at(8,44) chr(193) at(8,49) chr(193)

; Write cj...
at(12,40) color r+/n "tic " color g+/n "tac " color b+/n "toe"
at(13,40) color w/n "Version 2.0"
at(14,40) "cj 05/06/00"
if $demo="Y" color w+/n at(15,40) "Demo Mode" endif
return

:resetvars  ; -------------------------------------------------------------------------- reset vars
; Reset some vars
$turn=0 $pattern=0 $s=" "
$p=" " $p1=" " $p2=" " $p3=" "
$msg1=" " $msg2=" " $status="continue"
return

:resetgrid  ; -------------------------------------------------------------------------- reset grid
; Reset grid database and draw numbers
$i=1
color w+/n
do
	$on[$i]="."	; "." means empty square
	at($xc[$i]-1,$yc[$i]-1) "   "
	at($xc[$i],$yc[$i]-1) " $i "
	at($xc[$i]+1,$yc[$i]-1) "   "
	$i=$i+1
until $i=10
return

:updatescreen ; ---------------------------------------------------------------------- update screen
; Update score board
color w+/n
at(7,41) "   " at(7,41) $score[1]
at(7,46) "   " at(7,46) $score[2]
at(7,51) "   " at(7,51) $score[3]

; Change difficulty level if required
if ($score[1]-$hard)>$score[2] $diff="hard" endif
if ($score[2]-$easy)>$score[1] $diff="easy" endif
at(9,40) "Level = $diff"
return

:Xor0  ; ------------------------------------------------------------------------------ X or 0 ?
; Input:  $demo
color w+/n
at(21,0) "                                                          "
if $demo="Y"
	$player="0"
else
	at(21,0) "Do you want to be X or 0? (0 starts) :"
	:wrong
	get $a
	if ucase($a)="Q" ? ? color w+/n "Bye!" ? quit endif
	if ucase($a)="X" $player="X" goto ok endif
	if        $a="0" $player="0" goto ok endif
	beep goto wrong
endif
 :ok
$me="0" $you="X"  ; 0 starts
; Output:  $me, $you, $player
return

:choose	; ----------------------------------------------------------------------------- choose
; Input:  $demo
if $demo="Y"
	gosub checkgrid
	at(21,0) "                                                          "
	at(21,0) "$you's thinking..."
else
	if $player=$me
		; Get user input 
		color w+/n
		at(21,0) "                                                          "
		at(21,0) "(1-9) or (Q)uit :"
		get $put
		if ucase($put)="Q" ? ? color w+/n "Bye!" ? quit endif
		if $put<1 or $put>9 beep goto choose endif
		if $on[$put]<>"." beep goto choose else "$put" endif
		$msg1="Player chose $put" $msg2=" " gosub debuginfo
	else
		at(21,0) "                                                          "
		at(21,0) "CPU thinking..."
		gosub checkgrid
	endif
endif
; Output:  $put
return

:draw0  ; -------------------------------------------------------------------------- draw 0
; Input:  $put
; Draws a big O at $put
at($xc[$put]-1,$yc[$put]-1) chr(219)chr(219)chr(219)
at($xc[$put],$yc[$put]-1) chr(219)" "chr(219)
at($xc[$put]+1,$yc[$put]-1) chr(219)chr(219)chr(219)
return

:drawX  ; -------------------------------------------------------------------------- draw X
; Input:  $put
; Draws a big X at $put
at($xc[$put],$yc[$put]) chr(219)
at($xc[$put]-1,$yc[$put]-1) chr(219)" "chr(219)
at($xc[$put]+1,$yc[$put]-1) chr(219)" "chr(219)
return

 :place  ; -------------------------------------------------------------------------- place
; Input:  $put, $me
$on[$put]=$me
if $player=$me color g+/n else color b+/n endif ; green for human
if $me="X" gosub drawX else gosub draw0 endif ; draw 0 or X
color w+/n
return

:getpattern  ; ---------------------------------------------------------------------- get pattern
; Input:  $pattern
; Get grid pattern info
$p=$check[$pattern]
$p1=substr("$p",1,1)
$p2=substr("$p",2,1)
$p3=substr("$p",3,1)
$s=$on[$p1]+$on[$p2]+$on[$p3]
; Output:  $p, $p1, $p2, $p3, $s
return

:checkgrid  ; ----------------------------------------------------------------------- check grid
; Input:  $me, $you, $turn
; The main engine
; Here we check all possible combinations
; They are checked in this order:
; Player wins(playerwin), CPU is about to win(cpuwin), Player is about to win(block), then (random).

; Check for $you won
:win1  ; ---------------------------------------------------------------- 3 in a row
if $turn>4
	$pattern=1
	do
		gosub getpattern
		$msg1="Checking $pattern for" $msg2="'$you' win" gosub debuginfo
		if $s=$you+$you+$you goto win2 endif
		$pattern=$pattern+1
	until $pattern=9
endif
goto mewin1

:win2
$msg1="$you win at $put" $msg2="on pattern $pattern"
gosub debuginfo
$status="win"
$me=$you	; $you won and Place uses $me
$msg="$you has won!"
goto ok2

:mewin1  ; ------------------------------------------------------------- I win
; Check for $me about to win 
if $turn>3
	$pattern=1
	do
		gosub getpattern
		$msg1="Trying pattern $pattern" $msg2="for '$me' win" gosub debuginfo
		if $s="."+$me+$me $put=$p1 goto mewin2 endif
		if $s=$me+"."+$me $put=$p2 goto mewin2 endif
		if $s=$me+$me+"." $put=$p3 goto mewin2 endif
		$pattern=$pattern+1
	until $pattern=9
endif
goto block1

:mewin2
$msg1="$me win at $put on" $msg2="pattern $pattern"
gosub debuginfo 
$status="win"
$msg="$me has won!"
goto ok2 

:block1  ; -------------------------------------------------------------- block 
; stop $you from winning
if $turn>2
	$pattern=1
	do
		gosub getpattern
		$msg1="Trying pattern $pattern" $msg2="to block '$you'" gosub debuginfo
		if $s="."+$you+$you $put=$p1 goto block2 endif
		if $s=$you+"."+$you $put=$p2 goto block2 endif
		if $s=$you+$you+"." $put=$p3 goto block2 endif
		$pattern=$pattern+1
	until $pattern=9
endif
goto random1

:block2
$msg1="Block at $put on" $msg2="pattern $pattern"
gosub debuginfo 
goto ok2 

:random1  ; -------------------------------------------------------------- random/HARD
; All smart combinations tried - now just go random
; Pick a place for the computer based on difficulty level
if ($diff="hard") and ($turn>1)
	$pattern=1  $put=0
	do
		gosub getpattern
		$msg1="Hard $put for '$me'" $msg2=" " gosub debuginfo
		if ($s=$you+"..") or ($s=".."+$you) $put=$p2 endif
		if $s="."+$you+"." $put=$p3 endif
		$pattern=$pattern+1
	until $pattern=9
	if $put=0 gosub random2 endif  ; If HARD won't work, use random
else ;"easy" - random choice of remaining places
	gosub random2
endif

 :ok2
; Output:  $put, $status, $msg
return

:random2  ; -------------------------------------------------------------- RANDOM/hard
 :pickagain
$put=rnd(8)+1
$msg1="Random $put for '$me'" $msg2=" " gosub debuginfo
if $on[$put]<>"." goto pickagain endif
return

:debuginfo  ; ----------------------------------------------------------------------- debug info
; Update Debug info area
if $debug="2"
	$Dpattern=1
	do
		$Dp=$check[$Dpattern] $Dp1=substr("$Dp",1,1) $Dp2=substr("$Dp",2,1) $Dp3=substr("$Dp",3,1) 
		at($dx+5-$Dpattern,$dy+1) 
		if ($pattern=$Dpattern) and (($p<>" ") or ($turn>1)) color r+/n else color w+/n endif
		if ($pattern=4) or (($pattern=7) and ($Dpattern=1)) or (($pattern=8) and ($Dpattern=3)) color r+/n endif
		$on[$Dp1]
		if ($pattern=4) or (($pattern=7) and ($Dpattern=1)) or (($pattern=8) and ($Dpattern=3)) color w+/n endif
		if ($pattern=5) or (($pattern=7) and ($Dpattern=2)) or (($pattern=8) and ($Dpattern=2)) color r+/n endif
		$on[$Dp2]
		if ($pattern=5) or (($pattern=7) and ($Dpattern=2)) or (($pattern=8) and ($Dpattern=2)) color w+/n endif
		if ($pattern=6) or (($pattern=7) and ($Dpattern=3)) or (($pattern=8) and ($Dpattern=1)) color r+/n endif
		$on[$Dp3]
		if ($pattern=6) or (($pattern=7) and ($Dpattern=3)) or (($pattern=8) and ($Dpattern=1)) color w+/n endif
		if $pattern=$Dpattern color w+/n endif
		$Dpattern=$Dpattern+1
	until $Dpattern=4
	at($dx+3,$dy+8) "   " at($dx+3,$dy+8) "$p"
	at($dx+4,$dy+8) "         " at($dx+4,$dy+8) "$s"
	at($dx+5,$dy+14) " " at($dx+5,$dy+14) "$pattern"
endif
if $debug<>"0"
	at($dx+7,$dy+1) "                  " at($dx+7,$dy+1) "$msg1"
	at($dx+8,$dy+1) "                  " at($dx+8,$dy+1) "$msg2"
	at($dx+2,$dy+15) "$turn"            at($dx+3,$dy+16) "$me"
endif
return

:again  ; ---------------------------------------------------------------------------- winner/draw
; Highlight winning sequence
if $status="draw" goto draw endif
color r+/n
$i=1
do
	$put=substr("$p",$i,1)
	if $on[$put]="0" gosub draw0 else gosub drawX endif
	$i=$i+1
until $i=4

:draw
color y+/n
at(21,20) "$msg               "
color w+/n
if $demo="Y"
	at(21,40) "Demo restarting...               "
	sleep 2
	$status="continue" 
	goto start
else
	at(21,40) "Play again?        "
	get $a
	at(21,40) "           "
	if ucase($a)="Y" $status="continue" goto start endif
	gosub updatescreen at(22,0) color w+/n ? "Bye!" ? quit
endif

:MAIN  ; ================================================================================  Main

gosub title		; title screen
if $debug<>"0" gosub drawdebug endif	; draw debug window
gosub drawgrid		; draw grid and score board

:start
gosub resetvars	; reset variables
gosub resetgrid	; reset the grid
gosub updatescreen	; update screen info like scores
gosub Xor0		; ask user for X or 0

:turn
gosub choose		; Get user or computer choice
gosub place		; Place choice on grid
gosub debuginfo	; update debug info

if $status="win"  ; a winner!
	if $player=$me
		$score[1]=$score[1]+1
	else
		$score[2]=$score[2]+1
	endif
	goto again 
endif

$turn=$turn+1  ; another turn has passed
if $turn=9 ; 9 turns without a winner is a draw
	$status="draw" 
	$msg="Draw!" 
	$score[3]=$score[3]+1
	goto again 
endif 

if $me="0" $me="X" $you="0" else $me="0" $you="X" endif ; swap active player

goto turn

;END

---

enjoy,
cj

[This message has been edited by cj (edited 07 June 2000).]

You just have too much free time on your hands.

But it's a class act piece of work. Well done.

------------------
BoxKite
FACTA NON VERBA

Very very cool. and I agree with BoxKite: cj has too much sparetime.....

But this is the way to go with KiXtart, let everyone see what is Possible with this Scripting Language.

------------------
Lon Geefshuysen (one of the Moderators)
Microsoft Certified Systems Engineer

Senior Engineer ICT
kixtart.to/lon
lon@kixtart.to

Extremely well done !

But when it comes down to sparetime and loved ones - one can't have TOO MUCH of that - eh ?

I assume you wrote this for someone very special - your daughter Megan ?

Shawn.

------------------
Gus Dalinis
Systems Analyst

Megan is my girlfriend. I do have too much spare time

There are some limits. I tried to write a pacman game and it is quite good, but not good enough. Once there is a timed keyboard input routine I will have another look at it.

However, I do have some more spare time... any requests?

cj

just finished playing some rounds ......
well written 13kb of KIX Code

[scores: me=3(0);CPU=0(X);draws=2]hmmmmm
the debug level is quite cool

Here' snow my request:

i am right now thinking 'bout writing some
'Schiffe Versenken' [German] in a kind of Network-Game way ....

Translation: -> i don't know the right name for it but can imagine that this simple game
[played it as baby] is well known in da hole world...

problem will be the network connectivity [i think]

It have to be written entirely in KIX ... [Harrrrr!]

ANY Suggestions????????

Congratulations ,
Jochen

_________________________

I found it very easy to test as I know how to win every time. I had the choice of making it impossible to win, but instead chose random. I have learned a few moves that if I was to play against someone else, I would always win, no matter what they tried... It is not a good game really...

Megan has requested connect 4 and I am thinking about it. You could also very easily make the above game two players too.

Bitte ich mehr über 'Schiffe Versenken' erklären Sie

cj

CONNECT4 - YEAH YEAH YEAH YEAH YEAH !!!

I LOVE CONNECT4 !

I have this little electronic pocket version that beeps and pocks and keeps me amused on the commuter train and during those long stretches while I'm waiting for Jochen to finish that date minus 14 days script

Shawn.

p.s.

I really hope Jochen has a sense of humor !

Shawn..

[This message has been edited by Shawn (edited 16 June 2000).]

ok ehhhhrrr, 'Schiffe versenken' is roughly translated ..... 'sink ships' ... there are 2 players generally and they have each one
sheet with a table drawn on it ... You have to draw 'battleships'[4 cells],'cruiser'[xx cells],'submarines'[1 cell]....
it looks like this:

code:

---

  A B C D E F G H I J K L M N O P Q R S T
1
2                         X X X X X
3   X X X X
4
5
6                         X
7
8
9                 X
10                X
11     X          X
12     X
13     X            X X X X X
14
15
16
17
18
19
20         X X X X

---

not nice but rare!!!

You must KNOW IT [think it was invented back in 1914 [WW1] as the German fleet was high and mighty]
the player 'shoot' 3 grenades against the enemy fleet each round ... [e.g.:a10,h15,c3]
so we have wargames [*shame*]....

Shawn, did You yet found out my birthday ???
see handledatetopix*

cj, yep TicTacToe would be a nice Network-game too, at least a 2-player_1-Computer- Mode would be nice

Greetings

[This message has been edited by jpols (edited 16 June 2000).]

_________________________

How do you pronounce your name anyway ?

Is it Josh-en or Jock-en or Joe-Shen or Joe-Chen ???

Over here in North America, gamemaker Milton Bradley (tm) calls it "BattleShip" - it kinda goes like this:

"B4 - C3 - D1"
"You sunk my Battleship !"
"You bastard !"

Ok - I just threw in that last part !

Yeah - Battleship would be real cool !

Shawn.

p.s. I do not represent or endorse Milton Bradley games, blah blah blah...

p.p.s

What's that you said about your birthday and dates ? - Think I missed something there!

[This message has been edited by Shawn (edited 16 June 2000).]

Yeah! Go cj!!

------------------
K Torkelson
Sys Admin Analyst
ktorkelson@providentfunding.com

Any Diablo Warriors, Mages or Monks out there ?

Can't wait for Diablo II. It's due out any day (or so we've been saying for the last two years).

Shawn.

ah yep i knew MB ... [same name here in Germany] but 'battleship' was new for me.

Ok lets see ... no Joch would be to short [Josh rather than Joe]...ehhh the roots of this name are coming from 'Johannes'.
i think the anglo-american countries call him just John (Yes,the one with the River and the religious people he is holding under water)....
hmmm, the 'ch' is pronounced like ..*icantthinkaboutanywordinenglishpronouncedthesameway* ...[
it is really no'k'... try to build the sound deep in throat (sounds a bit like a scratching LP or the spanish name José )

I must leave You now as the F1-Race in Montreal is about to start....

Cheers,
Bilbo Baggins

p.s: i am a passioned and certified 'Halflife-Killer'...

p.p.s.: birthday and dates .... James got already a wrong guess ... SEE: HANDLING DATES - TOPIC by LD

[This message has been edited by jpols (edited 18 June 2000).]

[This message has been edited by jpols (edited 19 June 2000).]

[This message has been edited by jpols (edited 19 June 2000).]

[This message has been edited by jpols (edited 19 June 2000).]

_________________________