(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)))