Project cleanup, remove silly files and move board to file
This commit is contained in:
parent
ddcbaa6c35
commit
e46bc9f504
3
AUTHORS
3
AUTHORS
|
@ -1,3 +0,0 @@
|
||||||
Contributers to Gib-Gab-Gob 0.1:
|
|
||||||
|
|
||||||
Vivi Langdon <puttabutta@gmail.com>
|
|
|
@ -1 +0,0 @@
|
||||||
For a complete log, please see the Git commit log at <https://git.solarpunk.moe/vv/gib-gab-gob/commits/branch/main/>.
|
|
17
Makefile.am
17
Makefile.am
|
@ -33,10 +33,9 @@ SUFFIXES = .scm .go
|
||||||
.scm.go:
|
.scm.go:
|
||||||
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
|
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
|
||||||
|
|
||||||
SOURCES = gib-gab-gob/game.go \
|
SOURCES = gib-gab-gob/rps.scm \
|
||||||
gib-gab-gob/rps.scm \
|
gib-gab-gob/game.scm \
|
||||||
gib-gab-gob/game.scm \
|
gib-gab-gob/board.scm
|
||||||
gib-gab-gob/rps.go
|
|
||||||
|
|
||||||
TESTS =
|
TESTS =
|
||||||
|
|
||||||
|
@ -56,17 +55,9 @@ AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
|
||||||
|
|
||||||
dvi: # Don't build dvi docs
|
dvi: # Don't build dvi docs
|
||||||
|
|
||||||
EXTRA_DIST += ChangeLog \
|
EXTRA_DIST += COPYING \
|
||||||
AUTHORS \
|
|
||||||
NEWS \
|
|
||||||
doc/.dirstamp \
|
|
||||||
doc/stamp-vti \
|
|
||||||
doc/gib-gab-gob.info \
|
|
||||||
doc/version.info \
|
|
||||||
COPYING \
|
|
||||||
README.org \
|
README.org \
|
||||||
pre-inst-env.in \
|
pre-inst-env.in \
|
||||||
build-aux/texinfo.tex \
|
|
||||||
build-aux/test-driver.scm \
|
build-aux/test-driver.scm \
|
||||||
build-aux/missing \
|
build-aux/missing \
|
||||||
build-aux/install-sh \
|
build-aux/install-sh \
|
||||||
|
|
14
NEWS
14
NEWS
|
@ -1,14 +0,0 @@
|
||||||
# -*- mode: org; coding: utf-8; -*-
|
|
||||||
|
|
||||||
#+TITLE: Gib-Gab-Gob NEWS – history of user-visible changes
|
|
||||||
#+STARTUP: content hidestars
|
|
||||||
|
|
||||||
Copyright © (2023) Vivi Langdon <puttabutta@gmail.com>
|
|
||||||
|
|
||||||
Copying and distribution of this file, with or without modification,
|
|
||||||
are permitted in any medium without royalty provided the copyright
|
|
||||||
notice and this notice are preserved.
|
|
||||||
|
|
||||||
Please send Gib-Gab-Gob bug reports to INSERT EMAIL HERE.
|
|
||||||
|
|
||||||
* Publication at 0.1
|
|
|
@ -0,0 +1,45 @@
|
||||||
|
(define-module (gib-gab-gob board)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:export (make-board
|
||||||
|
board-ref
|
||||||
|
board-choose!
|
||||||
|
board-display
|
||||||
|
board-winner?))
|
||||||
|
|
||||||
|
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
|
||||||
|
|
||||||
|
(define (make-board)
|
||||||
|
(make-array #f ggg-size ggg-size))
|
||||||
|
|
||||||
|
(define (board-ref board x y)
|
||||||
|
(array-ref board y x))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(define (board-display board)
|
||||||
|
(array-slice-for-each-in-order
|
||||||
|
1
|
||||||
|
(λ (row)
|
||||||
|
(array-for-each (λ (x) (format #t "[~a]" (or x " "))) row)
|
||||||
|
(format #t "\n"))
|
||||||
|
board))
|
||||||
|
|
||||||
|
(define (board-winner? board mark)
|
||||||
|
;; e.g. '(0 1 2)
|
||||||
|
(define idxs (iota ggg-size))
|
||||||
|
;; 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))))))
|
|
@ -1,17 +1,11 @@
|
||||||
(define-module (gib-gab-gob game)
|
(define-module (gib-gab-gob game)
|
||||||
#:use-module (goblins)
|
#:use-module (goblins)
|
||||||
#:use-module (goblins vat)
|
|
||||||
#:use-module (goblins actor-lib methods)
|
#:use-module (goblins actor-lib methods)
|
||||||
#:use-module (goblins actor-lib sealers)
|
#:use-module (goblins actor-lib sealers)
|
||||||
#:use-module (goblins actor-lib selfish-spawn)
|
#:use-module (gib-gab-gob board)
|
||||||
#:use-module (ice-9 match)
|
|
||||||
#:use-module (srfi srfi-1)
|
|
||||||
#:use-module (ice-9 rdelim)
|
|
||||||
#:export (^ggg-controller))
|
#:export (^ggg-controller))
|
||||||
|
|
||||||
;; Actual Tic Tac Toe game
|
;; Actual Tic Tac Toe game
|
||||||
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
|
|
||||||
|
|
||||||
(define (^ggg-controller bcom initiator? peer)
|
(define (^ggg-controller bcom initiator? peer)
|
||||||
(define mark (if initiator? 'x 'o))
|
(define mark (if initiator? 'x 'o))
|
||||||
(define peer-mark (if initiator? 'o 'x))
|
(define peer-mark (if initiator? 'o 'x))
|
||||||
|
@ -35,41 +29,3 @@
|
||||||
(set! my-turn? (not my-turn?))
|
(set! my-turn? (not my-turn?))
|
||||||
(board-display board))
|
(board-display board))
|
||||||
(error "It's not my turn."))]))
|
(error "It's not my turn."))]))
|
||||||
|
|
||||||
;; Board logic
|
|
||||||
|
|
||||||
(define (make-board)
|
|
||||||
(make-array #f ggg-size ggg-size))
|
|
||||||
|
|
||||||
(define (board-ref board x y)
|
|
||||||
(array-ref board y x))
|
|
||||||
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
(define (board-display board)
|
|
||||||
(array-slice-for-each-in-order
|
|
||||||
1
|
|
||||||
(λ (row)
|
|
||||||
(array-for-each (λ (x) (format #t "[~a]" (or x " "))) row)
|
|
||||||
(format #t "\n"))
|
|
||||||
board))
|
|
||||||
|
|
||||||
(define (board-winner? board mark)
|
|
||||||
;; e.g. '(0 1 2)
|
|
||||||
(define idxs (iota ggg-size))
|
|
||||||
;; 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))))))
|
|
||||||
|
|
2
hall.scm
2
hall.scm
|
@ -19,6 +19,8 @@
|
||||||
((compiled-scheme-file "game")
|
((compiled-scheme-file "game")
|
||||||
(scheme-file "rps")
|
(scheme-file "rps")
|
||||||
(scheme-file "game")
|
(scheme-file "game")
|
||||||
|
(compiled-scheme-file "board")
|
||||||
|
(scheme-file "board")
|
||||||
(compiled-scheme-file "rps")))))
|
(compiled-scheme-file "rps")))))
|
||||||
(tests ((directory "tests" ())))
|
(tests ((directory "tests" ())))
|
||||||
(programs
|
(programs
|
||||||
|
|
Loading…
Reference in New Issue