CRIMP
Check-in [3ca084f409]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Cherry pick [3f01ece746] into trunk.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3ca084f40902d723b3db7bbb02f812cecee597aa
User & Date: andreask 2011-11-07 23:30:26.140
References
2011-11-18
05:47
Modified the demos framework to provide a documented api for access to app and demos directories, replaced outdated and broken (since [3ca084f409], and [3f01ece746]) uses of the $dir variable with these APIs. check-in: 360c8724f9 user: andreask tags: trunk
Context
2011-11-07
23:33
Keep the install build directories separate, for an easier look into things after a manual abort. check-in: 5e20c79955 user: andreask tags: trunk
23:30
Cherry pick [3f01ece746] into trunk. check-in: 3ca084f409 user: andreask tags: trunk
2011-10-22
21:11
Fixed bug in const expansion of float images. Take a double value, not integer. check-in: fa3254aaa2 user: andreask tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to demos.tcl.
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
package require widget::scrolledwindow
package require widget::toolbar
package require widget::arrowbutton
package require crosshair
package require fileutil

# Self dir
set dir [file dirname [file normalize [info script]]]

puts "In $dir"

set triedprebuilt 0
if {[catch {
    set triedprebuilt 1

    puts "Trying prebuild packages"

    # Use crimp as prebuilt package
    lappend auto_path $dir/lib

    foreach p {
	crimp::core
	crimp
	crimp::tk
	crimp::ppm
	crimp::pgm







|

|








|







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
package require widget::scrolledwindow
package require widget::toolbar
package require widget::arrowbutton
package require crosshair
package require fileutil

# Self dir
set selfdir [file dirname [file normalize [info script]]]

puts "In $selfdir"

set triedprebuilt 0
if {[catch {
    set triedprebuilt 1

    puts "Trying prebuild packages"

    # Use crimp as prebuilt package
    lappend auto_path $selfdir/lib

    foreach p {
	crimp::core
	crimp
	crimp::tk
	crimp::ppm
	crimp::pgm
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
	crimp_ppm.tcl  crimp::ppm   {Read/write portable pix maps}
	crimp_pgm.tcl  crimp::pgm   {Read/write portable grey maps}
	crimp_pfm.tcl  crimp::pfm   {Read/write portable float maps}
	crimp_bmp.tcl  crimp::bmp   {Read/write Windows bitmaps}
    } {
	puts "Trying dynamically compiled package \"$p\""
	# Directly access the package
	source [file join $dir $f]
	puts "Using dynamically compiled package \"$p\""
    }
}

wm protocol . WM_DELETE_WINDOW ::exit

puts "Starting up ..."

#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n[join [info loaded] \n]
#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# # ## ### ##### ######## #############

proc images_init {} {
    global dir images
    set images [lsort -dict [glob -tails -directory $dir/images *.png]]
    return
}

proc images_get {index} {
    global images
    return [image_load [lindex $images $index]]
}

proc image_load {name} {
    global dir

    set photo [image create photo -file [file join $dir images $name]]
    set image [crimp read tk $photo]
    image delete $photo

    return $image
}

# # ## ### ##### ######## #############

proc demo_init {} {
    global dir demo demo_index dcurrent demo_map
    set dcurrent {}

    array unset demo     *
    array unset demo_map *

    array set demo {
	aaaaa {
	    label       A:Unmodified
	    cmd         demo_close
	    active      {expr {[bases] == 1}}
	    setup       {}
	    setup_image {}
	    shutdown    {}
	}
    }
    set demo_index(A:Unmodified) [list aaaaa N/A]

    foreach f [glob -directory $dir/demos *.tcl] {
	set thedemo {}
	source $f
	set name [dict get $thedemo name]
	set demo_label [dict get $thedemo label]
	set demo_index(${demo_label}) [list ${name} [file tail ${f}]]
	#puts <$thedemo>
	set demo($name) $thedemo







|














|
|









|

|









|

















|







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
	crimp_ppm.tcl  crimp::ppm   {Read/write portable pix maps}
	crimp_pgm.tcl  crimp::pgm   {Read/write portable grey maps}
	crimp_pfm.tcl  crimp::pfm   {Read/write portable float maps}
	crimp_bmp.tcl  crimp::bmp   {Read/write Windows bitmaps}
    } {
	puts "Trying dynamically compiled package \"$p\""
	# Directly access the package
	source [file join $selfdir $f]
	puts "Using dynamically compiled package \"$p\""
    }
}

wm protocol . WM_DELETE_WINDOW ::exit

puts "Starting up ..."

#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n[join [info loaded] \n]
#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# # ## ### ##### ######## #############

proc images_init {} {
    global selfdir images
    set images [lsort -dict [glob -tails -directory $selfdir/images *.png]]
    return
}

proc images_get {index} {
    global images
    return [image_load [lindex $images $index]]
}

proc image_load {name} {
    global selfdir

    set photo [image create photo -file [file join $selfdir images $name]]
    set image [crimp read tk $photo]
    image delete $photo

    return $image
}

# # ## ### ##### ######## #############

proc demo_init {} {
    global selfdir demo demo_index dcurrent demo_map
    set dcurrent {}

    array unset demo     *
    array unset demo_map *

    array set demo {
	aaaaa {
	    label       A:Unmodified
	    cmd         demo_close
	    active      {expr {[bases] == 1}}
	    setup       {}
	    setup_image {}
	    shutdown    {}
	}
    }
    set demo_index(A:Unmodified) [list aaaaa N/A]

    foreach f [glob -directory $selfdir/demos *.tcl] {
	set thedemo {}
	source $f
	set name [dict get $thedemo name]
	set demo_label [dict get $thedemo label]
	set demo_index(${demo_label}) [list ${name} [file tail ${f}]]
	#puts <$thedemo>
	set demo($name) $thedemo
Changes to policy.tcl.
291
292
293
294
295
296
297

298
299
300
301
302
303
304
    namespace export *
    namespace ensemble create
}

::apply {{} {
    foreach fun [::crimp::List join_*] {
	proc [::crimp::P $fun] {args} [string map [list @ $fun] {

	    return [@ {*}$args]
	}]
    }
} ::crimp::join}

# # ## ### ##### ######## #############








>







291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
    namespace export *
    namespace ensemble create
}

::apply {{} {
    foreach fun [::crimp::List join_*] {
	proc [::crimp::P $fun] {args} [string map [list @ $fun] {
	    # TODO : Check arguments for proper type.
	    return [@ {*}$args]
	}]
    }
} ::crimp::join}

# # ## ### ##### ######## #############