Guess game - two processes (racket)

guess-client.rkt

#lang racket
 
(require racket/serialize)
(require racket/cmdline)
(require "./messages.rkt")
 
(define (rand-number pred ran)
  (let loop ()
    (let ([r (random ran)])
      (if (pred r) (loop) r))))

(define (rand-bigger n ran)
  (rand-number 
    (λ (r) (>= n r)) ran))
 
(define (rand-lesser n ran)
  (rand-number
    (λ (r) (<= n r)) ran))
 
(define (rand-between s e ran)
  (rand-number 
   (λ (r) (or (>= s r) (<= e r))) ran))
 
 
(define (guesser name tryn ns rand-range)
  (match (tryn (first ns))
    ['bigger
     (match ns
       [(or (list n)
            (cons n (cons (cons _ 'bigger) _)))
        (guesser name tryn (cons (rand-lesser n rand-range)
                       (cons (cons n 'bigger) ns)) rand-range)]
       [(cons n (cons (cons na 'lesser) _))
        (guesser name tryn (cons (rand-between na n rand-range) 
                       (cons (cons n 'bigger) ns)) rand-range)])]
    ['lesser
     (match ns
       [(or (list n)
            (cons n (cons (cons _ 'lesser) _)))
         (guesser name tryn (cons (rand-bigger n rand-range)
                        (cons (cons n 'lesser) ns)) rand-range)]
       [(cons n (cons (cons na 'bigger) _))
        (guesser name tryn (cons (rand-between n na rand-range)
                       (cons (cons n 'lesser) ns)) rand-range)])]
    ['win (display (format "[~a] GANHEI USANDO NUMERO ~a, após ~a tentativas\n" name (first ns) (length ns)))]
    ['another-winner (display (format "[~a] Buuuaa! Alguém ganhou e não foi eu. Fiz ~a tentativa\n" name (length ns)))]))
       
  
(define (create-player name rand-range host port)
  (define-values (c-in c-out) (tcp-connect host port))
    (thread
     (λ ()
       (write (serialize (join-game name)) c-out)
       (newline c-out)
       (flush-output c-out)
       (define (tryn n)
         (write (serialize (guess-game n)) c-out)
         (newline c-out)
         (flush-output c-out)
         (deserialize (read (open-input-bytes (sync (read-bytes-line-evt c-in 'linefeed))))))
       (guesser name tryn (list 5) rand-range))))

(define players-param (make-parameter 3))
(define host (make-parameter "localhost"))
(define host-port (make-parameter 4000))
(define game-range (make-parameter 1000))

(define main
    (command-line
     #:program "Guess game server"
     #:once-each
     [("-r" "--range") r "Guess range. Defaults to 1000"
                          (game-range (string->number r))]
     [("-p" "--players") i "Number of players"
                          (players-param (string->number i))]
     [("-P" "--port") p "Host port"
                          (host-port (string->number p))]
     [("-H" "--host") h "Host server"
                          (host h)]))

(for-each 
 (λ (i) (create-player (format "P~a" i) (game-range) (host) (host-port)))
 (range (players-param)))

(thread-wait (current-thread))

guess-server.rkt

#lang racket
 
(require racket/serialize)
(require "./messages.rkt") 

(define host-port (make-parameter 4000))
(define game-range (make-parameter 1000))


(define game%
  (class object%
    (init guess-range)
 
    (define random-number guess-range)
    
    (super-new)
 
    (define/public (guess n)
      (cond
        [(= n random-number) 'win]
        [(> n random-number) 'bigger]
        [(< n random-number) 'lesser]))
    
    (set! random-number (random guess-range))))
 
(define there-is-a-winner #f)
 
(define (create-game-thread guess-range)
  (thread 
  (λ ()
    (define guess-game (new game% [guess-range guess-range]))
    (let loop ()
      (match (thread-receive)
        [(list n rthread)
         (if there-is-a-winner
             (thread-send rthread 'another-winner)
             (let ([guess-result (send guess-game guess n)])
               (and (eq? 'win guess-result) (set! there-is-a-winner #t))
               (thread-send rthread guess-result)))
         (loop)])))))
      
(define game-thread (create-game-thread (game-range)))
 
(define (create-player-thread s-in s-out game-thread)
  ;(let ([evt (read-bytes-line-evt s-in 'linefeed)])
  (thread
   (lambda ()
     (let loop ()
       (match (deserialize (read (open-input-bytes (sync (read-bytes-line-evt s-in 'linefeed)))))
         [(join-game player)
          (display (format "Player ~a connected\n" player))
          (loop)]
         [(guess-game n)
          (display (format "Guessing ~a\n" n))
          (thread-send game-thread (list n (current-thread)))
          (let ([result (thread-receive)])
            (display (format "Guess result is ~a\n" result))
            (match result
            [(or 'win 'another-winner)
             (write (serialize result) s-out)
             (newline s-out)
             (close-input-port s-in)
             (close-output-port s-out)
             (kill-thread (current-thread))]
            [_ 
             (write (serialize result) s-out)
             (newline s-out)
             (flush-output s-out)
             (loop)]))])))))
 


(define main
    (command-line
     #:program "Guess game server"
     #:once-each
     [("-r" "--range") r "Guess range. Defaults to 1000"
                          (game-range (string->number r))]
     [("-P" "--port") p "Host port"
                          (host-port (string->number p))]))

(define server-thread
  (thread
   (lambda ()
     (define server (tcp-listen (host-port)))
     (let loop ()
       (define-values (s-in s-out) (tcp-accept server))
       (create-player-thread s-in s-out game-thread)
       (loop)))))

  
(thread-wait server-thread)

messages.rkt

#lang racket
(require racket/serialize)

(provide join-game)
(provide guess-game)

(serializable-struct join-game (name))
(serializable-struct guess-game (n))