vv/gib-gab-gob
1
0
Fork 0
Code Issues Pull requests Activity

Update to not use oop which reduces unneeded boilerplate

Browse source
This commit is contained in:
Vivianne 2023-07-01 23:08:05 -07:00
parent 461e88dd92
commit 3f39e8855e
9 changed files with 36 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Makefile.am
View file

@ -1,5 +1,5 @@
bin_SCRIPTS = scripts/join-rps \
scripts/do-rps
bin_SCRIPTS = scripts/make-client \
scripts/make-host
# Handle substitution of fully-expanded Autoconf variables.
do_subst = $(SED) \
@ -33,8 +33,11 @@ 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 \
SOURCES = gib-gab-gob/actors.go \
gib-gab-gob/lib.go \
gib-gab-gob/rps.scm \
gib-gab-gob/actors.scm \
gib-gab-gob/rps.go \
gib-gab-gob/lib.scm
TESTS =
@ -75,6 +78,8 @@ EXTRA_DIST += ChangeLog \
build-aux/mdate-sh \
hall.scm \
.gitignore \
configure.ac \
Makefile.am \
build-aux/test-driver.scm \
$(TESTS)

4
build-aux/test-driver.scm
View file

@ -2,8 +2,8 @@
(define script-version "2019-01-15.13") ;UTC
;;; Copyright ? 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright ? 2019 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co>
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by

4
configure.ac
View file

@ -12,8 +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])
AC_CONFIG_FILES([scripts/make-client],[chmod +x scripts/make-client])
AC_CONFIG_FILES([scripts/make-host],[chmod +x scripts/make-host])
dnl Search for 'guile' and 'guild'. This macro defines
dnl 'GUILE_EFFECTIVE_VERSION'.
GUILE_PKG([3.0 2.2 2.0])

3
gib-gab-gob.scm
View file

@ -1,7 +1,6 @@
(define-module (gib-gab-gob)
#:use-module (gib-gab-gob rps)
#:use-module (gib-gab-gob actors)
#:re-export (do-rps
join-rps))
#:re-export (make-client make-host))
(set! *random-state* (random-state-from-platform))

49
gib-gab-gob/rps.scm
View file

@ -5,24 +5,16 @@
#:use-module (goblins ocapn captp)
#:use-module (goblins ocapn ids)
#:use-module (goblins ocapn netlayer testuds)
#:use-module (oop goops)
#:export (do-rps join-rps pick-rps rps-winner rock-paper-scissors))
#:export (make-host make-client pick-rps rps-winner rock-paper-scissors))
;;
;; Host logic
;;
(define-class <rps-host> ()
(vat #:accessor vat #:init-thunk spawn-vat)
(lobby #:accessor lobby)
(mycapn #:accessor mycapn)
(user-name #:accessor user-name #:init-keyword #:user-name))
(define-method (initialize (host <rps-host>) initargs)
(next-method)
(with-vat (vat host)
(set! (lobby host) (spawn ^game-lobby))
(set! (mycapn host) (spawn-mycapn (new-testuds-netlayer)))
(define lobby-sref ($ (mycapn host) 'register (lobby host) 'testuds))
(define (make-host)
(with-vat (spawn-vat)
(define lobby (spawn ^game-lobby))
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
(define lobby-sref ($ mycapn 'register lobby 'testuds))
(format #t "Connect to: ~a\n" (ocapn-id->string lobby-sref))))
(define (new-testuds-netlayer)
@ -30,32 +22,17 @@
(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
;;
(define-class <rps-client> ()
(vat #:accessor vat #:init-thunk spawn-vat)
(user-name #:accessor user-name #:init-keyword #:user-name)
(addr #:accessor addr #:init-keyword #:addr)
(mycapn #:accessor mycapn)
(lobby #:accessor lobby))
(define-method (initialize (client <rps-client>) initargs)
(next-method)
(with-vat (vat client)
(set! (mycapn client) (spawn-mycapn (new-testuds-netlayer)))
(define lobby-sref (string->ocapn-id (addr client)))
(set! (lobby client)
($ (mycapn client) 'enliven lobby-sref))))
(define (join-rps user-name addr)
(define client (make <rps-client> #:user-name user-name #:addr addr))
(with-vat (vat client)
(define (make-client user-name addr)
(with-vat (spawn-vat)
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
(define lobby-sref (string->ocapn-id addr))
(define lobby ($ mycapn 'enliven lobby-sref))
(define client-picker (spawn ^client-picker))
(on (<- (lobby client) 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
(on (<- lobby 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
(lambda (_)
(format #t "~a finished the game.\n" user-name)))))

2
guix.scm
View file

@ -69,7 +69,7 @@
"GUILE_LOAD_COMPILED_PATH"
(compiled-dir out version)
(compiled-dir "" version))))
,''("join-rps" "do-rps"))
,''("make-client" "make-host"))
#t))))))))
(native-inputs
`(("autoconf" ,autoconf)

6
hall.scm
View file

@ -16,15 +16,17 @@
(files (libraries
((directory
"gib-gab-gob"
((scheme-file "utils")
((compiled-scheme-file "actors")
(compiled-scheme-file "lib")
(scheme-file "rps")
(scheme-file "actors")
(compiled-scheme-file "rps")
(scheme-file "lib")))))
(tests ((directory "tests" ())))
(programs
((directory
"scripts"
((in-file "join-rps") (in-file "do-rps")))))
((in-file "make-client") (in-file "make-host")))))
(documentation
((text-file "ChangeLog")
(text-file "AUTHORS")

2
scripts/join-rps.in → scripts/make-client.in
View file

@ -3,6 +3,6 @@
!#
(use-modules (gib-gab-gob rps))
(apply join-rps (cdr (command-line)))
(apply make-client (cdr (command-line)))
(while #t #f) ;; indefinitely

2
scripts/do-rps.in → scripts/make-host.in
View file

@ -3,6 +3,6 @@
!#
(use-modules (gib-gab-gob rps))
(apply do-rps (cdr (command-line)))
(apply make-host (cdr (command-line)))
(while #t #f) ;; indefinitely