;;; -*- Mode:LISP; Package:(TUBE GLOBAL); Base:10 -*-

;;; TUBES ARE BIDRECTIONAL COMMUNICATIONS STREAMS. YOU CAN TALK
;;; IN ONE END AND LISTEN ON THE OTHER. AKA TIN-CAN TELEPHONE.

(DEFVAR *REMOTE-TUBES* NIL)

(ADD-INITIALIZATION "TUBE"
		    '(PROCESS-RUN-FUNCTION "TUBE SERVER" 'SETUP-REMOTE-TUBE)
		    NIL
		    'CHAOS:SERVER-ALIST)

(defvar *remote-TUBE-unique-check-p* t)

(DEFUN SETUP-REMOTE-TUBE (&AUX STREAM CONN PKT ST N)
  (SETQ STREAM (CHAOS:OPEN-STREAM NIL "TUBE"))
  (SETQ CONN (SEND STREAM :CONNECTION))
  (SETQ PKT (CHAOS:CONN-READ-PKTS CONN))
  (COND ((NULL PKT)
	 (CHAOS:REJECT CONN "INTERNAL ERROR"))
	((NOT (SETQ N (STRING-SEARCH-CHAR #\SPACE (SETQ ST (CHAOS:PKT-STRING PKT)))))
	 (CHAOS:REJECT CONN "NO TUBE NAME GIVEN"))
	((and (GET-REMOTE-TUBE (SETQ ST (string-trim " " (SUBSTRING ST N))))
	      *remote-TUBE-unique-check-p*)
	 (CHAOS:REJECT CONN "Already have a TUBE by that name here"))
	('ELSE
	 (PUSH (LIST ST STREAM) *REMOTE-TUBES*)
	 (CHAOS:ACCEPT CONN))))


(DEFUN GET-REMOTE-TUBE (NAME)
  (if *remote-TUBE-unique-check-p*
      (CADR (ASS #'STRING-EQUAL NAME *REMOTE-TUBES*))
    (VALUES-LIST (MAPCAR #'CADR (SUBSET #'(LAMBDA (X) (STRING-EQUAL (CAR X) NAME)) *REMOTE-TUBES*)))))
					    

(DEFVAR *LOCAL-TUBES* NIL)

(DEFUN OPEN-TUBE (HOST NAME)
  (CHECK-TYPE NAME STRING)
  (LET ((S (IF (EQ SI:LOCAL-HOST (SI:PARSE-HOST HOST))
	       (OPEN-TUBE-TO-SELF NAME)
	     (CHAOS:OPEN-STREAM HOST (STRING-APPEND "TUBE " NAME)))))
    (PUSH (LIST HOST NAME S) *LOCAL-TUBES*)
    S))

(DEFFLAVOR LOCAL-TUBE
	   (INPUT-IO-BUFFER
	    (UNTYI-CHAR NIL)
	    OUTPUT-IO-BUFFER)
	   ()
  :INITABLE-INSTANCE-VARIABLES)

(DEFUN MAKE-LOCAL-TUBE ()
  (LET ((I (TV:MAKE-IO-BUFFER 100))
	(O (TV:MAKE-IO-BUFFER 100)))
    (VALUES (MAKE-INSTANCE 'LOCAL-TUBE
			   :INPUT-IO-BUFFER I
			   :OUTPUT-IO-BUFFER O)
	    (MAKE-INSTANCE 'LOCAL-TUBE
			   :INPUT-IO-BUFFER O
			   :OUTPUT-IO-BUFFER I))))


(DEFMETHOD (LOCAL-TUBE :TYI) ()
  (COND (UNTYI-CHAR
	 (PROG1 UNTYI-CHAR (SETQ UNTYI-CHAR NIL)))
	('ELSE
	 (TV:IO-BUFFER-GET INPUT-IO-BUFFER))))

(DEFMETHOD (LOCAL-TUBE :TYI-NO-HANG) ()
  (COND (UNTYI-CHAR
	 (PROG1 UNTYI-CHAR (SETQ UNTYI-CHAR NIL)))
	('ELSE
	 (TV:IO-BUFFER-GET INPUT-IO-BUFFER T))))

(DEFMETHOD (LOCAL-TUBE :UNTYI) (C)
  (SETQ UNTYI-CHAR C))

(DEFMETHOD (LOCAL-TUBE :TYO) (C)
  (TV:IO-BUFFER-PUT OUTPUT-IO-BUFFER C))

(DEFMETHOD (LOCAL-TUBE :STRING-OUT) (&OPTIONAL ARG1 &REST ARGS)
  (STREAM-DEFAULT-HANDLER SELF :STRING-OUT ARG1 ARGS))

(DEFUN OPEN-TUBE-TO-SELF (NAME)
  (IF (AND *remote-TUBE-unique-check-p*
	   (GET-REMOTE-TUBE NAME))
      (FERROR NIL "Already have a TUBE by that name"))
  (MULTIPLE-VALUE-BIND (A B)
      (MAKE-LOCAL-TUBE)
    (PUSH (LIST NAME B) *REMOTE-TUBES*)
    A))


(COMPILE-FLAVOR-METHODS LOCAL-TUBE)