Документ взят из кэша поисковой машины. Адрес оригинального документа : http://kodomo.fbb.msu.ru/hg/allpy/rev/505ce122068b
Дата изменения: Unknown
Дата индексирования: Tue Oct 2 00:25:17 2012
Кодировка:
allpy: 505ce122068b

allpy

changeset 9:505ce122068b

Generalized tcl examples in the sandbox.
author Danya Alexeyevsky <me.dendik@gmail.com>
date Thu, 10 Jun 2010 14:24:08 +0400
parents 208ec59bad5b
children ea7a761d3f70
files sandbox/common.tcl sandbox/tk-canvas.tcl sandbox/tk-text.tcl
diffstat 3 files changed, 56 insertions(+), 58 deletions(-) [+]
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/sandbox/common.tcl	Thu Jun 10 14:24:08 2010 +0400
     1.3 @@ -0,0 +1,45 @@
     1.4 +proc generate_lines {} {
     1.5 +	global lines
     1.6 +
     1.7 +	set f [open "/dev/urandom"]
     1.8 +
     1.9 +	proc rand {class} {
    1.10 +		global f
    1.11 +		while {1} {
    1.12 +			set c [read $f 1]
    1.13 +			if {[string is $class $c]} { return $c }
    1.14 +		}
    1.15 +	}
    1.16 +
    1.17 +	set lines {}
    1.18 +	for {set i 0} {$i < 800} {incr i} {
    1.19 +		if {$i % 10 == 0} { puts "line $i"; }
    1.20 +	
    1.21 +		set line {}
    1.22 +		for {set j 0} {$j < 1000} {incr j} {
    1.23 +			lappend line $i $j [rand upper] [rand integer]
    1.24 +		}
    1.25 +		lappend lines $line
    1.26 +	}
    1.27 +
    1.28 +	set f [open "data/lines.tcl" w]
    1.29 +	puts $f "set lines [list $lines]"
    1.30 +	close $f
    1.31 +}
    1.32 +
    1.33 +proc load_lines {} {
    1.34 +	global lines
    1.35 +	source "data/lines.tcl"
    1.36 +}
    1.37 +
    1.38 +proc add_scrolls {w} {
    1.39 +	scrollbar .w -orient horizontal -command {$w xview}
    1.40 +	scrollbar .h -orient vertical -command {$w yview}
    1.41 +	$w configure -xscrollcommand {.w set}
    1.42 +	$w configure -yscrollcommand {.h set}
    1.43 +	grid rowconfigure . 0 -weight 1
    1.44 +	grid columnconfigure . 0 -weight 1
    1.45 +	grid $w -row 0 -column 0 -sticky nsew
    1.46 +	grid .w -row 1 -column 0 -sticky we
    1.47 +	grid .h -row 0 -column 1 -sticky ns
    1.48 +}
     2.1 --- a/sandbox/tk-canvas.tcl	Thu Jun 10 14:18:23 2010 +0400
     2.2 +++ b/sandbox/tk-canvas.tcl	Thu Jun 10 14:24:08 2010 +0400
     2.3 @@ -1,43 +1,13 @@
     2.4 -canvas .x
     2.5 -grid .x -row 0 -column 0 -sticky nsew
     2.6 +#!/bin/sh
     2.7 +# vim: set ft=tcl: \
     2.8 +exec wish "$0" "$@"
     2.9  
    2.10 -scrollbar .w -orient horizontal -command {.x xview}
    2.11 -scrollbar .h -orient vertical -command {.x yview}
    2.12 -.x configure -xscrollcommand {.w set}
    2.13 -.x configure -yscrollcommand {.h set}
    2.14 -grid rowconfigure . 0 -weight 1
    2.15 -grid columnconfigure . 0 -weight 1
    2.16 -grid .w -row 1 -column 0 -sticky we
    2.17 -grid .h -row 0 -column 1 -sticky ns
    2.18 -.x configure -scrollregion {0 0 10000 8000}
    2.19 +source "common.tcl"
    2.20  
    2.21 -#set f [open "/dev/urandom"]
    2.22 -#
    2.23 -#proc rand {class} {
    2.24 -#	global f
    2.25 -#	while {1} {
    2.26 -#		set c [read $f 1]
    2.27 -#		if {[string is $class $c]} { return $c }
    2.28 -#	}
    2.29 -#}
    2.30 -#
    2.31 -#set lines {}
    2.32 -#for {set i 0} {$i < 800} {incr i} {
    2.33 -#	if {$i % 10 == 0} { puts "line $i"; }
    2.34 -#
    2.35 -#	set line {}
    2.36 -#	for {set j 0} {$j < 1000} {incr j} {
    2.37 -#		lappend line $i $j [rand upper] [rand integer]
    2.38 -#	}
    2.39 -#	lappend lines $line
    2.40 -#}
    2.41 -#
    2.42 -#set f [open "data/lines.tcl" w]
    2.43 -#puts $f "set lines [list $lines]"
    2.44 -#close $f
    2.45 +canvas .x -scrollregion {0 0 10000 8000}
    2.46 +add_scrolls .x
    2.47  
    2.48 -source "data/lines.tcl"
    2.49 -
    2.50 +load_lines
    2.51  puts "lines are ready"
    2.52  
    2.53  foreach line $lines {
     3.1 --- a/sandbox/tk-text.tcl	Thu Jun 10 14:18:23 2010 +0400
     3.2 +++ b/sandbox/tk-text.tcl	Thu Jun 10 14:24:08 2010 +0400
     3.3 @@ -2,29 +2,12 @@
     3.4  # vim: set ft=tcl: \
     3.5  exec wish "$0" "$@"
     3.6  
     3.7 +source "common.tcl"
     3.8 +
     3.9  text .x -wrap no
    3.10 -grid .x -row 0 -column 0 -sticky nsew
    3.11 +add_scrolls .x
    3.12  
    3.13 -scrollbar .w -orient horizontal -command {.x xview}
    3.14 -scrollbar .h -orient vertical -command {.x yview}
    3.15 -.x configure -xscrollcommand {.w set}
    3.16 -.x configure -yscrollcommand {.h set}
    3.17 -grid rowconfigure . 0 -weight 1
    3.18 -grid columnconfigure . 0 -weight 1
    3.19 -grid .w -row 1 -column 0 -sticky we
    3.20 -grid .h -row 0 -column 1 -sticky ns
    3.21 -
    3.22 -# set f [open "/dev/urandom"]
    3.23 -# 
    3.24 -# proc rand {class} {
    3.25 -# 	global f
    3.26 -# 	while {1} {
    3.27 -# 		set c [read $f 1]
    3.28 -# 		if {[string is $class $c]} { return $c }
    3.29 -# 	}
    3.30 -# }
    3.31 -
    3.32 -source "data/lines.tcl"
    3.33 +load_lines
    3.34  
    3.35  for {set i 0} {$i < 10} {incr i} {
    3.36  	.x tag configure $i -background #$i$i$i