aboutsummaryrefslogtreecommitdiff
path: root/object_db-plugin.tcl
blob: 95518334d6e96c76ab52845f19ef26dd356973df (plain)
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

set enabled_libraries {
    {pd-lib} {boids} {bsaylor} {creb} {cxc} {cyclone} {cyclone (hammer)} {cyclone (sickle)}
    {ekext} {fftease} {flatspace} {flib} {freeverb~} {gem} {ggee} {hardware} {hcs} {hid}
    {iem_ambi} {iem_bin_ambi} {iemgui} {iemlib} {jasch_lib} {jmmmp} {keyboardkeys}
    {la-kitchen} {list-abs} {mapping} {markex} {maxlib} {memento} {mjlib} {motex} {mrpeach}
    {nqpoly~} {nqpoly4} {nusmuk} {oscx} {pan} {pddp} {pdjimmies} {pdmtl abstractions}
    {pdogg} {pdp} {Percolate} {pidip} {pixeltango} {pmpd} {rradical} {rtc} {sigpack}
    {smlib} {toxy} {unauthorized} {vasp} {xsample} {zexy} {zexy Abstraction}
}
# comment the following line to enable all libraries
set enabled_libraries {pd-lib}

# top level categories (tags)
set tlc {conversion pdmtl cyclone maxlib zexy vasp storage audio control connectivity imaging math misc}

# second level (in menu) categories
set c2 {
    connectivity {osc midi network}
    conversion {midi audio}
    cyclone {hammer sickle audio math control}
    zexy {audio analysis matrix control}
    maxlib {control time math glue}
    audio {abstraction conversion fftease cyclone math logical analysis filters delay effects tables}
    vasp {declaration arithmetic basics functions generators transcendent minmax utilities filters fft displace}
    storage {abstraction lists matrix tables}
    pdmtl {control convert list edit flow imaging}
    imaging {{gem particles} {gem manipulators} {gem pixes} {gem geos} {gem opengl} {pdp image} {pdp processing} {pdp abstraction} {pdp 3d} pidip manipulators wrapper particles automata processing}
}





#---------------------------------------------------------------------------------------------
# object -> tags mapping
array set object_tags {}
# tag reverse mapping
array set objects_with_tag {}

# load object -> tags mapping from file in Pd's path
set testfile [file join $::current_plugin_loadpath object_tags.tcllist]
if { [file isfile $testfile]} {
    set f [open $testfile]
    set tmp_db [read $f]
    close $f
    unset f        
}

foreach {library object tags} $tmp_db {
    # skip unwanted libraries
    if {[lsearch -exact $enabled_libraries $library] == -1} {continue}
    foreach tag $tags {lappend object_tags($object) $tag}
}
unset tmp_db

foreach k [array names object_tags] {
    set object_tags($k) [lsort $object_tags($k)]
    foreach tag $object_tags($k) {lappend objects_with_tag($tag) $k}
}

proc object_db_query {q workingset} {
    global object_tags
    set q _[join [lsort $q] _.*_]_
    set result [list]
    foreach k $workingset {
        set v _[join $object_tags($k) __]_
        if {[regexp $q $v]} {lappend result $k}
    }
    set result
}

# TODO: benchmark which is faster between the two
proc object_db_query_re {q workingset} {
    global object_tags
    set q (?b)\\<[join [lsort $q] \\>.*\\<]\\>
    set result [list]
    foreach k $workingset {
        if {[regexp $q $object_tags($k)]} {lappend result $k}
    }
    set result
}

proc complement {e s} {
    set result [list]
    foreach i $e {if {[lsearch -exact $s $i] == -1} {lappend result $i}}
    set result
}

proc merge {args} {
    array set tmp {}
    foreach arg $args {
        foreach k $arg {
            set tmp($k) .
        }
    }
    set x [array names tmp]
    array unset tmp
    set x
}

proc pdtk_canvas_popup_addObjectBranch {t m lst} {
    set n 0
    foreach {k v} $lst {
        if {$k == {.}} {
            incr n
            set cbrk 0
            if {$n > 18} {
                set cbrk 1
                set n 1
            }
            $m add command -label $v -columnbreak $cbrk \
            -command "pdsend \"\$::focused_window obj \$::popup_xcanvas \$::popup_ycanvas $v\""
        } else {
            if {[llength $v] == 0} continue
            set sub ${m}.sub[incr ::s]
            menu $sub
	    # fix menu font size on Windows with tk scaling = 1
	    if {$::windowingsystem eq "win32"} {$sub configure -font menufont}
            $m add cascade -label $k -menu $sub
            pdtk_canvas_popup_addObjectBranch $t $sub $v
        }
    }
}

proc print_r {l {indent 0}} {
    foreach {k v} $l {
        if {$k == "."} {
            for {set j 0} {$j < $indent} {incr j} {puts -nonewline "  "}
            puts $v
        } else {
            for {set j 0} {$j < $indent} {incr j} {puts -nonewline "  "}
            puts "$k {"
            print_r $v [expr {$indent+1}]
            for {set j 0} {$j < $indent} {incr j} {puts -nonewline "  "}
            puts "}"
        }
    }
}

proc @ {l} {
    set result [list]
    set ls [lsort $l]
    foreach i $ls {lappend result . $i}
    set result
}

set l [list]
set all [array names object_tags]
# *partition* by tag into top-level-categories
foreach c $tlc {
    set c_$c [object_db_query $c $all]
    set all [complement $all [set c_$c]]
}
set c_others $all
# *search* by tag in 2nd-level-categories
# add 2-level categories
foreach {tlcn c2l} $c2 {
    set ll [list]
    set accum [list]
    foreach c2i $c2l {
        set lll [object_db_query $c2i [set c_$tlcn]]
        set accum [merge $accum $lll]
        if {[llength $lll] > 0} {lappend ll $c2i [@ $lll]}
    }
    set others [complement [set c_$tlcn] $accum]
    if {[llength $others] > 0} {lappend ll "others" [@ $others]}
    lappend l $tlcn $ll
}
# add 1-level-categories
foreach tlci $tlc {
    set c2_keys [list]
    # can't use dict on 8.4
    foreach {k v} $c2 {lappend c2_keys $k}
    if {[lsearch -exact $c2_keys $tlci] != -1} {continue}
    set c_1_set [object_db_query $tlci [set c_$tlci]]
    lappend l $tlci [@ $c_1_set]
}
# end menu structure builder

#print_r $l

.popup add separator
set s 0
pdtk_canvas_popup_addObjectBranch - .popup $l