Skip to content
This repository
Newer
Older
100644 159 lines (137 sloc) 4.861 kb
7097296b »
2011-02-14 added content
1 #!/usr/bin/env newlisp
2
3 ;; @module TicTacToe
4 ;; @author cormullion
5 ;; @description simple tic tac toe
6 ;; @version 0.0.2 2008-10-08 21:33:37
7 ;; version 0.0.1 2008-05-10 22:48:36
8 ;; just waiting for you to add some intelligence to (generate-computer-move) !
9
10 (load "/usr/share/newlisp/guiserver.lsp")
11
12 (gs:init)
13 (gs:frame 'TicTacToe 100 100 360 400 "TicTacToe")
14 (gs:set-border-layout 'TicTacToe)
15 (gs:canvas 'Ttt-Canvas)
16 (gs:set-size 'Ttt-Canvas 360 360)
17 (gs:set-background 'Ttt-Canvas '(.3 .4 .5 .4))
18 (gs:mouse-released 'Ttt-Canvas 'mouse-released-action true)
19 (gs:label 'Status "Loading...")
20 (gs:set-font 'Ttt-Canvas "Sans Serif" 60 "bold")
21
22 ; playing grid
23 (set '*grid* (dup nil 9))
24
25 ; size of squares in pixels
26 (set 'size 120)
27
28 ; winning positions
29 (set '*winning-positions* '((0 1 2) (3 4 5) (6 7 8) (0 3 6) (1 4 7) (2 5 8) (0 4 8) (2 4 6)))
30
31 ; game functions
32
33 ;; @syntax (mouse-released-action x y button modifiers tags)
34 ;;
35 (define (mouse-released-action x y button modifiers tags)
36 { extract the tag of the clicked square }
37 (let ((move (int (string (first tags)) -1 10)))
38 (do-human-move move)))
39
40 ;; @syntax (flash-the-win)
41 ;;
42 (define (flash-the-win)
43 { flash the winning line }
44 (let ((winning-line (nth (last *winner*) *winning-positions* )))
45 (dotimes (x 40)
46 (if (< ((now) 6) 500000) ; less than 500k milliseconds
47 (map (fn (tg) (gs:hide-tag (string tg))) winning-line)
48 (map (fn (tg) (gs:show-tag (string tg))) winning-line))
49 (sleep 100))))
50
51 ;; @syntax (square-to-xy square)
52 ;;
53 (define (square-to-xy square)
54 { convert grid square number to x/y (column row) }
55 (list (mod square 3) (/ square 3)))
56
57 ;; @syntax (display)
58 ;;
59 (define (display)
60 { draw grid and plays }
61 (local (x y)
62 (for (i 0 8)
63 (map set '(x y) (square-to-xy i))
64 (cond
65 ((= (*grid* i) 'X) (set 'colour gs:white))
66 ((= (*grid* i) 'O) (set 'colour gs:black))
67 (true (set 'colour gs:gray)))
68 ; delete previous squares and redraw
69 (gs:delete-tag (string i))
70 (gs:fill-rect (string i) (* x size) (* y size) (- size 2) (- size 2) colour)
71 ; delete previous X or O text and redraw
72 (gs:delete-tag (string "text" i))
73 (gs:draw-text
74 (string "text" i) ; tag
75 (if (*grid* i) (string (*grid* i)) "") ; text to display
76 (+ 35 (* x size)) ; move text slightly right
77 (+ 78 (* y size)) ; move text down
78 (if (= colour gs:white) gs:black gs:white) ; invert colour
79 ))))
80
81 ;; @syntax (available-moves)
82 ;;
83 (define (available-moves)
84 (index nil? *grid*))
85
86 ;; @syntax (generate-computer-move)
87 ;;
88 (define (generate-computer-move)
89 { Here you could add code to find the best move :) }
90 { this just chooses at random... }
91 (apply amb (available-moves)))
92
93 ;; @syntax (check-move move)
94 ;;
95 (define (check-move move)
96 { check if move is valid }
97 (and (<= 0 move 8) (find move (available-moves))))
98
99 ;; @syntax (won? player)
100 ;;
101 (define (won? player)
102 { check if a player has won }
103 ; get all squares marked by this player
104 (letn ((player-squares (index (fn (x) (= x player)) *grid*))
105 ; are these squares found one of the winning positions?
106 (wins-for-player (map (fn (win) (= win (intersect win player-squares))) *winning-positions*)))
107 ; wins-for-player is something like {nil nil nil true nil nil nil... )
108 (if (exists true? wins-for-player)
109 ; return *winner* and index of winning position
110 (set '*winner* (list player (find true wins-for-player))))))
111
112 ;; @syntax (game-over?)
113 ;;
114 (define (game-over?)
115 { is the game over yet? }
116 (or (won? 'X) (won? 'O) (empty? (available-moves))))
117
118 ;; @syntax (do-computer-move)
119 ;;
120 (define (do-computer-move)
121 { the computer has a move }
122 (and (not (game-over?) (= *turn* "computer"))
123 (gs:set-text 'Status "thinking...")
124 (gs:update)
125 (sleep 2000)
126 (setf (*grid* (generate-computer-move)) 'O)
127 (set '*turn* "human")
128 (gs:set-text 'Status "Your move")))
129
130 ;; @syntax (do-human-move move)
131 ;;
132 (define (do-human-move move)
133 { the human has made a move }
134 (and (not (game-over?) (= *turn* "human"))
135 (check-move move)
136 (setf (*grid* move) 'X)
137 (display)
138 (set '*turn* "computer")
139 (do-computer-move)
140 (display)))
141
142 (gs:add-to 'TicTacToe 'Ttt-Canvas "center" 'Status "south")
143 (gs:set-visible 'TicTacToe true)
144
145 (while true
146 (display)
147 (set '*turn* "human" '*winner* nil)
148 (gs:set-text 'Status "New game. Your move")
149 (do-until (game-over?) (gs:check-event 1000000))
150 (cond
151 (*winner* (gs:set-text 'Status (string (first *winner*) " wins"))
152 (flash-the-win))
153 (true (gs:set-text 'Status "it's a draw")
154 (sleep 3000)))
155 ; reset for another game
156 (set '*grid* (dup nil 9)))
157
158 ; eof
Something went wrong with that request. Please try again.