79 lines
2.6 KiB
Scheme
79 lines
2.6 KiB
Scheme
(define-module (gib-gab-gob rps)
|
|
#:use-module (gib-gab-gob actors)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (goblins)
|
|
#: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))
|
|
|
|
;;
|
|
;; 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))
|
|
(format #t "Connect to: ~a\n" (ocapn-id->string lobby-sref))))
|
|
|
|
(define (new-testuds-netlayer)
|
|
(define tmp "/tmp/netlayers")
|
|
(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 client-picker (spawn ^client-picker))
|
|
(on (<- (lobby client) 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
|
|
(lambda (_)
|
|
(format #t "~a finished the game.\n" user-name)))))
|
|
|
|
;;
|
|
;; Standard rock paper scissors logic follows!
|
|
;;
|
|
(define rock-paper-scissors (list 'rock 'paper 'scissors))
|
|
|
|
(define (pick-rps)
|
|
(list-ref rock-paper-scissors (random (length rock-paper-scissors))))
|
|
|
|
(define (rps-winner a b)
|
|
(if (and (memq a rock-paper-scissors) (memq b rock-paper-scissors))
|
|
(match (list a b)
|
|
[(x x) 'tie]
|
|
[('rock 'scissors) #t]
|
|
[('rock 'paper) #f]
|
|
[('scissors 'paper) #t]
|
|
[(x y) (not (rps-winner y x))])
|
|
(error "Unexpected item in the shooting area" a b)))
|