samer@0: (display "loading shell.silk\n")
samer@0: 
samer@0: (import "samer.core.*")
samer@0: (import "samer.core.types.*")
samer@0: (import "samer.silk.*")
samer@0: 
samer@0: (define true #t)
samer@0: (define false #f)
samer@0: 
samer@0: 
samer@0: (define (for-it proc it)
samer@0: 	(if (.hasNext it)
samer@0: 		(begin
samer@0: 			(proc (.next it))
samer@0: 			(for-it proc it))))
samer@0: 
samer@0: 
samer@0: ;;; directory handling
samer@0: 
samer@0: (define (abs-path path) (.getCanonicalPath (java.io.File. path)))
samer@0: (define (pwd) (abs-path "."))
samer@0: ;(define .. "..")
samer@0: (define (cd dir)
samer@0: 	(System.setProperty "user.dir" (abs-path dir))
samer@0: 	(System.getProperty "user.dir"))
samer@0: (define (ls . paths)
samer@0: 	(array->list (.listFiles (java.io.File.
samer@0: 		(if (null? paths) "." (first paths))
samer@0: 	))))
samer@0: 
samer@0: (define (filter p? l) (reverse (filter-rev p? l ())))
samer@0: (define (filter-rev p? l a)
samer@0: 	(if (null? l) a
samer@0: 		(let ((h (car l)) (t (cdr l)))
samer@0: 			(if (p? h)
samer@0: 				(filter-rev p? t (cons h a))
samer@0: 				(filter-rev p? t a)))))
samer@0: 
samer@0: (define push Shell.push)
samer@0: (define pop Shell.pop)
samer@0: (define env Shell.env)
samer@0: (define cat string-append)
samer@0: 
samer@0: (define (pr-env)
samer@0: 	(for-it
samer@0: 		(lambda (b)
samer@0: 			(display (.name b))
samer@0: 			(display "=")
samer@0: 			(write (.get b X.ObjectCodec$ null))
samer@0: 			(display "\n"))
samer@0: 		(.data (Shell.env))))
samer@0: 
samer@0: 
samer@0: (define (vbls) (.getViewables (get "ViewableManager")))
samer@0: (define (pr-vbls)
samer@0: 	(for-it
samer@0: 		(lambda (v)
samer@0: 			(display (.toString (.getNode v)))
samer@0: 			(newline))
samer@0: 		(vbls)))
samer@0: 
samer@0: (define (it->list it)
samer@0: 	(define (accum it list)
samer@0: 		(if (not (.hasNext it))
samer@0: 			list
samer@0: 			(accum it (cons (.next it) list))))
samer@0: 	(reverse (accum it ())))
samer@0: 
samer@0: (define (view-vector L name)
samer@0: 	(Shell.expose (javax.swing.JScrollPane. (javax.swing.JList. L)) name)
samer@0: 	null)
samer@0: 
samer@0: (define (view-list L name) (view-vector (list->vector L) name))
samer@0: 
samer@0: (define (print l)
samer@0: 	(define (print-list l n)
samer@0: 		(if (null? l)
samer@0: 			(newline)
samer@0: 			(begin
samer@0: 				(display (cat (number->string n) ": " (first l)))
samer@0: 				(newline)
samer@0: 				(print-list (rest l) (+ n 1)))))
samer@0: 	(if (list? l)
samer@0: 		(print-list l 0)
samer@0: 		(if (vector? l)
samer@0: 			(print (vector->list l))
samer@0: 			(begin (display l) (newline))
samer@0: 		)
samer@0: 	)
samer@0: )
samer@0: 
samer@0: ;;; ------------ some macros ------------
samer@0: 
samer@0: (define node (macro (name . body)
samer@0: 	`(begin
samer@0: 		(Shell.push ,name)
samer@0: 		(let ((a
samer@0: 			(tryCatch
samer@0: 				(begin . ,body)
samer@0: 				(lambda (ex) (Shell.pop) (throw ex)))))
samer@0: 			(Shell.pop)
samer@0: 			a))))
samer@0: 
samer@0: ; ; (define node (macro (name . body)
samer@0: ; ; 	`(let*	(	(a (Shell.push ,name))
samer@0: ; ; 					(b (begin . ,body))		)
samer@0: ; ; 		(Shell.pop) b
samer@0: ; ; 	))
samer@0: ; ; )
samer@0: 
samer@0: ;;; this creates a named node as a child of (.getNode parent)
samer@0: (define (child parent name) (Node. name (.getNode parent)))
samer@0: 
samer@0: ;;; alternative version
samer@0: ;(define node (macro (name . body)
samer@0: ;	`(Shell.push ,name)
samer@0: ;	`(let ((b (begin . ,body)))
samer@0: ;		(Shell.pop) b)
samer@0: ;))
samer@0: 
samer@0: (define observer (macro body `(samer.silk.SilkObserver. (lambda (o a) ,@body))))
samer@0: (define on-change (macro (o . body)
samer@0: 	`(.addObserver ,o (samer.silk.SilkObserver. (lambda (o a) ,@body)))
samer@0: ))
samer@0: 
samer@0: ;;; ---------------------------------------
samer@0: 
samer@0: (define-method (exec (agent Agent) cmd) (.execute agent cmd (Shell.env)))
samer@0: (define-method (exec (vbl Viewable) cmd) (.execute (.getAgent vbl) cmd (Shell.env)))
samer@0: (define-method (exec (mat samer.maths.Matrix) cmd) (.execute (.getAgent mat) cmd (Shell.env)))
samer@0: (define (matexec matrix cmd) (exec (samer.maths.MatrixAgent. matrix) cmd))
samer@0: 
samer@0: (define (viewable name) (.getViewable (get "ViewableManager") (.abs (Shell.env) name)))
samer@0: (define (edit-vbl vbl)
samer@0: 	(Shell.showDialogFor
samer@0: 		(.getComponent (.getViewer vbl))
samer@0: 		(.getLabel vbl)))
samer@0: 
samer@0: (define (cur-node) (.node (env)))
samer@0: (define (set nm vl) (X.store nm vl))
samer@0: (define (put nm vl) (Shell.put nm vl))
samer@0: (define (get nm) (Shell.get nm))
samer@0: (define (interp cmd) (display "**** deprecated ****\n") 
samer@0: 	(.dispatch (get "AgentManager") cmd (Shell.env)))
samer@0: (define (pr-viewables)	(.listViewables (get "ViewableManager")))
samer@0: (define (exit) 		(.dispatch (get "AgentManager") "exit" (Shell.env)))
samer@0: (define-method (expose) (.dispatch (get "AgentManager") "expose" (Shell.env)))
samer@0: (define-method (expose (name String)) (Shell.expose (viewable name)))
samer@0: (define-method (expose (vbl Viewable)) (Shell.expose (.getViewer vbl) (.fullName (.getNode vbl))))
samer@0: (define-method (expose (vwr Viewer) (name String)) (Shell.expose vwr name))
samer@0: 
samer@0: ; another kind of store
samer@0: ;(define (store nm obj) (.store (Shell.env) nm obj X.StringCodec$))
samer@0: 
samer@0: (define (hclicker canvas_name rcname)
samer@0: 	(define rc (viewable rcname))
samer@0: 	(define cl (Clicker. (get canvas_name) (+ (.getMax rc) 1) 1))
samer@0: 	(.setXReceiver cl rc))
samer@0: 
samer@0: (define (vclicker canvas_name rcname)
samer@0: 	(define rc (viewable rcname))
samer@0: 	(define cl (Clicker. (get canvas_name) 1 (+ (.getMax rc) 1)))
samer@0: 	(.setYReceiver cl rc))
samer@0: 
samer@0: 
samer@0: ;; buffering input. Always using this so put here
samer@0: (define-method (linein size step) (linein (samer.audio.LineSource.) size step))
samer@0: (define-method (linein (source samer.audio.AudioSource) size step)
samer@0: 	(define line (LineIn. source size step))
samer@0: 	(put "LineIn" line)
samer@0: 	(addtask line)
samer@0: 	(.output line) )