jon

#lang scheme

;; The RFC for IRC
;; http://rfc.sunsite.dk/rfc/rfc2812.html

(define-struct Connection (input output))

(define (join vars between)
  (if (null? vars)
    ""
    (let loop ((vars (cdr vars))
	       (all (car vars)))
      (cond
	((null? vars) all)
	((null? (cdr vars))
	 (string-append all between (car vars)))
	(else
	  (loop (cdr vars)
		(string-append all between (car vars))))))))

(provide nick-message)
(define (nick-message name)
  (format "NICK ~a\r\n" name))

(provide user-message)
(define (user-message name real-name)
  (format "USER ~a 0 * :~a\r\n" name real-name))

(provide chat-message)
(define (chat-message channel message)
  (format "PRIVMSG ~a :~a\r\n" channel message))

(provide join-channel-message)
(define (join-channel-message . channels)
  (format "JOIN ~a\r\n" (join channels ",")))

(provide quit-message)
(define (quit-message)
  (format "QUIT\r\n"))

(define (read-message port)
  (let loop ((chars '())
	     (last #\x))
    (let ((next (read-char port)))
      (if (or (eof-object? next)
	      (and (char=? #\return last)
		   (char=? #\newline next)))
	(apply string-append "" (map string (reverse (cdr chars))))
	(loop (cons next chars) next)))))

(define (log* str . v)
  (apply printf str v))

(define (read-server input)
  ;; (let loop ((can-read? (char-ready? input)))
  (let loop ((can-read? (char-ready? input)))
    (when can-read?
      (log* "Read another message..\n")
      (let ((ok (read-message input)))
	(log* "Got '~a'\n" ok))
      (loop (char-ready? input)))))

(provide send-message)
(define (send-message connection message)
  (log* "Sending message ~a\n" message)
  (display message (Connection-output connection))
  (flush-output (Connection-output connection))
  (read-server (Connection-input connection)))

(provide connect)
(define (connect server-name)
  (printf "Connecting to irc server ~a\n" server-name)
  (let-values (((input output)
		(tcp-connect server-name 6667)))
    (let ((c (make-Connection input output)))
      (read-server (Connection-input c))
      c)))