rebol [
	Title: "Noughts, Crosses & Boxes"
	File: %noughts-crosses-boxes.r
	Date: 2-Mar-2004
	Version: 1.0.1
	;Needs: [View]
	Author: "Anton Rolls"
	Language: 'English
	Purpose: {A game similar to noughts and crosses.}
	Usage: {}
	ToDo: {
	- bug: check for winner fails for diagonal where middle piece is placed last, eg. circles at 2x1, 4x3, then 3x2
	- make notes accessible via dialog
	- undo (unlimited ?)
	- show all three player pieces and move a marker showing whose turn it is. (Awareness of order)
	- convert to a network game
	- computer players ?
	}
	History: [
		1.0.0 [15-Jul-2003 {First version} "Anton"]
		1.0.1 [2-Mar-2004 {added notes} "Anton"]
	]
	Notes: {
		I love this game!
		It's just a slightly "bigger" version of noughts & crosses, only the play
		area is now a 4x4 grid instead of 3x3, and there is a third player...
		Still the aim is to get only three pieces in a row.

		I first made it on paper, looking for a quick upgrade to noughts & crosses.
		I play by myself quite often, as it can be a great mental challenge.
		Also, convincing my friends of the never-ending mysteries locked inside, and
		to try this strange, "pointless" new game can be ... as hard as the game itself.
		I think the difficulty with it is that is not as simple as noughts and crosses,
		it takes much more concentration to put yourself into the mind of the other
		players, and, at the end, there may be no winner.

		Having three players brings about many new situations compared to your
		traditional one-on-one win-or-lose competitive game, such as chess.
		Chess and many other games are balanced so that, in most cases, one player
		will eventually begin to dominate and win.
		In this game, we see the relationships between the players change as each turn
		is played. After a player has had a turn, the other players often must cooperate
		to prevent that player winning.
		
		"Cooperation." "Trust." "Responsibility." "Betrayal." "Sacrifice." 
		(and sometimes "Ambivalence." :)

		The attitude and political personality of human players will surely affect deeply
		how the game will proceed.
	}
]

data: array [4 4]
current-turn: 'nought

cell-size: 100x100
game-size: cell-size * 4

next-turn: does [indicate-turn current-turn: select [#[none] nought cross box nought] current-turn]

indicate-turn: func [player][
	turn-box/effect: select [
		nought [oval]
		cross  [cross]
		box    [draw [pen black line 2x2 17x2 17x17 2x17 2x2]]
	] player
	show turn-box
]

gen-draw-blk: has [code ibox origin][
	ibox: cell-size * 0.8 ; inner box
	clear draw-blk
	repeat y length? data [
		repeat x length? data/:y [
			origin: (as-pair x y) - 1x1 * cell-size/x + (cell-size * 0.1) - 2x2
			if code: compose/deep select [
				nought [circle (origin + (ibox / 2)) (ibox/x / 2)]
				;cross  [line (origin) (origin + ibox) line (origin + (ibox * 1x0)) (origin + (ibox * 0x1))]
				cross  [line (ibox * 1x0 / 4 + origin) (ibox * 2x1 / 4 + origin) (ibox * 3x0 / 4 + origin)
					(ibox * 4x1 / 4 + origin) (ibox * 3x2 / 4 + origin) (ibox * 4x3 / 4 + origin)
					(ibox * 3x4 / 4 + origin) (ibox * 2x3 / 4 + origin) (ibox * 1x4 / 4 + origin)
					(ibox * 0x3 / 4 + origin) (ibox * 1x2 / 4 + origin) (ibox * 0x1 / 4 + origin)
					(ibox * 1x0 / 4 + origin)
				]
				box    [line (origin) (origin + (ibox * 1x0)) (origin + ibox) (origin + (ibox * 0x1)) (origin)]
			] data/:y/:x [insert draw-blk code]
		]
	]
]

rotate-right: func [p][as-pair (0 - p/y) p/x]
rotate-left: func [p][as-pair p/y (0 - p/x)]

show-winner: func [winner /local pos dir cen x y p1 p2 rad][
	;?? winner
	pos: winner/3 - 1x1
	dir: winner/4 ; direction
	;cen: (pos + dir - 1x1) * 100 + (cell-size / 2) ; centre

	rad: cell-size * 0.1

	p1: pos * cell-size + (cell-size / 2) - 2x2
	p2: 2 * dir + pos * cell-size + (cell-size / 2) - 2x2

	append draw-blk compose [
		;line (p1) (p2)
		fill-pen red
		polygon ((rotate-right dir) * rad + p1) ((negate dir) * rad + p1) ((rotate-left dir) * rad + p1)
			((rotate-left dir) * rad + p2) (dir * rad + p2) ((rotate-right dir) * rad + p2)
	]
	
	show game-box
]

check-winner: func [x y /local piece c d xdirs ydirs reset][
	; look for three the same in a row, horizontally, vertically and diagonally
	xdir: either x < 3 [1][-1]
	ydir: either y < 3 [1][-1]

	piece: data/:y/:x
	;?? piece

	reset: does [
		c: 0 ; number of piece found
		dx: x
		dy: y
	]

	; check horizontal
	reset
	loop 3 [if piece = data/:y/:dx [c: c + 1] dx: dx + xdir]
	if c = 3 [return reduce [piece 'vertical (as-pair x y) (as-pair xdir 0)]]

	; check vertical
	reset
	loop 3 [if piece = data/:dy/:x [c: c + 1] dy: dy + ydir]
	if c = 3 [return reduce [piece 'vertical (as-pair x y) (as-pair 0 ydir)]]

	; check diagonal
	reset
	loop 3 [
		if piece = data/:dy/:dx [c: c + 1]
		dx: dx + xdir
		dy: dy + ydir
	]
	if c = 3 [return reduce [piece 'diagonal (as-pair x y) (as-pair xdir ydir)]]

	; check horizontal reverse
	if any [x = 2 x = 3][ ; if not on edge, horizontally
		reset
		dx: x + xdir
		loop 3 [if piece = data/:y/:dx [c: c + 1] dx: dx - xdir]
		if c = 3 [return reduce [piece 'horizontal (as-pair x + xdir y) (-1x1 * as-pair xdir 0)]]
	]

	; check vertical reverse
	if any [y = 2 y = 3][ ; if not on edge, vertically
		reset
		dy: y + ydir
		loop 3 [if piece = data/:dy/:x [c: c + 1] dy: dy - ydir]
		if c = 3 [
			;print 'vertical-reverse
			return reduce [piece 'vertical (as-pair x y + ydir) (1x-1 * as-pair 0 ydir)]
		]
	]
	
	; check diagonal reverse
	if all [find [2 3] x find [2 3] y][ ; not on edge, horizontally or vertically
		reset
		dx: x + xdir
		dy: y + ydir
		loop 3 [
			if piece = data/:dy/:dx [c: c + 1]
			dx: dx - xdir
			dy: dy - ydir
		]
		if c = 3 [
			;print 'diagonal-reverse
			return reduce [piece 'diagonal (as-pair x + xdir y + ydir) (negate as-pair xdir ydir)]
		]
	]

	false ; winner not found
]

new-game: does [data: array [4 4] current-turn: 'nought]

view/new center-face layout [
	across
	button "New game" [new-game refresh] label "player's turn:" turn-box: box 20x20 return
	game-box: box game-size edge [size: 2x2] effect [grid 100x100 98x98 1x1 draw []] feel [
		engage: func [face action event /local x y][
			if action = 'down [
				position: event/offset / 100 + 1x1
				x: position/x
				y: position/y
				if none? data/:y/:x [
					poke data/:y x current-turn
					gen-draw-blk
					show game-box
					if winner: check-winner x y [show-winner winner]
					next-turn
				]
			]
		]
	]
	do [draw-blk: select game-box/effect 'draw]
]

;data/2/2: 'cross

do refresh: does [
	indicate-turn current-turn
	gen-draw-blk
	show game-box
]

wait none