2023-07-03 02:56:06 +00:00
|
|
|
(define-module (gib-gab-gob game)
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins)
|
2023-02-18 20:02:19 +00:00
|
|
|
#:use-module (goblins vat)
|
2023-02-03 13:18:17 +00:00
|
|
|
#:use-module (goblins actor-lib methods)
|
|
|
|
#:use-module (goblins actor-lib sealers)
|
2023-07-02 07:08:23 +00:00
|
|
|
#:use-module (goblins actor-lib selfish-spawn)
|
2023-02-12 05:37:38 +00:00
|
|
|
#:use-module (ice-9 match)
|
2023-07-03 06:55:20 +00:00
|
|
|
#:use-module (srfi srfi-1)
|
2023-02-12 08:42:07 +00:00
|
|
|
#:use-module (ice-9 rdelim)
|
2023-07-03 02:52:44 +00:00
|
|
|
#:export (^ggg-controller))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
|
|
|
;; Actual Tic Tac Toe game
|
|
|
|
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
|
|
|
|
|
2023-07-03 05:14:07 +00:00
|
|
|
(define (^ggg-controller bcom initiator? peer)
|
2023-07-03 05:57:40 +00:00
|
|
|
(define mark (if initiator? 'x 'o))
|
|
|
|
(define peer-mark (if initiator? 'o 'x))
|
|
|
|
(define board (make-board))
|
2023-07-03 05:14:07 +00:00
|
|
|
(define my-turn? (not initiator?))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
2023-02-06 11:12:28 +00:00
|
|
|
(methods
|
2023-07-03 05:14:07 +00:00
|
|
|
;; The peer is telling us about the turn it took.
|
2023-07-03 08:09:56 +00:00
|
|
|
[(peer-turn! x y)
|
2023-07-03 05:14:07 +00:00
|
|
|
(if (not my-turn?)
|
|
|
|
(begin
|
2023-07-03 08:09:56 +00:00
|
|
|
(board-choose! board peer-mark x y)
|
2023-07-03 05:57:40 +00:00
|
|
|
(set! my-turn? (not my-turn?))
|
|
|
|
(board-display board))
|
2023-07-03 05:14:07 +00:00
|
|
|
(error "It's my turn!"))]
|
|
|
|
;; TODO: This needs to go somewhere else so the peer can't move for us!
|
2023-07-03 08:09:56 +00:00
|
|
|
[(my-turn! x y)
|
2023-07-03 05:14:07 +00:00
|
|
|
(if my-turn?
|
|
|
|
(begin
|
2023-07-03 08:09:56 +00:00
|
|
|
(board-choose! board mark x y)
|
2023-07-03 05:57:40 +00:00
|
|
|
(set! my-turn? (not my-turn?))
|
|
|
|
(board-display board))
|
2023-07-03 05:14:07 +00:00
|
|
|
(error "It's not my turn."))]))
|
2023-02-12 05:37:38 +00:00
|
|
|
|
|
|
|
;; Board logic
|
2023-02-06 11:12:28 +00:00
|
|
|
|
2023-07-03 05:57:40 +00:00
|
|
|
(define (make-board)
|
|
|
|
(make-array #f ggg-size ggg-size))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
2023-07-03 08:09:56 +00:00
|
|
|
(define (board-ref board x y)
|
|
|
|
(array-ref board y x))
|
2023-02-06 11:12:28 +00:00
|
|
|
|
2023-07-03 08:09:56 +00:00
|
|
|
(define (board-choose! board val x y)
|
|
|
|
(define ref (board-ref board x y))
|
|
|
|
(if ref
|
|
|
|
(error "That space is already occupied with:" ref)
|
|
|
|
(array-set! board val y x)))
|
2023-07-03 05:57:40 +00:00
|
|
|
|
|
|
|
(define (board-display board)
|
2023-07-03 05:59:01 +00:00
|
|
|
(define (print m) (or m " "))
|
2023-07-03 05:57:40 +00:00
|
|
|
;; this is .. probably messy?
|
|
|
|
(array-slice-for-each-in-order
|
|
|
|
1
|
2023-07-03 08:09:56 +00:00
|
|
|
(λ (x)
|
|
|
|
(map (λ (i) (format #t "[~a]" (print i)))
|
2023-07-03 05:57:40 +00:00
|
|
|
(array->list x))
|
|
|
|
(format #t "\n"))
|
|
|
|
board))
|
2023-07-03 06:55:20 +00:00
|
|
|
|
|
|
|
(define (board-winner? board mark)
|
2023-07-03 08:09:56 +00:00
|
|
|
;; e.g. '(0 1 2)
|
2023-07-03 06:55:20 +00:00
|
|
|
(define idxs (iota ggg-size))
|
2023-07-03 08:09:56 +00:00
|
|
|
;; true, if any item in list is non-false
|
|
|
|
(define (any? l) (and (any identity l) #t))
|
|
|
|
;; Iterate through iota calling fn and check if all are true
|
|
|
|
(define (iter-all? fn) (apply eq? mark (map fn idxs)))
|
|
|
|
;; Iterate through the rows and see if any are winners
|
|
|
|
(define (row-winner? b)
|
|
|
|
(any? (map (λ (y) (iter-all? (λ (x) (board-ref b x y)))) idxs)))
|
|
|
|
(or (row-winner? board)
|
|
|
|
(row-winner? (transpose-array board 1 0))
|
|
|
|
;; check the two diagonals
|
|
|
|
(iter-all? (λ (x) (board-ref board x x)))
|
|
|
|
(iter-all? (λ (x) (board-ref board x (- ggg-size x 1))))))
|