(require 'cgn) (progn (use-package :cgn) (use-package :ltk)) (defstruct model mname params randomcall datacall) (defstruct param pname lower upper step) (defstruct acall cname fname ) (defparameter *currentmodel* nil) (defparameter *olist* nil) (defparameter *seheult* (make-model :mname 'seheult :params (list (make-param :pname 'x :lower 1.4 :upper 1.6 :step .001) (make-param :pname 'y :lower 1.4 :upper 1.6 :step .001) (make-param :pname 'sd :lower .00001 :upper .00025 :step .00001) (make-param :pname 'mu :lower 1.5181932 :upper 15.181932 :step 1.5181932) (make-param :pname 'tau :lower 0.0036737733 :upper 0.036737733 :step 0.0036737733)) :randomcall (make-acall :cname '(new-random-seheult 1.4 1.6 (value x) (round (* 1.e5 (value sd) (value mu) (value tau)))) :fname "randomdata.dat") :datacall (make-acall :cname '(handle-seheult (value x) (value y) (value sd) (value mu) (value tau)) :fname "sliderdata.dat"))) (defparameter *walsh* (make-model :mname 'walsh :params (list (make-param :pname 'p.xy :lower 1 :upper 500 :step 1) (make-param :pname 'f.1 :lower 1 :upper 5000 :step 1) (make-param :pname 't.1 :lower .2 :upper 2 :step .2) (make-param :pname 'p.0 :lower .403 :upper 4.03 :step .403) (make-param :pname 'p.1 :lower .272 :upper 2.72 :step .272) (make-param :pname 's.1 :lower .070 :upper .7 :step .070)) :randomcall (make-acall :cname '(random-walsh) :fname "random.dat") :datacall ())) ;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;; ;;;;;;;;;;;;;; (defmacro makevars (&optional (amodel *currentmodel*)) `(let* ((modelname (format nil "~A GUI" (model-mname ,amodel))) ;(splotty (format nil "splot '~a','~a'" ; (acall-fname (model-randomcall ,amodel)) ; (acall-fname (model-datacall ,amodel)))) (textie (format nil "Slider Data returns LR of: ~A." (acall-cname (model-datacall ,amodel)))) (paramname ()) (var `((l0 (make-instance 'label :master nil :text ,modelname)) (f0 (make-instance 'frame :master nil))))) (dolist (i (model-params ,amodel) var) (setf paramname (format nil "~A_slider" (param-pname i))) (setf var (append var `((,(param-pname i) (make-instance 'scale :master f0 :label ,paramname :from ,(param-lower i) :to ,(param-upper i) :troughcolor 'cyan :orientation 'horizontal :resolution ,(param-step i))))))) (setf var (append var `((f1 (make-instance 'frame :master nil)) (l1 (make-instance 'label :master f1)) (b1 (make-instance 'button :master f1 :text "Graph it!")) ;:command ;(lambda () ;(acall-cname (model-randomcall ,amodel)) ; (setf (text l1) ;'hello))) ; (with-gnuplot ('linux) ; (format-gnuplot "reset") ; (format-gnuplot ,splotty)))))))))) ))))) (defmacro makepack (&optional (amodel *currentmodel*)) `(let ((var `((pack l0) (pack f0)))) (dolist (i (model-params ,amodel) var) (setf var (append var `((pack ,(param-pname i)))))) (setf var (append var `((pack f1) (pack l1) (pack b1)))))) (defmacro retall (&optional (amodel *currentmodel*)) `(labels ((x () (makevars ,amodel)) (y () (makepack ,amodel))) `(with-ltk () (let* (,@(x)) ,@(y) )))) ;;;hey i works! (defmacro arrgh! () `(progn ,(retall *seheult*))) (defmacro grr (attempt) `(progn ,attempt)) (defun another (amodel) (setf *currentmodel* amodel)) ;;;i worksmuch better...ish (defmacro final (amodel) (progn (another amodel)) `(progn ,(retall))) ;(defmacro a! (&body amodel) ; `(progn ; ,@amodel)) ;(defmacro makegui3 (&body body) ; `(progn ; (let ((,@body)) ; 'arr))) #| (defmacro fred (thing) (format t "hello ~A~%" thing) `(let ((x 10) ,@body))) ) (defmacro makegui (amodel) `(with-ltk () (let* (,(makevars ,amodel)) ;;(print useful) ;;(print l0) ))) (defmacro makegui1 (amodel) (setf *currentmodel* amodel) (print *currentmodel*) `(with-ltk () (let* ((,@(makevars)))))) (defmacro makeguinew (amodel) (labels ((testie () (print amodel)) (testie2 () `(let ((var (list `(l0 (make-instance 'label :master nil :text "placeholder")) `(f0 (make-instance 'frame :master nil)))) (i 0)) (dolist (i (model-params ,amodel) var) (setf var (append var (list `(,(param-pname i) (make-instance 'scale :master f0 :from ,(param-lower i) :to ,(param-upper i) :resolution ,(param-step i)))))))))) ;;(testie) `(let* (,@(makevars *seheult*)) ;`(with-ltk () ; (let (,(testie2)) ; )))) ))) (defmacro makegui-defunct (afuncall) (let ((vars (1- (length afuncall)))) `(with-ltk () (let* ((l0 (make-instance 'label :master nil :text (format nil "~A GUI" (first ,afuncall)))) (f0 (make-instance 'frame :master nil)) (s0 (make-instance 'scale :master f0 :label (format nil "~A" (second ,afuncall)) :troughcolor 'cyan)) (s1 (make-instance 'scale :master f0 :label (format nil "~A" (third ,afuncall)) :troughcolor 'cyan)) (s2 (make-instance 'scale :master f0 :label (format nil "~A" (fourth ,afuncall)))) (f2 (make-instance 'frame :master nil)) (l2 (make-instance 'label :master f2)) (b2 (make-instance 'button :master f2 :text "Calculate" :command (lambda () (setf (text l2) (funcall (first ,afuncall) (value s0) (value s1) (value s2))))))) (pack l0) (pack f0) (pack s0 :side :left) (pack s1 :side :left) (pack s2 :side :left) (pack f2 :side :bottom :after f0) (pack l2) (pack b2))))) ||# #| (defmacro retall1 (&optional (amodel *currentmodel*)) (print 'hello) `(labels ((x () (makevars ,amodel)) (y () (makepack ,amodel)) (testie () `(with-ltk () (let* (,@(x)) ,@(y) )))) `(progn ,(testie)))) |#