1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
if {0} {
/*
* This file is part of din.
*
* din is copyright (c) 2006 - 2012 S Jagannathan <jag@dinisnoise.org>
* For more information, please visit http://dinisnoise.org
*
* din is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 2 of the License, or
* (at your option) any later version.
*
* din is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
* for more details.
*
* You should have received a copy of the GNU General Public License along
* with din. If not, see <http://www.gnu.org/licenses/>.
*
*/
}
puts -nonewline {<<< loading Tcl init script: }
;# bring the math functions to use them LISP style eg., + 2 3
namespace import ::tcl::mathop::*
;# short for sourcing tcl scripts / patches
proc src {name} {
uplevel #0 source ~/.din/$name.tcl
}
;# console colors
set color(header) {set-text-color 1 0.75 0.5}
set color(text) {set-text-color 0.8 1 0.8}
set color(error) {set-text-color 1 0.6 0.6}
set color(fine) {set-text-color 0.6 1 0.6}
set resetbeat 0
proc tap-bpm-changed {name element op} {
;# tap bpm changed
global taptarget tapbpm resetbeat
set wr {}
if $resetbeat {
foreach i $taptarget {
set-beat $i [get-beat $i first]
}
set wr {[+ reset]}
set resetbeat 0
}
set-bpm $taptarget $tapbpm
echo "tap bpm: $tapbpm $wr"
}
trace add variable tapbpm write tap-bpm-changed
;# list files in ~/.din matching extension
proc lsdotdin {{ext *} {orient h} } {
set mapping [list .$ext {}]
if {$orient eq "v" || $orient eq "vertical"} {lappend mapping { } \n}
string map $mapping [lsort [glob -nocomplain -tails -directory ~/.din *.$ext]]
}
proc bad-sub-command {c} {
upvar $c cmds
set err "bad sub-command. should be: "
foreach i [lrange $cmds 0 end-1] {
append err "$i, "
}
append err "or [lindex $cmds end]"
}
proc exec-sub-command {ucmds uactions ucmd uargs} {
upvar $ucmds cmds $uactions actions $ucmd cmd $uargs args
set j 0
foreach i $cmds {
if {$cmd eq $i} {
return [{*}[lindex $actions $j] {*}$args]
}
incr j
}
bad-sub-command cmds
}
;# find-scale command -> lists scales that match pattern
proc find-scale {pattern} {
lsort [lsearch -all -inline [list-scales] $pattern]
}
;# tuning command -> list, set and get available tunings
proc tuning {cmd args} { ;# tuning command
set cmds {list set get}
set actions {"lsdotdin tuning" "set-var tuning" "get-var tuning"}
exec-sub-command cmds actions cmd args
}
;# called when drones are deleted
proc drones-deleted {args} {}
;# called once every din loop
proc loop {} {} ;# required
;# list-patches command
set lsp_body {{{v ""}} {
lsdotdin patch.tcl $v
}}
eval "proc list-patches $lsp_body"
eval "proc lp $lsp_body"
;# load-patch command
set lop_body {{patch} {
if [catch {src $patch.patch}] {
set-text-color 1 0.5 0.5
echo "bad $patch"
} else {
set-text-color 0.5 1 0.5
echo "loaded $patch"
echo "help $patch for more information"
}
}}
eval "proc load-patch $lop_body"
eval "proc lop $lop_body"
;# make interval note variables based on current tuning
src make-interval-note-vars
;# load help displayer
src help
if {0} {
make empty midi procs
if user wants diagnostics, they can load midimap patch
}
proc make-midi name {
uplevel #0 "proc $name args {}"
}
foreach i {midi-start midi-clock midi-note-on midi-note-off midi-pitch-bend midi-program-change midi-cc} {
make-midi $i
}
proc setup-editors {} {
set instrument [get-var instrument]
set eds [set instrument]_editors
global $eds
set ids [array get $eds]
foreach {i j} $ids {
set-curve-editor $j $i
}
}
proc update-editor {name screen} {
set instrument [get-var instrument]
set eds [set instrument]_editors
global $eds
array set $eds [list $screen $name]
}
proc exit {} {}
proc show-authors-note {} {
proc get-rand {{a 0.3} {b 1}} {
return [expr {$a + ($b - $a) * rand ()}]
}
rename get-rand @
set-text-color [@] [@] [@]
echo "Welcome to DIN Is Noise"
echo "DIN has been in continous development for the last 6 years!"
set-text-color 1 [@] [@]
echo "But now, DIN needs your kind & generous support to continue."
set-text-color [@] [@] [@]
echo "So, if you can, please donate to the DIN Is Noise project."
echo "No amount too small!"
rename @ get-rand
}
puts {done. +++}
proc getval {min max amount} { ;# get interpolated value from min to max
set amount [/ $amount 127.0]
return [expr { (1 - $amount) * $min + $amount * $max }]
}
source ~/.din/tips.tcl
|
