;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;;        ABSTRACT: Lisp Interface Functions for KAPI stuff                ;;;
;;;                  for the functions in kapi.h/c                          ;;;
;;;    The functions implemented are KConnect, KDisconnect, KSendString,    ;;;
;;;  KGetString, KGetString_Or_Wait, KSendList, KGetList, KGetList_Or_Wait  ;;;
;;;                                                                         ;;;
;;;        Created by Siva Panchanatham on Sun 7, March '93  -  14:13:34    ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(IN-PACKAGE "COM")

;;; MALLOC for allocating space for strings to be used in foreign functions ;;;

(defun malloc-foreign-string (str)
  (check-type str string)
  (let ((str-type (list ':pointer 
			(list ':array ':character(list (+ 1 (length str)))))))
    (let ((f-str (malloc-foreign-pointer :type str-type)))
      (setf (foreign-string-value f-str) str)
      (setf (foreign-pointer-type f-str) '(:pointer :character))
      (setf (foreign-string-value f-str) str)
      f-str)))



;;;; Lisp KCONNECT ;;;;

(def-foreign-function (LFI-KConnect (:return-type :fixnum)
				    (:language :c)
				    (:name "_KConnect"))
  (mbhost (:pointer :character))
  (mbport :fixnum)
  (myname (:pointer :character)))

(defun Lisp-KConnect (host port name)
  (LET* ((phost (malloc-foreign-string host))
	 (pname (malloc-foreign-string name))
	 (retval nil))
    (SETF retval (LFI-KConnect phost port pname))
    (free-foreign-pointer phost)
    (free-foreign-pointer pname)
    retval))



;;;; LISP KDISCONNECT ;;;;


(def-foreign-function (LFI-KDisconnect (:return-type :fixnum)
				       (:language :c)
				       (:name "_KDisconnect")))


(defun Lisp-KDisconnect ()
  (LFI-KDisconnect))



;;;; LISP KSENDSTRING ;;;;

(def-foreign-function (LFI-KSendString (:return-type :fixnum)
				       (:language :c)
				       (:name "_KSendString"))
  (message (:pointer :character))
  (whom (:pointer :character)))


(defun Lisp-KSendString (msg whom)
  (LET* ((pmsg (malloc-foreign-string msg))
	 (pwhom (malloc-foreign-string whom))
	 (retval nil))
    (SETF retval (LFI-KSendString pmsg pwhom))
    (free-foreign-pointer pmsg)
    (free-foreign-pointer pwhom)
    retval))



;;;; LISP KGETSTRING ;;;;

(def-foreign-function (LFI-KGetString (:return-type (:pointer :character))
				      (:language :c)
				      (:name "_KGetString"))
  (whom (:pointer :character))
  (str (:pointer (:array :character(4096)))))


(defun Lisp-KGetString (whom)
  (LET* ((pstr (malloc-foreign-pointer 
		:type '(:pointer (:array :character(4096)))))
	 (pwhom (malloc-foreign-string whom))
	 (retval nil))
    (SETF retval (foreign-string-value 
		  (LFI-KGetString pwhom pstr)))
    (free-foreign-pointer pwhom)
    (free-foreign-pointer pstr)
    retval))



;;;; LISP KGETSTRING_OR_WAIT ;;;;

(def-foreign-function (LFI-KGetString-Or-Wait
		       (:return-type (:pointer :character))
		       (:language :c)
		       (:name "_KGetString_or_Wait"))
  (whom (:pointer :character))
  (str (:pointer (:array :character(4096)))))

(defun Lisp-KGetString-Or-Wait (whom)
  (LET* ((pstr (malloc-foreign-pointer 
  		:type '(:pointer (:array :character(4096)))))
	 (pwhom (malloc-foreign-string whom))
	 (retval nil))
    (SETF retval (foreign-string-value 
		  (LFI-KGetString-Or-Wait pwhom pstr)))
    (free-foreign-pointer pwhom)
    (free-foreign-pointer pstr)
    retval))



;;; LISP YP-KGETSTRING_OR_WAIT ;;;;

(defun YP-KGetString-Or-Wait (whom)
  (LET* ((pstr (malloc-foreign-pointer 
		:type '(:pointer (:array :character(4096)))))
	 (pwhom (malloc-foreign-string whom))
	 (retval nil))
    (SETF retval (list 
		  (foreign-string-value 
		   (LFI-KGetString-Or-Wait pwhom pstr))
		  (foreign-string-value pwhom)))
    (free-foreign-pointer pwhom)
    (free-foreign-pointer pstr)
    retval))



;;;; LISP KSENDLIST ;;;;

(defun Lisp-KSendList (l-list whom)
  (LET ((l-str (FORMAT NIL "~s" l-list)))
    (Lisp-KSendString l-str whom)))



;;;; LISP KGETLIST ;;;;

(defun Lisp-KGetList (whom)
  (Read-From-String (Lisp-KGetString whom)))



;;;; LISP KGETLIST-OR-WAIT ;;;;
    
(defun Lisp-KGetList-Or-Wait (whom)
  (Read-From-String (Lisp-KGetString-Or-Wait whom)))