63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
(if (> depth node-depth) ;; (+ 1 node-depth))
#f
(loop hed tal depth (+ nodenum 1)))))
#f))))
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(if (not (iup:attribute obj "TITLE0"))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (string=? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
(depth 1)
(pathl (list top)))
|
>
|
|
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(if (> depth node-depth) ;; (+ 1 node-depth))
#f
(loop hed tal depth (+ nodenum 1)))))
#f))))
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(if (or (not (string? (iup:attribute obj "TITLE0")))
(string-null? (iup:attribute obj "TITLE0")))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (equal? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
(depth 1)
(pathl (list top)))
|
110
111
112
113
114
115
116
|
path))
(newpath (append trimpath (list node-title))))
(if (>= currnode nodenum)
newpath
(loop (+ currnode 1)
newpath)))))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
path))
(newpath (append trimpath (list node-title))))
(if (>= currnode nodenum)
newpath
(loop (+ currnode 1)
newpath)))))
#|
(let* ((tb (iup:treebox
#:value 0
#:name "Runs"
#:expand "YES"
#:addexpanded "NO"
#:selection-cb
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(run-id (tree-path->run-id (cdr run-path))))
(if run-id
(begin
(dboard:data-set-curr-run-id! *data* run-id)
(dashboard:update-run-summary-tab)))
;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
))))
|#
|