Mercurial > hg > jslab
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 |