Update to not use oop which reduces unneeded boilerplate

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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