Some work on getting scripts to work, hopefully not too messy.
This commit is contained in:
parent
bf522a863d
commit
b9006ffd64
|
|
@ -63,3 +63,6 @@ stamp-h[0-9]
|
|||
tmp
|
||||
/.version
|
||||
/doc/stamp-[0-9]
|
||||
|
||||
scripts/*
|
||||
!scripts/*.in
|
||||
31
Makefile.am
31
Makefile.am
|
|
@ -1,4 +1,5 @@
|
|||
bin_SCRIPTS =
|
||||
bin_SCRIPTS = scripts/join-rps \
|
||||
scripts/do-rps
|
||||
|
||||
# Handle substitution of fully-expanded Autoconf variables.
|
||||
do_subst = $(SED) \
|
||||
|
|
@ -32,8 +33,10 @@ SUFFIXES = .scm .go
|
|||
.scm.go:
|
||||
$(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
|
||||
|
||||
SOURCES = gib-gab-gob/rps.scm \
|
||||
gib-gab-gob/actors.scm
|
||||
SOURCES = gib-gab-gob/utils.scm \
|
||||
gib-gab-gob/rps.scm \
|
||||
gib-gab-gob/actors.scm \
|
||||
gib-gab-gob/lib.scm
|
||||
|
||||
TESTS =
|
||||
|
||||
|
|
@ -51,14 +54,28 @@ AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)"
|
|||
|
||||
AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)"
|
||||
|
||||
info_TEXINFOS = doc/gib-gab-gob.texi
|
||||
info_TEXINFOS = doc/version.texi \
|
||||
doc/gib-gab-gob.texi
|
||||
dvi: # Don't build dvi docs
|
||||
|
||||
EXTRA_DIST += README \
|
||||
HACKING \
|
||||
EXTRA_DIST += ChangeLog \
|
||||
AUTHORS \
|
||||
NEWS \
|
||||
doc/.dirstamp \
|
||||
doc/stamp-vti \
|
||||
doc/gib-gab-gob.info \
|
||||
doc/version.info \
|
||||
COPYING \
|
||||
.gitignore \
|
||||
HACKING \
|
||||
README \
|
||||
pre-inst-env.in \
|
||||
build-aux/texinfo.tex \
|
||||
build-aux/test-driver.scm \
|
||||
build-aux/missing \
|
||||
build-aux/install-sh \
|
||||
build-aux/mdate-sh \
|
||||
hall.scm \
|
||||
.gitignore \
|
||||
build-aux/test-driver.scm \
|
||||
$(TESTS)
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,8 @@ AM_SILENT_RULES([yes])
|
|||
|
||||
AC_CONFIG_FILES([Makefile])
|
||||
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
||||
|
||||
AC_CONFIG_FILES([scripts/join-rps],[chmod +x scripts/join-rps])
|
||||
AC_CONFIG_FILES([scripts/do-rps],[chmod +x scripts/do-rps])
|
||||
dnl Search for 'guile' and 'guild'. This macro defines
|
||||
dnl 'GUILE_EFFECTIVE_VERSION'.
|
||||
GUILE_PKG([3.0 2.2 2.0])
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
#:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
|
||||
#:use-module (gib-gab-gob utils)
|
||||
#:use-module (goblins)
|
||||
#:use-module (goblins vat)
|
||||
#:use-module (goblins actor-lib methods)
|
||||
#:use-module (goblins actor-lib sealers)
|
||||
#:use-module (oop goops)
|
||||
|
|
@ -71,21 +72,22 @@
|
|||
|
||||
;; Convert from a prompt to a valid move.
|
||||
;; TODO: validation
|
||||
;; Careful! This does not play nice with the REPL!
|
||||
(define (prompt->move)
|
||||
(format #t "enter move? > ")
|
||||
(map string->number (string-tokenize (read-line (current-input-port)) char-set:digit)))
|
||||
|
||||
;; Do our move.
|
||||
(define (move!)
|
||||
(let ((move (prompt->move)))
|
||||
(format #t "move is ~s\n" move)
|
||||
($ board 'choose! move mark)
|
||||
move))
|
||||
(on (spawn-fibrous-vow (lambda () (prompt->move)))
|
||||
(lambda (move)
|
||||
(format #t "move is ~s\n" move)
|
||||
($ board 'choose! move mark)
|
||||
move)))
|
||||
|
||||
(define (loop-move peer)
|
||||
(format #t "begin move w ~s\n" peer)
|
||||
(on (<- peer 'exchange-move receiver
|
||||
(move!))
|
||||
(on (<- peer 'exchange-move receiver (move!))
|
||||
;; get exchange
|
||||
(lambda (peer-move)
|
||||
;; Actually respond to the move
|
||||
|
|
@ -115,9 +117,9 @@
|
|||
|
||||
(methods
|
||||
;; Switch coords for clarity
|
||||
[(ref coords) (
|
||||
(format #t "coords are ~s\n" coords)
|
||||
(match coords ((x y) (array-ref arr y x))))]
|
||||
[(ref coords)
|
||||
((format #t "coords are ~s\n" coords)
|
||||
(match coords ((x y) (array-ref arr y x))))]
|
||||
[(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
|
||||
[(choose! coords mark-char)
|
||||
(if ($ self 'chosen? coords)
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
#:use-module (goblins ocapn ids)
|
||||
#:use-module (goblins ocapn netlayer testuds)
|
||||
#:use-module (oop goops)
|
||||
#:export (<rps-host> <rps-client> join-rps pick-rps rps-winner rock-paper-scissors))
|
||||
#:export (do-rps join-rps pick-rps rps-winner rock-paper-scissors))
|
||||
|
||||
;;
|
||||
;; Host logic
|
||||
|
|
@ -30,6 +30,9 @@
|
|||
(unless (access? tmp X_OK) (mkdir tmp))
|
||||
(spawn ^testuds-netlayer tmp))
|
||||
|
||||
(define (do-rps user-name)
|
||||
(make <rps-host> #:user-name user-name))
|
||||
|
||||
;;
|
||||
;; Client logic
|
||||
;;
|
||||
|
|
|
|||
57
guix.scm
57
guix.scm
|
|
@ -15,7 +15,62 @@
|
|||
(version "0.1")
|
||||
(source "./gib-gab-gob-0.1.tar.gz")
|
||||
(build-system gnu-build-system)
|
||||
(arguments `())
|
||||
(arguments
|
||||
`(#:modules
|
||||
((ice-9 match)
|
||||
(ice-9 ftw)
|
||||
,@%gnu-build-system-modules)
|
||||
#:phases
|
||||
(modify-phases
|
||||
%standard-phases
|
||||
(add-after
|
||||
'install
|
||||
'hall-wrap-binaries
|
||||
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||
(let* ((compiled-dir
|
||||
(lambda (out version)
|
||||
(string-append
|
||||
out
|
||||
"/lib/guile/"
|
||||
version
|
||||
"/site-ccache")))
|
||||
(uncompiled-dir
|
||||
(lambda (out version)
|
||||
(string-append
|
||||
out
|
||||
"/share/guile/site"
|
||||
(if (string-null? version) "" "/")
|
||||
version)))
|
||||
(dep-path
|
||||
(lambda (env modules path)
|
||||
(list env
|
||||
":"
|
||||
'prefix
|
||||
(cons modules
|
||||
(map (lambda (input)
|
||||
(string-append
|
||||
(assoc-ref inputs input)
|
||||
path))
|
||||
,''("guile-goblins"))))))
|
||||
(out (assoc-ref outputs "out"))
|
||||
(bin (string-append out "/bin/"))
|
||||
(site (uncompiled-dir out "")))
|
||||
(match (scandir site)
|
||||
(("." ".." version)
|
||||
(for-each
|
||||
(lambda (file)
|
||||
(wrap-program
|
||||
(string-append bin file)
|
||||
(dep-path
|
||||
"GUILE_LOAD_PATH"
|
||||
(uncompiled-dir out version)
|
||||
(uncompiled-dir "" version))
|
||||
(dep-path
|
||||
"GUILE_LOAD_COMPILED_PATH"
|
||||
(compiled-dir out version)
|
||||
(compiled-dir "" version))))
|
||||
,''("join-rps" "do-rps"))
|
||||
#t))))))))
|
||||
(native-inputs
|
||||
`(("autoconf" ,autoconf)
|
||||
("automake" ,automake)
|
||||
|
|
|
|||
12
hall.scm
12
hall.scm
|
|
@ -16,12 +16,15 @@
|
|||
(files (libraries
|
||||
((directory
|
||||
"gib-gab-gob"
|
||||
((compiled-scheme-file "actors")
|
||||
((scheme-file "utils")
|
||||
(scheme-file "rps")
|
||||
(scheme-file "actors")
|
||||
(compiled-scheme-file "rps")))))
|
||||
(scheme-file "lib")))))
|
||||
(tests ((directory "tests" ())))
|
||||
(programs ((directory "scripts" ())))
|
||||
(programs
|
||||
((directory
|
||||
"scripts"
|
||||
((in-file "join-rps") (in-file "do-rps")))))
|
||||
(documentation
|
||||
((text-file "ChangeLog")
|
||||
(text-file "AUTHORS")
|
||||
|
|
@ -32,14 +35,13 @@
|
|||
(text-file ".dirstamp")
|
||||
(text-file "stamp-vti")
|
||||
(info-file "gib-gab-gob")
|
||||
(info-file "version")
|
||||
(texi-file "gib-gab-gob")))
|
||||
(text-file "COPYING")
|
||||
(text-file "HACKING")
|
||||
(text-file "README")))
|
||||
(infrastructure
|
||||
((in-file "pre-inst-env")
|
||||
(automake-file "Makefile")
|
||||
(autoconf-file "configure")
|
||||
(directory
|
||||
"build-aux"
|
||||
((tex-file "texinfo")
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
#!@GUILE@ --no-auto-compile
|
||||
-*- scheme -*-
|
||||
!#
|
||||
|
||||
(use-modules (gib-gab-gob rps))
|
||||
(apply do-rps (cdr (command-line)))
|
||||
|
||||
(while #t #f) ;; indefinitely
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
#!@GUILE@ --no-auto-compile
|
||||
-*- scheme -*-
|
||||
!#
|
||||
|
||||
(use-modules (gib-gab-gob rps))
|
||||
(apply join-rps (cdr (command-line)))
|
||||
|
||||
(while #t #f) ;; indefinitely
|
||||
Loading…
Reference in New Issue