;; -*- Mode: LISP; Syntax: Common-Lisp; Package: (USER); -*-
;-----------------------------------------------------------
;
;  Motor.lisp
;  -contains Action Scheduler functions
;
; 'Ymir Agent System, 1995 
;
;  This file is meant to run on SPOT
;-----------------------------------------------------------

;  This file needs to be loaded before the Acts.lisp file
;  Acts.lisp loaded at end of this file.
;  Only load CLOS and this file for motor scheduler on Spot.

;NOTES 5/1 95:
; Debugged and finished class defs and make classes
; Debugged trace mechanism, except haven't finished find-best
; Still have to finish scheduler.
; Idea: make sub-classes for each of the face parts, like
; brows, mouth, gaze, and make find-best use the classes
; to figure out best path through the graph.

(in-package 'USER)
(proclaim '(optimize (compilation-speed 0)))

;INCLUDES

(unless (fboundp 'make-instance)
  (load "/mas/lib/ds/lisp/clos.mbin"))
(load "foreign2")
(load "my-net-io")
(load "Acts")

;------------------------------------------
; CLASS DEFINITIONS
;------------------------------------------

(defclass act ()
  ((name   :accessor name   :initarg :name   :initform nil)
   (pos    :accessor pos    :initarg :pos    :initform nil) ;only used in making out obj.
   (execution-time :accessor exec-time :initarg :exec-time :initform nil)))

(defclass motor (act)
  ((ctrlpt :accessor ctrlpt :initarg :ctrlpt :initform nil)
   ))

(defclass complex-act (act)
  ((acts :accessor acts :initarg :acts :initform nil)))

(defclass seq-act (complex-act)
  ())

(defclass par-act (complex-act)
  ())

(defclass out-act ()
  ((exec-time :accessor exec-time :initarg :exec-time :initform nil)
   (motors :accessor motors :initarg :motors :initform nil)))
  
(defclass seq-out-act (out-act)  ;executed in sequential steps
  ((start  :accessor start  :initarg :start  :initform nil)))
   ;this slot is initialized to now+interval-till-next-timeslice

(defclass par-out-act (out-act)  ;executed in one step
  ())


;face-object is used by select-option to determine which option
;should be selected when requests for actions come in.

(defclass face-object ()
  ; Each slot holds a tuple, first number is when started, second is how long it'll run.
  ; nil stands for "not busy"
  ((pupils :accessor pupils :initarg :pupils :initform nil)
   (l-brow :accessor l-brow :initarg :l-brow :initform nil)
   (r-brow :accessor r-brow :initarg :r-brow :initform nil)
   (l-eye  :accessor l-eye  :initarg :l-eye  :initform nil)
   (r-eye  :accessor r-eye  :initarg :r-eye  :initform nil)
   (mouth  :accessor mouth  :initarg :mouth  :initform nil)
   (head   :accessor head   :initarg :head   :initform nil)
   ))

(defvar face-object nil)

(defun make-face-object ()
  (setf face-object (make-instance 'face-object)))


;------------------------------------------
; MAKE FUNCTIONS
;------------------------------------------

(defun prepare-motors (node-list)
  (loop for (name class ctrlpt exec-t) in node-list
        collect `(defparameter ,name
                     (make-instance ',class
                                    :name ',name
                                    :ctrlpt ',ctrlpt
                                    :exec-time ',exec-t)))
  )

(defmacro make-motors (node-list)   ;send it the list 'motor-list'
  (let ((forms (prepare-motors (symbol-value node-list))))
    `(progn ,@forms)))

(defun prepare-acts (node-list)
  (loop for (name class acts) in node-list
        collect `(defparameter ,name
                     (make-instance ',class
                                    :name ',name
                                    :acts ',acts)))
  )
                                    
(defmacro make-acts (node-list)  ;send it the list 'act-list'
  (let ((forms (prepare-acts (symbol-value node-list))))
    `(progn ,@forms)))

(defun make-one-act (name class)
  (setf name (make-instance class)))

(defun make-action-lists ()
  (setf *motors* '())
  (setf *acts* '())
  ;Make a list containing objects.
  (make-motors motor-list)
  (make-acts act-list)
  (dolist (sub-list motor-list)    
    (setf *motors* 
	  (append *motors* (list (eval (first sub-list))))))
  (dolist (sub-list act-list)
    (setf *acts* 
	  (append *acts* (list (eval (first sub-list))))))
  )


;------- MAKE ALL --------


(defun make-all-objects ()
  (make-motors motor-list)
  (make-acts act-list)
  (make-face-object))


;------------------------------------------
; SCHEDULING FUNCTIONS
;------------------------------------------

;Note: put ready acts on a list with 
;"now" timestamp and when should be
;executed, i.e. now+x ms from now.

(defvar IN-BOX  '() "Incoming act commands.")
(defvar OUT-BOX '() "Outgoing, pending commands.")

(defun SCHEDULE ()
;  (loop
;   (if (listen *in-acts-socket*)    ;if list-of-incoming acts not empty
;       (read-in-socket))

; NB! IN-BOX is a list of lists containing a single symbol.
; It really should also contain where it came from (what layer initated act).   

   ;calculate, then put on list-of-pending-motor-cmnds
   ;if list-of-pending-motor-cmnds not empty
   ;execute: all reactive acts
   ;         then all dialogue acts
   ;         when no reactive or dialogue acts left,
   ;         all other acts
  (loop
   (update-face-object) 
   ))

(defun update-face-object ()
  "Makes sure that the face-object times are up to date."
  )

;(defun fake-schedule (act)
;  (push (top-node-act act) OUT-BOX)
;  (loop while OUT-BOX do
;	(print "out-box: ")(princ out-box)
;	(execute (pop OUT-BOX))	
;	)
;  )

;-------------------- ------
;------ Check options ------
;-------------------- ------

(defmethod More-than-one-option? ((in-act Par-Act))
  (if (> (length (acts in-act)) 1)
      T
    nil))

(defmethod More-than-one-option? ((in-act Seq-Act))
  (if (> (length (acts in-act)) 1)
      T
    nil))

;(defmethod More-than-one-option? ((in-act Seq-Act))
;  (let ((return-it nil))
;    (dolist (option (acts in-act))
;	    (if (> (length option) 1)
;		(setf return-it T)
;	      ))
;    ))

(defmethod More-than-one-option? ((in list))
  (if  (> (length in) 1)
      T
    nil))

#|
(defmethod num-options (in-act)
  (length (acts in-act)))
|#

(defmethod Motor-Level ((act Act))
  (let ((item (acts act)))
    (loop while (not (atom item)) do
	  (setf item (first item)))
    (if (eq (type-of (symbol-value item)) 'Motor)
	T
      nil))
  )

(defmethod Motor-Level ((act-or-options List))
  (let* ((item1 (copy-tree act-or-options))
	 (item2 nil))
    (loop until (atom item1) do
	  (setf item1 (first item1)))
    (setf item1 (symbol-value item1))
    (setf item2 (acts item1))
    (loop until (atom item2) do
	  (setf item2 (first item2)))
    (if (eq (type-of (symbol-value item2)) 'Motor)
	T
      nil)
    ))

;-----------------------------
;------- SELECT OPTION -------
;-----------------------------

(defmethod Select-Option ((options List))
  (print 'options>)(princ options)
  (print 'selecting>)(princ (first options))
  (first options))   ;compare options against face-object, then select

(defmethod any-options? ((options List))
  (if (> (length options) 1)
      T
    nil))


(defmethod Make-Object ((a-list list))
  (let* ((return nil)
	 (the-obj (copy-act (symbol-value (first a-list))))
	 (the-acts (acts the-obj))
	 (name (first a-list))
	 (pos  (second a-list))
	 (exec-t (third a-list)))
    (cond ((and (atom name)
		(not (eq (type-of the-obj) 'Motor)))
	   (progn
	     (setf return (make-instance (type-of the-obj)
					:acts the-acts
					:name name
					:pos  pos
					:exec-time exec-t))
	     (Copy-down-time return)
	     ))
	  (T
	   (setf return  (make-instance (type-of the-obj)
				       :name name
				       :pos  pos
				       :exec-time exec-t))
	   )
	  )  ;end cond
    return
    ))

(defmethod Copy-Act ((object Act))
  "Receive a global object, return a local copy of it."
  (make-instance (type-of object) 
		 :name (name object)
		 :pos  (pos  object) 
		 :exec-time (exec-time object)
		 :acts (copy-tree (acts object))
		 )
  )


(defmethod Motors? ((item list))
  (loop while (not (atom item)) do
	(setf item (first item)))
  (if (eq (type-of (symbol-value item)) 'Motor)
      T
    nil)
  )

(defmethod Fetch-the-Options ((in-act Act))
  (setf return-motors nil)
  (dolist (option (acts in-act))             ;option = list of 3-item lists
	  (dolist (item option)	             ;item = a single 3-item list
		  (if (motors? item)
		      (push (Fetch-the-Motors (Make-Object item)) return-motors)
		    (Get-Best (Make-Object item))
			  ))
	  )
  return-motors
  )
    
(defmethod Get-Best ((in-act symbol)) 
  "Called from the top func receiving the command over the socket."
  (setf O-list nil
	M-list nil)
  (Get-Best (copy-act (symbol-value in-act)))
  )

(defmethod Get-Best ((in-act Act))
  "Receives an act object, returns continually refined motor choices."
  (print 'get-best>)(print in-act)(princ (name in-act))(read-char)
  (if (More-than-one-option? in-act)
      (progn
	(Fetch-the-Options in-act)
	(print 'o-list-now>)(princ o-list)
	(setf O-list (Select-Option O-list))
	)
    (progn
      (setf M-list nil)
      (dolist (item (first (acts in-act)))
	      (print 'here>)(princ item)
	      (if (Motors? item)
		  (progn 
		    (print 'itsamotor)
		    (push item M-list)
		    (print M-list))
		(progn (print 'helloooo)(setf O-list  (Get-Best (Make-Object item)))
		       )
		)
	      )
      (push (list (reverse M-list)) O-list)
      )
    )
  O-list
  )
    

#|
      (dolist (option (acts in-act)) 
	      (print 'option>)(princ option)
	      (if (not (motor-level option))  
		  (dolist (item option)
			  (print 'item>)(princ item)
			  (Fetch-the-Options (Make-Object item))
			  )
		(progn
		  (print 'calling-fetch-motors>)
		  (Fetch-the-Motors in-act)
;	    (push (Fetch-the-Motors in-act) O-list)
;	    (setf O-list (Select-Option O-list))
		  )
		))
    (dolist (item (first (acts in-act)))
	    (print 'here>)(princ item)
	    (setf O-list (Get-Best (Make-Object item))))
;      (push (Fetch-the-Motors in-act) O-list)
;      (setf O-list (Select-Option O-list))
    )
  (setf O-list (Select-Option O-list))  ;get-options and get-motors fill in in-act with motors...
  )
|#

(defmethod Fetch-the-Motors ((in-act Act))
  "Receives an object that has no options below it & returns a list of motors."
  (setf	return  nil
	tmotors nil)
  (Get-Motors in-act)
  )

(defmethod Get-Motors ((in-act Seq-Act))
  (print in-act)(princ (name in-act))
  (if (More-than-one-option? in-act)
      (progn
	(print 'more)(describe in-act)
	(Fetch-the-Options in-act)
	)
    (progn
      (if (not (Motor-level in-act))
	  (dolist (option (acts in-act))
		  (dolist (item option)
			  (Get-Motors (Make-Object item))
			  ))
	(setf return (Get-Motors (acts in-act)))
	)
      (print 'return>)(princ return)
      return
      )
    ))


(defmethod Get-Motors ((in-act Par-Act))
  (print in-act)(princ (name in-act))
  (if (More-than-one-option? in-act)
      (progn
	(print 'more);(describe in-act)
	(Fetch-the-Options in-act)
	)
    (progn
      (if (not (Motor-level in-act))
	  (dolist (option (acts in-act))
		  (dolist (item option)
			  (Get-Motors (Make-Object item))
			  ))	      
	(setf return (Get-Motors (acts in-act)))
	)
      (print 'return>)(princ return)
      return
      )
    ))


(defmethod Get-Motors ((in-act list))
  (setf tmotors (append tmotors (list in-act))))

(defmethod Find-Biggest ((in-list List))
  "Receives a list of options, returns longest exec time."
  (let ((item nil)
	(sub-item nil)
	(the-list nil))
    (loop while in-list do
	  (print 'in-list>)(princ in-list)
	  (setf item (pop in-list))            ;option
	  (loop while item do                  
		(setf sub-item (first item))
		(push (third sub-item) the-list)
		(pop item)
		(print the-list)
		)
	  )
    (find-highest the-list)
    ))

(defmethod calc-par-scalar ((option list) e-time)
  "Receives an option, returns a number to scale exec-times with."
  (let ((item nil)
	(the-list nil))
    (loop while option do
	  (setf item (pop option))          
	  (push (third item) the-list)
	  (pop item)
;	  (print the-list)
	  )	  
    (/ e-time (find-highest the-list))
    ))

(defmethod calc-seq-scalar ((option list) e-time)
  (/ e-time 10))


(defmethod copy-down-time ((action Par-Act))
  "Sets the time for every item in the action's options, returns action modified."
  (let ((e-time (exec-time action))
	(scalar nil))
    (if (listp (first (first (acts action))))  ;if not motor level
	(dolist (option (acts action))               ;time from above affects all options
		(setf scalar (calc-par-scalar option e-time))
		(dolist (item option)                ;and all elements of each option
			(setf (third item) (* (third item) scalar)))
		)
      (dolist (item (acts action))
	      (print 'hello)  ;does it ever get to here?
	      (setf (third item) e-time))
      )
;    (print 'copy-time)(princ (acts action))
    action
    ))

(defmethod copy-down-time ((action Seq-Act))
  "Sets the time for every item in the action's options, returns action modified."
  (let ((t-time (exec-time action))
	(e-time nil)
	(scalar nil))
    (if (listp (first (first (acts action))))        ;<-if not motor level
	(dolist (option (acts action))               ;time "from above" affects all options
		(setf e-time (round (/ t-time (length option))))
		(setf scalar (calc-seq-scalar option e-time))
		(dolist (item option)                ;and all elements of each option
			(setf (third item) (* (third item) scalar)))
		)
      (dolist (item (acts action))    
	      (print 'hello)  ;does it ever get to here?
	      (setf (third item) e-time))            ;<-do this if motor level
      )
;    (print 'copy-time-seq)(princ (acts action))
    action
    ))

(defmethod copy-down-time ((action Motor))
  action)



;------ Calculate -----

(defmethod calc-exec-time ((action Par-Act))
  (let ((time-list nil))
    (dolist (sub-act (acts action))
	    (push (third sub-act) time-list))
    (find-highest time-list)
    ))

(defmethod calc-exec-time ((action Seq-Act))
  "Receives an object with options, returns a."
  (let ((estim-time 0))
    (dolist (option (acts action))
	    (dolist (sub-act act)
		    (setf estim-time (+ estim-time (third sub-act))))
	    estim-time)
    ))

(defmethod calc-par-time ((action List) e-time)
 ;Receives an action option and returns its exec time.
 ;Simply take the longest of the acts
  (let ((time-list nil))
    (dolist (sub-act action)
      (setf time-list (push (third sub-act) time-list)))
    (print 'par-time>)(print (find-highest time-list))
    (round (/ (find-highest time-list) e-time))
  ))

(defmethod calc-seq-time ((action List) e-time)
 ;Receives an action option and returns its exec time.
 ;Simply add the time of all the acts
  (let ((estim-time 0))
    (dolist (sub-act action)
      (setf estim-time (+ estim-time (third sub-act))))
    (print 'seq-estim-time>)(print estim-time)
    (/ estim-time e-time)
  ))

(defun find-highest (a-list)
  (let ((old (first a-list)))
    (dolist (x a-list)
      (if (> x old) (setf old x)))
    old))


;---------------------
;------ Execute ------
;---------------------


(defmethod EXECUTE ((action list))
  (dolist (item action)
    (execute item)))

(defmethod EXECUTE ((action act))
  (dolist (item (acts action))
	  (if (listp item)
	      (dolist (motor item)
		      (execute (pop item)))
	    (execute item)))
  )

(defmethod EXECUTE ((motor Motor))
  (motor-output (ctrlpt motor) (pos motor) (exec-time motor)))



;------------------------------------------
;
;              INPUT SOCKET
;
;------------------------------------------

(defvar act-in-socket-# 1999)
(defvar act-in-socket-status nil)
(defvar *in-acts-socket* nil)

(defun open-act-in-socket ()
  "Open the IN socket for receiving acts from the Alpha."
  (setf IN-BOX nil) ;empty buffer...
  (terpri)(princ "Setting up connection to Dialogue System.")
  (terpri)(princ "Waiting for connection on socket #")
  (princ act-in-socket-#)(princ " ......")
  (if
      (and (setf *in-acts-socket*
                 (wait-for-socket act-in-socket-#))
           (numberp *in-acts-socket*))
      (progn 
        (terpri)(princ "Connected to Dialogue System.")
        (setf act-in-sock-status t))
    (progn
      (print "Error (open-act-socket): Dialogue System connection did not open!")
      (print *in-acts-socket*))) ;In which case this is an error message.
  *in-acts-socket*
  )

(defun close-act-in-socket ()
  (close-socket *in-acts-socket*)
  (setf act-in-sock-status nil))

(defun sched-socket-status ()
  (terpri)
  (princ "act-socket-#: ")(princ act-socket-#)
  (terpri)
  (princ "*in-act-socket*: ")
  (if act-sock-status (princ " (apparently open).")
    (princ " (apparently closed)."))
  (terpri)
  (princ "animation-socket-#: ")(princ animation-socket-#)
  (terpri)
  )

;------------------------
;------ Read Input ------
;------------------------
   
(defun read-act-socket ()
  "Read all data available in act socket and store in a buffer."
  (let ((in (receive-line-no-hang *in-acts-socket*)))
    (if in (push (read-from-string in)
                 IN-BOX))  ;Fill buffer up with the newest info.
    ))
   

;-------------------------------------------------
;
;          FACE OUTPUT SOCKET CONNECTION
;
;-------------------------------------------------


(defvar face-socket# 4000)
(setf   face-socket# 4000)
(defvar face-cmnd-sock# 4050)
(setf   face-cmnd-sock# 4050)
(defvar face-stream nil)
(defvar face-host-name "splotch")

(defun summon-gandalf ()
  (startup-face)
  (sleep 3)
  (open-com-sock)
  (close-socket face-startup-stream))

(defun startup-face ()
  "Open connection to face animation subsystem."
  (terpri) (princ "Calling FACE program. Socket: ")  (princ face-socket#)
  (if (numberp (setf face-startup-stream (open-socket face-host-name face-socket#)))
      (progn
        (terpri)
        (princ "Connected to ")(princ face-host-name)(princ " on above port.")
	(terpri)(princ "Stream #: ") face-startup-stream
        ) 
    (progn
      (print "Error in face-anim-sock, connection to FACE not made.")
      face-startup-stream)
    )
  )

(defun close-face ()
  (close-face-stream))

(defun open-com-sock ()
  (open-face-cmnd-sock))

(defun open-face-cmnd-sock ()
  "Open connection to face animation subsystem."
  (terpri) (princ "Calling command socket for ToonFace. Socket: ")  (princ face-cmnd-sock#)
  (if (numberp (setf face-stream (open-socket face-host-name face-cmnd-sock#)))
      (progn
        (terpri)
        (princ "Connected to ")(princ face-host-name)(princ " on above port.")
	(terpri)(princ "Stream #: ") face-stream
	)
    (progn
      (print "Error in face-anim-sock, connection to FACE not made.")
      face-stream)
    )
  )

(defun close-face-sock ()
  (close-socket face-stream)
  (close-socket face-startup-stream))

(defun close-face-stream ()
  (close-face-sock))

(defun manual-socket (socket-num)
  (setf face-stream (open-socket "splotch" socket-num))
  )

;------------------------------------------
; MOTOR OUTPUT
;------------------------------------------


; Dimension
(defconstant horiz 0)
(defconstant verti 1)
; Start and stop codes
(defvar start 9998)
(defvar stop  9999)
(defvar QUIT  9997)


(defun out (a b c)
  (motor-output a b c))

(defun speak (utter)
  (motor-output 0 utter nil))

(defun MOTOR-OUTPUT (ctrlpt pos time)
  (if (eq ctrlpt 0)       ;if speech
      (let ((words pos)
	    (string nil)
	    (f-stream face-stream))
	(setf string (format nil "~A ~A ~A ~A"
			     start ctrlpt words #\newline))
	(transmit-buf f-stream string))
    (let ((dir verti)
	  (string nil)
	  (f-stream face-stream))
      (if (> ctrlpt 50)
	  (progn
	    (if (oddp ctrlpt)(setf dir horiz))
	    (setf ctrlpt (round (* ctrlpt 0.1)))))
   ;   (write start :stream *standard-output*)
   ;   (write ctrlpt :stream *standard-output*)
   ;   (write pos :stream *standard-output*)
   ;   (write dir :stream *standard-output*)
   ;   (write time :stream *standard-output*)
   ;   (write stop :stream *standard-output*)
      (progn
	(setf string (format nil "~A ~A ~A ~A ~A ~A ~A"
			     start ctrlpt pos dir time stop #\newline))
	(transmit-buf f-stream string))
      ))
  )


;(defun write-output (num) 

;(defun write-output (num stream)
;  (if (> num 255)
;      (progn
;	(transmit-buf stream (stringnum)))
;    (progn
;      (transmit-buf stream num))
;    )

;        (setf first-byte (ldb (byte 8 0) num)
;              num (ldb (byte 16 8) num))
;        (transmit-buf num stream)
;	(transmit-buf first-byte :stream stream))


;    )
;      (write 0 :stream stream)
;      (write num :stream stream))
  


;--------------------------------------------------
;
;                   TIME STAMPS
;
;--------------------------------------------------


(defvar *time-offset* 0 "Maintains diff. betw. speech and local clock.")

(defun time-stamp ()
  (reactive-time-base))

(defun reactive-time-base ()
  "Returns time in hundreds of seconds (centiceconds)."
  (-  (round (/ (get-internal-real-time) 
		(/ internal-time-units-per-second 100)))
      *time-offset*)) ;This is subtracted to synchronize to speech & body.


;;_______________________________
;; TIME SERVER SYNCHRONIZATION
;;-------------------------------

(defvar splotch-time-sock# 7766)
;(defvar spud-time-sock# xxxxx)

;Make sure the timeserv process is running on the machine called:
; 29/5/95: The modified timeserver is /ahi/timeserver/timeserv2
; To run: splotch> /ahi/timeserver/timeserv2 > /dev/null &
; To kill: su@splotch> ps -efa, then kill #


(defun synchronize (host-name host-port)
  (let ((sock (open-socket "splotch" splotch-time-sock#))
        (time-offset nil)
        (local-time nil)
        (time-in nil)
        (mark nil))     ;A time marker to notify client mach. of timegrab.
    (setf *sock* sock)    
    (if sock
        (progn
          (terpri)(princ "SYNCHRONIZING")
          (terpri)(princ "Asking for time ...")
          (bytes-to-stream "cent" sock)
          (loop while (not (receive-char-no-hang sock)))  ;loop until host sends "mark" ... and then
          (setf local-time (time-stamp))                  ;read this as soon as that one returns.
          (setf mark (read-bytes sock 1))
          (setf time-in (read-from-string (read-line sock)))
          (terpri)(princ "Local time:     ")(princ local-time)
          (terpri)(princ "Time from host: ")(princ time-in)
          (setf time-offset (- local-time time-in))
          (if time-offset
	      (progn
	        (terpri)(princ "Time offset:    ")(princ time-offset)
                (print 'CLOSING)
             ;   (bytes-to-stream "bye " sock)
		(close-time-sock sock))
	    (princ "Time offset not read correctly.")))
      (princ "TIME port did not open. Make sure timeserv is running."))
    (setf *time-offset* time-offset))
  )

(defun sync ()
  (synchronize "splotch" splotch-time-sock#))
 
(defun close-time-sock (sock)
  (bytes-to-stream "bye " sock)
  (close-socket sock)
  (terpri)(princ "Time socket closed."))

(defun bytes-to-stream (what f-stream)
  (transmit-buf f-stream string)
  )



;--------------- DEBUG STUFF -------------

(defmethod describe-motors ((act act))
  (dolist (the-motor-list (acts act))
	  (dolist (motor the-motor-list)
		  (describe motor)))
  )



;--------------- OLDER STUFF -------------

#|
(defmethod Make-par-obj-list (options e-time) ;a list of options
					;"Receives options, scales times, returns a list of objects with times."
  (let ((new-list nil)
        (option-list nil)
        (scalar nil))
    (dolist (option options) 
	    (setf new-list nil)
	    (print 'option>>)(princ option)
	    (setf scalar (calc-par-time option e-time))
	    (dolist (item option)
		    (print 'item?)(princ item)
		    (push (make-item (symbol-value (first item)) 
				     (second item)
				     e-time scalar) new-list)
		    (print 'par-made-item>) (describe (first new-list)))
	    (push new-list option-list))
    option-list)
  )

(defmethod Make-seq-obj-list (act-list e-time) ;a list of options
					;"Receives act-list, scales times, returns a list of objects with times."
  (print 'here-it-is>)(princ act-list)(princ e-time)
  (let ((new-obj nil)
        (option-list nil)
        (scalar nil))
    (dolist (action act-list) 
	    (setf new-obj (symbol-value (first action)))
	    (if (not (eq (type-of new-obj) 'Motor))
		(progn
		  (setf scalar (calc-seq-time (acts new-obj) e-time))
		  (push (make-item new-obj 
				   (second item) 
				   e-time scalar) new-list)
		  (print 'seq-made-item>) (describe (first new-list))
		  (push new-obj option-list)
		  (push new-list option-list))
	      option-list)
	    )
    ))

(defmethod make-item ((item Par-Act) pos the-time scalar)
  (make-instance (type-of item)
                 :acts (acts item)
                 :pos pos
		 :exec-time (round (* the-time scalar)))
  )

(defmethod make-item ((item Seq-Act) pos the-time scalar)
  (make-instance (type-of item)
                 :acts (acts item)
                 :pos pos
		 :exec-time  (round (* the-time scalar)))
  )

(defmethod make-item ((item Motor) pos the-time scalar)
  (make-instance (type-of item)
                 :name (name item)
                 :pos pos
                 :ctrlpt (ctrlpt item)
		 :exec-time (round (* the-time scalar)))
  )
|#

#| old versions

(defmethod find-best-act ((new-list list))
  ;"Receive list of options [as objects] and select best."
  ;For now just take the first one.....
  (first new-list))


(defmethod Strip-Act ((in-act Par-Act) (next-acts list))
  ;"Receives options, selects, and returns when motor level is reached."
  (let ((best-act nil)
        (new-next-acts nil)
        (obj-list nil)
	(e-time (exec-time in-act)))
    (setf obj-list (Make-par-obj-list next-acts e-time))
    (if (not (eq (type-of (first obj-list)) 'Motor))
        (progn
          (setf best-act (find-best-act obj-list))
          (dolist (item best-act)
            (dolist (act (acts item))
	      (push act new-next-acts)))
          (Strip-Act (first best-act) new-next-acts))
;      (print 'obj-list>)(princ obj-list)
      obj-list)
    ))

(defmethod Strip-Act ((in-act Seq-Act) (next-acts list))
  ;"Receives options, selects, and returns when motor level is reached."
  (let ((best-act nil)
        (new-next-acts nil)
        (obj-list nil)
	(e-time (exec-time in-act)))
    (setf obj-list (Make-seq-obj-list next-acts))               ;collect all options
    (if (not (eq (type-of (first best-act)) 'Motor))    ;if not motor level
        (progn                 
          (setf best-act (find-best-act obj-list))              ;find best of options
          (dolist (item best-act)
;            (print 'hello)(print item)
            (dolist (act (acts item))
	      (push act new-next-acts)))
          (Strip-Act (first best-act) new-next-acts))
;      (print 'obj-list>)(princ obj-list)
      obj-list)
    ))

(defmethod Strip-Act ((in-act Motor) (next-acts list))
  ;"Last in the chain; return the motor list option."
  next-acts)
|#

#|
;----------- HARLEQUIN STYLE ---------------
(defun open-face-sock ()
  (setf face-stream 		      
        (comm:open-tcp-stream "splotch" face-socket#
			      :element-type '(unsigned-byte 8)))
  )

(defun close-face-stream ()
  (close face-stream))
|#


;---------- HARLEQUIN STYLE ---------------
#|
(defun MOTOR-OUTPUT (ctrlpt pos time)

      (progn

	(let ((dir verti))
	  (if (> ctrlpt 50)
	      (progn
		(if (oddp ctrlpt)(setf dir horiz))
          (setf ctrlpt (round (* ctrlpt 0.1)))))
;    (write startcode :stream *standard-output*)
;    (write ctrlpt :stream *standard-output*)
;    (write pos :stream *standard-output*)
;    (write dir :stream *standard-output*)
;    (write time :stream *standard-output*)
;    (write stopcode :stream *standard-output*)
    (if (streamp anim-stream)
        (progn
          (write-output start anim-stream)
          (write-output ctrlpt anim-stream)
          (write-output pos anim-stream)
          (write-output dir anim-stream)
          (write-output time anim-stream)
          (write-output stop anim-stream)
          (finish-output anim-stream))
      (report "anim-stream not been opened?" nil)
      ))
  )

(defun write-output (num stream)
  (if (> num 255)
      (progn
        (setf first-byte (ldb (byte 8 0) num)
              num (ldb (byte 16 8) num))
        (write-byte num stream)
	(write-byte first-byte stream))
    (progn
      (write-byte 0 stream)
      (write-byte num stream))
    ))
|#