(define-module (gib-gab-gob ui console)
  #:use-module (gib-gab-gob rps)
  #:use-module (gib-gab-gob game)
  #:use-module (gib-gab-gob board)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 exceptions)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-1)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (goblins)
  #:use-module (goblins ocapn captp)
  #:use-module (goblins ocapn ids)
  #:use-module (goblins ocapn netlayer onion)
  #:export (make-initiator make-joiner))

;; Module for simple console-based UI (no curses)

;; A single run of the loop for a bespoke REPL for playing the game
(define (%loop vat b controller my-turn+)
  (get-message my-turn+)
  (with-vat vat
            (on (<- controller 'state)
                (λ (state)
                  (%print b state)
                  (if (eq? state 'play)
                      (let ((coords (%read)))
                        (if coords (%eval vat b controller coords) #f))
                      #f)))))

(define (%read)
  (define line (read-line (current-input-port)))
  (if (string-prefix? ",q" line) #f
      (let ((coords (map string->number (string-tokenize line char-set:digit))))
        (if (not (= (length coords) 2))
            (begin (format #t "Must be two numbers, x y; or ,quit to quit. Try again.\n")
                   (%prompt) (%read))
            coords))))

(define (%eval vat b controller coordinates)
  (format #t "Moving ~a\n" coordinates)
  ;; weird?
  (let ((x (first coordinates))
        (y (second coordinates)))
    (on (<- controller 'my-turn! x y)
        (λ (state) (%display b state)))))

(define (%print b state)
  (%display b state)
  (%prompt))

(define (%prompt) (format #t "Enter your move: "))

(define (%display b state)
  (board-display b)
  (cond
   ((eq? state 'won) => (format #t "*** I won! ***\n"))
   ((eq? state 'lost) => (format #t "*** I lost! ***\n"))))

(define (begin-game-loop board controller my-turn+)
  (define vat (spawn-vat #:name "UI"))
  (spawn-fiber
   (λ ()
     (while (%loop vat board controller my-turn+))
     (format #t "bye-bye!\n")
     #f)))

(define (make-initiator)
  (with-vat
   (spawn-vat #:name "Initiator Game")
   (define my-turn+ (make-channel))
   (define board (make-board))
   (define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
   (initiator/connect initiator)
   (begin-game-loop board initiator my-turn+)))

(define (make-joiner ^game-controller addr)
  (with-vat
   (spawn-vat #:name "Joiner Game")
   (define mycapn (spawn-mycapn (new-onion-netlayer)))
   (define my-turn+ (make-channel))
   (define board (make-board))
   (let* ((init-sref (string->ocapn-id addr))
          (initiator ($ mycapn 'enliven init-sref))
          (joiner (spawn ^game-joiner initiator ^game-controller board my-turn+))
          (sealed ($ joiner 'get-sealed-pick)))
     (on (<- initiator 'register-opponent joiner sealed)
         (λ (_)
           (on ($ joiner 'initialize!)
               (λ (status) (begin-game-loop board joiner my-turn+) #f)))))))