>||MIRANDA 3-Dimensional Noughts-and-Crosses (author: Mike Joy)

This program plays noughts and crosses in 3-dimensions.

> %export oxo

> inputdatum ::= Prompt | Error | NodeNumber num

square weightings for simple algorithm

> crossvals :: [num]
> crossvals = [1,6,36,10000]
> noughtvals :: [num]
> noughtvals = [1,4,16,200]

startboard is the initial position.

> startboard :: [char]
> startboard = rep 64 '.'

rows is a list of 4-tuples representing the possible lines on the board.

> rows :: [[num]]
> rows = [[0,1,2,3], [0,4,8,12], [0,5,10,15], [1,5,9,13], [2,6,10,14], 
>		[3,6,9,12], [3,7,11,15], [4,5,6,7], [8,9,10,11], [12,13,14,15], 
>		[0,16,32,48], [0,17,34,51], [1,17,33,49], [2,18,34,50],
>		[3,18,33,48], [3,19,35,51], [0,20,40,60], [0,21,42,63],
>		[1,21,41,61], [2,22,42,62], [3,22,41,60], [3,23,43,63],
>		[4,20,36,52], [4,21,38,55], [5,21,37,53], [6,22,38,54],
>		[7,22,37,52], [7,23,39,55], [8,24,40,56], [8,25,42,59], 
>		[9,25,41,57], [10,26,42,58], [11,26,41,56], [11,27,43,59],
>		[12,24,36,48], [12,25,38,51], [13,25,37,49], [14,26,38,50],
>		[15,26,37,48], [15,27,39,51], [12,28,44,60], [12,29,46,63],
>		[13,29,45,61], [14,30,46,62], [15,30,45,60], [15,31,47,63],
>		[16,17,18,19], [16,20,24,28], [16,21,26,31], [17,21,25,29], 
>		[18,22,26,30], [19,22,25,28], [19,23,27,31], [20,21,22,23],
>		[24,25,26,27], [28,29,30,31], [32,33,34,35], [32,36,40,44],
>		[32,37,42,47], [33,37,41,45], [34,38,42,46], [35,38,41,44], 
>		[35,39,43,47], [36,37,38,39], [40,41,42,43], [44,45,46,47], 
>		[48,49,50,51], [48,52,56,60], [48,53,58,63], [49,53,57,61], 
>		[50,54,58,62], [51,54,57,60], [51,55,59,63], [52,53,54,55], 
>		[56,57,58,59], [60,61,62,63]]

nodes is an array of indices of rows corresponding to each square

> nodes :: [[num]]
> nodes = [[0,1,2,10,11,16,17], [0,3,12,18], [0,4,13,19], [0,5,6,14,15,20,21],
>		[1,7,22,23], [2,3,7,24], [4,5,7,25], [6,7,26,27], [1,8,28,29],
>		[3,5,8,30], [2,4,8,31], [6,8,32,33], [1,5,9,34,35,40,41],
>		[3,9,36,42], [4,9,37,43], [2,6,9,38,39,44,45], [10,46,47,48],
>		[11,12,46,49], [13,14,46,50], [15,46,51,52], [16,22,47,53],
>		[17,18,23,24,48,49,53],
>		[19,20,25,26,50,51,53], [21,27,52,53], [28,34,47,54],
>		[29,30,35,36,49,51,54], [31,32,37,38,48,50,54], [33,39,52,54],
>		[40,47,51,55], [41,42,49,55], [43,44,50,55], [45,48,52,55],
>		[10,56,57,58], [12,14,56,49], [11,13,56,60], [15,56,61,62],
>		[22,34,57,63], [24,26,36,38,58,59,63], [23,25,35,37,60,61,63],
>		[27,39,62,63], [16,28,57,64], [18,20,30,32,59,61,64],
>		[17,19,29,31,58,60,64], [21,33,62,64], [40,57,61,65],
>		[42,44,59,65], [41,43,60,65], [45,58,62,65],
>		[10,14,34,38,66,67,68], [12,36,66,69], [13,37,66,70],
>		[11,15,35,39,66,71,72], [22,26,67,73], [24,68,69,73],
>		[25,70,71,73], [23,27,72,73], [28,32,67,74], [30,69,71,74],
>		[31,68,70,74], [29,33,72,74], [16,20,40,44,67,71,75],
>		[18,42,69,75], [19,43,70,75], [17,21,41,45,68,72,75]]

> promptmessage :: [char]
> promptmessage = "Board, column, row? "

> filt :: [char]->num->num->[inputdatum]
> filt [] 0 m = [NodeNumber (m-21)]
> filt [] n m = []
> filt x 0 m = NodeNumber (m-21) : Prompt : filt x 3 0
> filt ('\n' : b) n m  = filt b n m
> filt (' ' : b) n m  = filt b n m
> filt (a : b) n m
>	= Error : Prompt : filt (remrestofline b) 3 0, if ~ (digit a)
>	= Error : Prompt : filt (remrestofline b) 3 0, if code a < code '1'  \/ code a > code '4'
>	= NodeNumber (m-21) : Prompt : filt (a:b) 3 0, if n = 0
>	= filt b 2 (4*(code a - code '0')), if n = 3
>	= filt b 1 (m + (code a - code '0')), if n = 2
>	= filt b 0 (m + 16*(code a - code '0')), if n = 1
>	= Error : Prompt : filt (remrestofline b) 3 0, otherwise

remrestofline ignores all characters to newline

> remrestofline :: [char]->[char]
> remrestofline [] = []
> remrestofline ('\n' : b) = b
> remrestofline (a : b) = remrestofline b

> oxo2 :: [inputdatum]->[char]->[char]
> oxo2 [] bd = "\nYou resign - I win!\n"
> oxo2 (Error : x) bd = "Bad Input\n" ++ oxo2 x bd
> oxo2 (Prompt : x) bd = promptmessage ++ oxo2 x bd
> oxo2 (NodeNumber n : x) bd
>	= "Occupied; try again: " ++ oxo2 x bd, if occupied bd n
>	= "You win; well done!\n", if hlo ~= []
>	= "Drawn game\n", if qm < 0
>	= printboard nb ++showresult qm ++ "\n" ++
>		printboard nbx ++ again, otherwise
>			where
>			nb = newboard 'O' n bd
>			qm = quickmove nb
>			hlo = hasline 'O' rows nb
>			hlx = hasline 'X' rows nbx
>			nbx = newboard 'X' qm nb
>			again
>				= "I win, tough luck!\n", if hlx ~= []
>				= oxo2 x nbx, otherwise

> showresult :: num->[char]
> showresult n
>	= "Draw", if n = -1
>	= "I move " ++ show (((n div 4) mod 4) + 1) ++
>			show ((n mod 4) + 1) ++
>			show (n div 16 + 1), otherwise

> oxo1 :: [char]->[char]
> oxo1 = oxo2 (Prompt : filt (read "/dev/tty") 3 0)

newboard takes a board and replaces it with a board where position is
changed to be owned by player.

> newboard :: char->num->[char]->[char]
> newboard player 0 (h:t) = player : t
> newboard player posn (h:t) = h : newboard player (posn-1) t

> linevalue :: [num]->[char]->num
> linevalue x bd
>	= lv2 (lv1 (lv0 x))
>		where
>		lv0 [a,b,c,d] = [bd!a, bd!b, bd!c, bd!d]
>		lv1 [] = (0,0)
>		lv1 ('X':t) = xadd (lv1 t)
>				where
>				xadd (x,o) = (x+1,o)
>		lv1 ('O':t) = oadd (lv1 t)
>				where
>				oadd (x,o) = (x,o+1)
>		lv1 (h:t) = lv1 t
>		lv2 (x,0) = crossvals!x
>		lv2 (0,o) = noughtvals!o
>		lv2 (x,o) = 0

> squarevalue :: [char]->num->num
> squarevalue bd n
>	= -1, if bd!n ~= '.'
>	= addv bd (nodes!n), otherwise
>		where
>		addv bd [] = 0
>		addv bd (x:y) = linevalue (rows!x) bd + addv bd y

> values bd = map (squarevalue bd) [0..63]
> quickmove bd
>	= -2, if hasline 'O' rows bd ~= []
>	= -3, if hasline 'X' rows bd ~= []
>	= biggest (values bd) (-1) (-1) 0, otherwise

biggest - arg1 is the list of values, arg2 is the current biggest
value found, arg3 is the square it was found in, arg4 is
the current square being examined.

> biggest :: [num]->num->num->num->num
> biggest [] (-1) square posn = -1
> biggest [] n square posn = square
> biggest (a:b) n square posn
>	= biggest b n square (posn+1), if n > a
>	= biggest b a posn (posn+1), otherwise

> oxo :: [char]
> oxo = "Three dimensional noughts and crosses\n" ++
>		"You are O, I am X, you move first\n" ++
>		printboard startboard ++
>		(oxo1 startboard)

> hasline :: char->[[num]]->[char]->[num]
> hasline plr [] bd = []
> hasline plr (a:b) bd
>	= a, if bd!(a!0) = plr & bd!(a!1) = plr &
>			bd!(a!2) = plr & bd!(a!3) = plr
>	= hasline plr b bd, otherwise

> for :: num->num->num->(num->[char])->[char]
> for a b c f
>	= [], if a > b
>	= f a ++ for (a+c) b c f, otherwise

printboard displays the board in a suitable terminal form

> printboard :: [char]->[char]
> printboard x = pb x 3
>			where
>			pb [] n = []
>			pb (a:b:c:d:e) 0 = a:b:c:d:'\n': pb e 3
>			pb (a:b:c:d:e) n = a:b:c:d:' ':' ': pb e (n-1)

occupied says whether the square (argument 2) is free in board (argument 1).

> occupied :: [char]->num->bool
> occupied x n = x!n ~= '.'