#!/usr/bin/env chicken-scheme
;; -*- mode: scheme; -*-

(use tcp extras irregex
     (prefix sdl2 sdl2:))

(define width 640)
(define height 480)

(on-exit sdl2:quit!)

(sdl2:set-main-ready!)
(sdl2:init! '(everything))

(define-values (_window renderer)
  (sdl2:create-window-and-renderer! width height))

(define port 8080)
(define listener (tcp-listen port))

(tcp-accept-timeout 20)

(define px-re '(: "PX " (=> x (+ num))
                  " " (=> y (+ num))
                  (? " "
                     (? (=> a (= 2 xdigit)))
                     (=> r (= 2 xdigit))
                     (=> g (= 2 xdigit))
                     (=> b (= 2 xdigit)))))

(let loop ()
  (when (not (sdl2:quit-requested?))
    (receive
     (i o)
     (condition-case
      (tcp-accept listener)
      ((exn i/o net) (values #f #f)))
     (let loop ((lines 0))
       (when (and i o (not (eof-object? (condition-case
                                         (peek-char i)
                                         ((exn i/o net) #!eof)))))
         ;; TODO: check whether this needs condition-case
         (let ((line (read-line i)))
           (cond
            ((equal? line "SIZE")
             (printf "[SIZE] ~a ~a\n" width height)
             (write-line (format "SIZE ~a ~a" width height) o))
            ((irregex-match px-re line) =>
             (lambda (match)
               (let ((x (string->number (irregex-match-substring match 'x)))
                     (y (string->number (irregex-match-substring match 'y)))
                     (a (irregex-match-substring match 'a))
                     (r (irregex-match-substring match 'r))
                     (g (irregex-match-substring match 'g))
                     (b (irregex-match-substring match 'b)))
                 (if (and r g b)
                     (let ((a (string->number (or a "ff") 16))
                           (r (string->number r 16))
                           (g (string->number g 16))
                           (b (string->number b 16)))
                       (printf "[POKE] ~a ~a: ~a ~a ~a ~a\n" x y a r g b)
                       (sdl2:render-draw-color-set! renderer (sdl2:make-color r g b a))
                       (sdl2:render-draw-point! renderer x y))
                     (begin
                       (printf "[PEEK] ~a ~a\n" x y)
                       ;; FIXME
                       (write-line (format "PX ~a ~a ff00ff" x y) o))))))
            (else
             (printf "[???] ~a\n" line)))
           ;; TODO: this should round-robin between clients, *then*
           ;; proceed with the lines of the original connection
           (if (< lines 100)
               (loop (add1 lines))
               (begin
                 (sdl2:render-present! renderer)
                 (loop 0))))))
     (when (and i o)
       (close-input-port i)
       (close-output-port o)))
    (sdl2:render-present! renderer)
    (loop)))