(load "date-time.scm") (load "plc-init.scm") (load "scheduler.scm") (define protocol-a (current-protocol)) ;(define protocol-b (protocol-load " c:\\bbleble.p")) (define path "c:\\fytoscope\\") (define analyse-run2-enabled #t) (define (set-light-actinic1 percent) (set-property "fluorcam.actinic" percent) (set-property "fluorcam.actinic_on" #t)) (define (set-light-actinic2 percent) (set-property "fluorcam.super" percent) (set-property "fluorcam.unknown.switch0" #t)) (define (set-light-far percent) (set-property "fluorcam.unknown.track1" percent) (set-property "fluorcam.unknown.switch1" #t)) ;sheduler actions (define (action-measuring) (lambda () (exp-measure protocol-a))) (define (action-light-off) (lambda () (set-light-actinic1 0) (set-light-actinic2 0) (set-light-far 0))) (define (action-set-light light percent) (if (= light "act1") (lambda () (set-light-actinic1 percent)) (if (= light "act2") (lambda () (set-light-actinic2 percent)) (if (= light "far") (lambda () (set-light-far percent)) (lambda() (display "invalid name for light" light)))))) (define (action-wait)(wait/progress "Time to next day: " 10)) (define (next-day) (define-action "23:59:55" action-wait)) (define sh (list (define-action "09:00:00" (action-set-light "act2"10)) (define-action "09:00:02" (action-set-light "act1"10)) (define-action "23:00:00" (action-set-light "act2"0)) (define-action "23:00:02" (action-set-light "act1"0)) (next-day) )) (define (simple-measure protocol) (set-protocol protocol) (if (empty-protocol? protocol) (throw -1 "Protocol is EMPTY")) (if (not (compile-protocol protocol)) (throw -2 "Compile protocol failed")) (if (not (upload-protocol protocol)) (throw -3 "Upload protocol failed")) (if (not (start-measuring)) (throw -4 "Start measuring failed")) (if (!= (wait-for-end-measuring) 0) (throw -5 "Error in measuring")) ok) (define (create-exp-name . param) (define (iter result param) (if (null? param) result (iter (+ result (car param))(cdr param)))) (iter "" param)) (define (char-alpha? ch) (or (and (>= ch #\A) (<= ch #\Z))(and (>= ch #\a)(<= ch #\z)))) (define (correct-name str) (define count (string-length str)) (define (iter n) (if (>= n count) str (begin (define ch (string-ref str n)) (if (not (or (char-numeric? ch) (char-alpha? ch))) (string-set! str n #\-)) (iter (+ n 1))))) (iter 0)) (define (datetime) (correct-name (datetime->string (current-datetime)))) (define (analyse-run) (set-selection-auto)(sleep 100) (background-exclusion)(sleep 100) (exp-analyse)) (define (analyse-run2) (set-selection-manual)(sleep 100) (shapes-load "c:\\fytoscope\\mask1.sel") (background-exclusion)(sleep 100) (exp-analyse)) (define (exp-measure protocol) (gui-set-page 0) (simple-measure protocol) (if analyse-run2-enabled (analyse-run2)) (save-exp (create-exp-name path (datetime) ".tar"))) (define (check protocol) (if (empty-protocol? protocol) (set! protocol (open-protocol))) (if (empty-protocol? protocol) (throw -1 "Protocol is EMPTY")) (if (not (path-exists? path)) (set! path (select-dir))) (if (not (string? path)) (throw -1 "Path is EMPTY"))) (define (start) (check protocol-a) (scheduler-start sh)(start)) (try/cc start) ;(if analyse-run2-enabled (analyse-run2)) ;(create-exp-name (datetime)) ;(shapes-load "c:\\fytoscope\\npq.sel")