comparison src/scheme/task.scm @ 0:bf79fb79ee13

Initial Mercurial check in.
author samer
date Tue, 17 Jan 2012 17:50:20 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bf79fb79ee13
1 ;;; task related utilities
2 (import "samer.tools.*")
3
4
5 (define task (macro body `(SilkTask. (lambda () ,@body))))
6
7 ;;; convert a CompoundTask to a Scheme list
8 (define (tasks->list tasks)
9 (define L ())
10 (define (list-it it)
11 (if (.more it) (begin
12 (set! L (append L (list (.next it))))
13 (list-it it))))
14 (list-it (.iterator tasks))
15 L
16 )
17
18 ;;; create and access main task list
19
20 (define _thread null)
21 (define _tasklist_stack ())
22
23 (define (start) (exec _thread "start"))
24 (define (stop) (exec _thread "stop"))
25 (define (thread) _thread)
26
27 ;;; creates a task list/thread if none exists, returns a task list
28 (define (tasks)
29 (if (null? _tasklist_stack)
30 (let ((t (CompoundTask.)))
31 (set! _thread (RThread. t))
32 (push-tasklist t)
33 t
34 )
35 (first _tasklist_stack)
36 )
37 )
38
39 (define (push-tasklist t)
40 (set! _tasklist_stack (cons t _tasklist_stack)))
41
42 (define (pop-tasklist)
43 (let ((t (first _tasklist_stack)))
44 (set! _tasklist_stack (rest _tasklist_stack))
45 t))
46
47 (define with-tasks (macro (tasks . body)
48 `(begin
49 (push-tasklist ,tasks)
50 (tryCatch
51 (let ((a (begin . ,body))) (pop-tasklist) a)
52 (lambda (ex) (pop-tasklist) (throw ex))))))
53
54 ; add task to current task list
55 (define (addtask t) (.addTask (tasks) t) t)
56 (define (removetask t) (.removeTask (tasks) t) t)
57 (define-method (add (t Task)) (.addTask (tasks) t) t)
58 (define-method (addafter (a Task) (t Task)) (.addTaskAfter (tasks) t a) t)
59 (define-method (remove (t Task)) (.removeTask (tasks) t) t)
60
61 ; add multiple tasks to current task list
62 (define (addtasks . t)
63 (for-each (lambda (t) (.addTask (tasks) t)) t)
64 (tasks) )
65
66 (define-method (pr-tasks) (print (tasks->list (tasks))))
67 (define-method (view-tasks) (view-tasks (tasks)))
68 (define-method (view-tasks tasks) (view-list (tasks->list tasks) "Tasks"))
69 (define-method (task-ref (n Integer)) (list-ref (tasks->list (tasks)) n))
70 (define-method (task-ref tasks (n Integer)) (list-ref (tasks->list tasks) n))
71
72 (define (switch task) (SwitchTask. task))
73
74 ;;; Create a subrate task and a UI for the subrate factor
75 ;;; !! need to dispose of VInteger when task is disposed.
76 (define (sub n task)
77 (define vn (VInteger. "subfactor" n))
78 (define subt (SubrateTask. n task))
79 (on-change vn (.setFactor subt (.value$ vn)))
80 (.value$ vn n) (.changed vn)
81 subt
82 )
83
84 (define (seq . tasks)
85 (define c (CompoundTask.))
86 (for-each (lambda (t) (.addTask c t)) tasks)
87 c)
88