stand-in-language/tictactoe.tel at master · Stand-In-Language/stand-in-language · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
import Prelude

drawPiece = \piece alt -> if piece
                             then if left piece
                                     then "O"
                                     else "X"
                             else alt

-- drawBoard
drawBoard
 = \pieces -> let getPiece = \n -> left (n (\x -> right x) pieces)
                  alt = \n -> (n succ (left "1"), 0)
                  dp = \n -> drawPiece (getPiece n) (alt n)
                  blankRow = "-+-+-\n"
              in concat [ dp $0, "|", dp $1, "|", dp $2, "\n"
                        , blankRow
                        , dp $3, "|", dp $4, "|", dp $5, "\n"
                        , blankRow
                        , dp $6, "|", dp $7, "|", dp $8, "\n"
                        ]

setPiece
 = \player pos board -> let before = take pos board
                            after = right (drop pos board)
                        in concat [before, (player,0), after]

getSquare
 = \pos board -> left (drop pos board)

fullBoard
 = \board -> let squares = map (\x -> getSquare (d2c x) board) [0,1,2,3,4,5,6,7,8]
             in foldr and 1 squares

emptyBoard = [0,0,0,0,0,0,0,0,0]

-- validInput = \x -> assert (and x (and (not (right x)) (not ($127 left x)))) "invalid input"
-- validInput = \x -> assert (not ($127 left x)) "invalid input"
validInput = \x -> assert (and (not ($127 left x)) (not (right x))) "invalid input"
validPlayer = \x -> assert (not ($3 left x)) "invalid player state"
validBoard = \x -> assert (not ($9 right x)) "invalid board state"

processInput
 = \string -> let num = dMinus (left string) (left "0")
              in if and num (dMinus 10 num)
                 then num
                 else 0

whoWon
 = \board -> let rows = [[0,1,2]
                        ,[3,4,5]
                        ,[6,7,8]
                        ,[0,3,6]
                        ,[1,4,7]
                        ,[2,5,8]
                        ,[0,4,8]
                        ,[2,4,6]
                        ]
                 doRow
                   = \row -> let pieces = map (\x -> getSquare (d2c x) board) row
                                 oneWins = foldr and 1 (map (dEqual 1) pieces)
                                 twoWins = foldr and 1 (map (dEqual 2) pieces)
                             in if oneWins then 1 else if twoWins then 2 else 0
                 combineRow
                   = \row winAcc -> if winAcc then winAcc else doRow row
             in foldr combineRow 0 rows

main
 = \input -> let placeString : validInput = left input
                 oldState = right input
                 boardIn : validBoard = right oldState
                 playerIn : validPlayer = left oldState
                 oldBoard = if boardIn then boardIn else emptyBoard
                 place = processInput placeString
                 placeOccupied = getSquare (d2c (left place)) oldBoard
                 validPlace = and place (not placeOccupied)
                 newBoard = if validPlace
                               then setPiece (succ playerIn) (d2c (left place)) oldBoard
                               else oldBoard
                 winner = whoWon newBoard
                 filledBoard = fullBoard newBoard
                 showBoard = or (and validPlace
                                     (and (not winner)
                                          (not filledBoard)
                                     )
                                )
                                (not boardIn)
                 doEnd = if winner then concat [ "Player "
                                               , (d2c winner succ (left "0"), 0)
                                               , " wins!"
                                               ]
                                   else "the game is a tie"
                 nextPlayer = if showBoard then not playerIn else playerIn
                 output = if showBoard
                             then concat [ (drawBoard newBoard)
                                         , "Player "
                                         , (d2c nextPlayer succ (left "1"), 0)
                                         , "'s turn\n"
                                         , "please input number of square: "
                                         ]
                             else if dEqual placeString "q"
                                     then 0
                                     else if not place
                                             then "please enter a number 1-9"
                                             else if not validPlace
                                                     then "please choose unoccupied space"
                                                     else doEnd
                 nextState = if and output
                                    (and (not filledBoard)
                                         (not winner)
                                    )
                                then (nextPlayer,newBoard)
                                else 0
             in (output, nextState)