Commit 9b32e0f1 authored by CD's avatar CD

committing changes from Win Machine to prep for merge

parent b8a4fe10
......@@ -44,7 +44,7 @@
((and (stringp slot-value) (equalp (char slot-value 0) #\:))
(read-from-string (subseq slot-value 1)))
((numberp slot-value)
(cond
(cond
((and visual (member slot-symbol '(screen-x screen-y width height) :test 'equal))
(round slot-value))
((ratiop slot-value)
......@@ -53,7 +53,7 @@
(t slot-value)))
(defun parse->json-chunk (jsown-obj &key (visual nil))
(let* ((name (if (find "name" (jsown:keywords jsown-obj) :test #'equal)
(let* ((name (if (find "name" (jsown:keywords jsown-obj) :test #'equal)
(read-from-string (jsown:val jsown-obj "name"))
nil))
(typ (read-from-string (jsown:val jsown-obj "isa")))
......@@ -68,13 +68,13 @@
type-expression))
(defun json->chunkpairs (loc-chunks obj-chunks)
(pairlis (define-chunks-fct (mapcar (lambda (chunk) (parse->json-chunk chunk :visual t)) loc-chunks))
(pairlis (define-chunks-fct (mapcar (lambda (chunk) (parse->json-chunk chunk :visual t)) loc-chunks))
(define-chunks-fct (mapcar (lambda (chunk) (parse->json-chunk chunk :visual t)) obj-chunks))))
(defun json->chunkpair (loc-chunk obj-chunk)
(cons (first (define-chunks-fct (list (parse->json-chunk loc-chunk :visual t))))
(first (define-chunks-fct (list (parse->json-chunk obj-chunk :visual t))))))
(defun update-display-chunks (chunks)
(loop for chunk in chunks do
(let ((name (read-from-string (jsown:val chunk "name")))
......@@ -85,7 +85,7 @@
(set-chunk-slot-value-fct name slot-symbol slot-value))))))
(defmethod handle-event ((instance json-interface-module) model method params)
(cond
(cond
((string= method "disconnect")
(return-from handle-event t))
((string= method "trigger-event")
......@@ -107,14 +107,14 @@
(if (not (process-display-called (get-module :vision)))
(proc-display :clear (jsown:val params "clear")))))
((string= method "display-new")
(progn
(progn
(setf (display instance) (json->chunkpairs (jsown:val params "loc-chunks")
(jsown:val params "obj-chunks")))
(if (not (process-display-called (get-module :vision)))
(proc-display :clear t))))
((string= method "display-add")
(progn
(setf (display instance) (cons (json->chunkpair (jsown:val params "loc-chunk")
(setf (display instance) (cons (json->chunkpair (jsown:val params "loc-chunk")
(jsown:val params "obj-chunk"))
(display instance)))
(if (not (process-display-called (get-module :vision)))
......@@ -144,7 +144,7 @@
((string= method "new-other-sound")
(new-other-sound (jsown:val params "content") (jsown:val params "onset") (jsown:val params "delay") (jsown:val params "recode"))))
(return-from handle-event nil))
(defmethod read-stream ((instance json-interface-module))
(handler-case
(loop
......@@ -181,7 +181,7 @@
(defmethod send-command ((instance json-interface-module) method params &key sync)
(let ((mid (format nil "~a" (current-model))))
(bordeaux-threads:with-recursive-lock-held
(bordeaux-threads:with-recursive-lock-held
((sync-lock instance))
(progn
(setf (wait instance) t)
......@@ -273,7 +273,7 @@
(setf (read-from-stream instance) t)
(setf (thread instance) (bordeaux-threads:make-thread #'(lambda () (read-stream instance))))
(install-device instance))
(usocket:socket-error ()
(usocket:socket-error ()
(progn
(print-warning "Socket error")
(cleanup instance)
......@@ -297,7 +297,7 @@
(defun jni-register-event-hook (event hook)
(setf (gethash event (event-hooks (get-module json-network-interface))) hook))
(defun params-json-netstring-module (instance param)
(if (consp param)
(let ((hostname (jni-hostname instance))
......@@ -318,8 +318,8 @@
(:jni-sync (jni-sync instance)))))
(undefine-module jni)
(define-module-fct
'json-network-interface
(define-module-fct
'json-network-interface
nil
(list (define-parameter :jni-hostname
:documentation "The hostname/fqdn of the remote environment")
......
<ini>
<windowtop> 383 </windowtop>
<windowleft> 837 </windowleft>
<windowhigh> 302 </windowhigh>
<windowwide> 424 </windowwide>
<windowtop> 0 </windowtop>
<windowleft> 0 </windowleft>
<windowhigh> 364 </windowhigh>
<windowwide> 544 </windowwide>
<windowstate> 0 </windowstate>
<pipeinterval> 10 </pipeinterval>
<hidewindow> False </hidewindow>
......
......@@ -21,7 +21,7 @@
;;; Tested w/ CCL
;;; Should theoretically work with sbcl
;;; (*features* should be tested for all implementation specific functions)
;;; (*features* stil need to be tested for all implementation specific functions)
;;Thread library
......@@ -130,7 +130,7 @@ t)
(let ((currTime (get-universal-time)))
(handler-case
(while (and (not (probe-file solverOutputFile)) (< (- (get-universal-time) currTime) max-wait)))
(error (e) (print (concatenate 'string "124 phys" (write-to-string e))))))
(error (e) (print (concatenate 'string "Error on line 133 in Phys Module - " (write-to-string e))))))
;;If we didn't get the output file, go back and do this all over again
(when (not (probe-file solverOutputFile)) (go resetAdvance)))
......@@ -147,7 +147,6 @@ t)
(while (not (handler-case (delete-file solverOutputFile)
(error () nil))))
(go parseValList)))
;;Delete the output file after we've harvested those data
(while (probe-file solverOutputFile)
(handler-case
......@@ -286,7 +285,7 @@ t)
#+:ccl (ccl::cwd old-dir)
#+:sbcl (sb-posix:chdir old-dir)
;;Wait for the output file from starting HumMod, then delete it
;(while (not(probe-file solverOutputFile)))
(while (not(probe-file solverOutputFile)))
(handler-case (delete-file solverOutputFile) (error () nil))))
......@@ -392,7 +391,7 @@ t)
((or
#+:ccl ccl::simple-file-error
#+:sbcl sb-impl::simple-file-error
simple-error) () (format t "Error loading ICS file!~&")))
simple-error) (e) (format t "Error loading ICS file!~&" e)))
;;[NOT USED (Doesn't seem to be needed)] Clean up resulting output
#|(while (probe-file solverInputFile)) ;Wait for Model Solver to finish computation & output file
(let ((currTime (get-universal-time)))
......
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment