This is a page for code that would be too long to paste in the Tcl Chatroom or #Tcl.
Copy and Paste: A coder's best friend. This technique can save a coder hours maybe even days worth of time, but at what cost? The coder will miss the opportunity to go through all the frustrations, discoveries, thrills, struggles, and break throughs that the original coder went through
Another resource you might consider using for this is http://www.nomorepasting.com
/* Copyright 2003 George Peter Staplin
* Revision 2
*/
#include <stdio.h>
#include <stdlib.h>
#define check_malloc(s) ({void *r = malloc(s); \
if (NULL == r) { perror ("unable to malloc"); exit (EXIT_FAILURE); } \
r; })
typedef struct pig_s {
struct pig_s *ar[256];
int val;
} Pig;
Pig *create_pig () {
Pig *p = check_malloc (sizeof (Pig));
memset (p, 0, sizeof (Pig));
return p;
}
int pig_get (Pig *p, char *key) {
while ('\0' != *key) {
if (NULL == p->ar[*key]) {
return 0;
}
p = p->ar[*key];
++key;
}
return p->val;
}
void pig_insert (Pig *p, char *key, int val) {
while ('\0' != *key) {
if (NULL == p->ar[*key]) {
p->ar[*key] = create_pig();
}
p = p->ar[*key];
++key;
}
p->val = val;
}
int main () {
Pig *p;
p = create_pig ();
pig_insert (p, "abc", 123);
pig_insert (p, "def", 456);
pig_insert (p, "abc xyz", 444);
printf ("1 %d 2 %d 3 %d\n",
pig_get (p, "abc"),
pig_get (p, "def"),
pig_get (p, "abc xyz"));
return EXIT_SUCCESS;
}AM A quick hack for automatically creating a parser from the grammar -- 22 dec
# Experiment with parser generation
#
# Simple example:
# names := name names
# name := first_name last_name
# first_name := STRING
# last_name := STRING
#
# The input to "parse" is a list of "lexemes"
#
proc define { name dependents } {
global definitions
set definitions($name) $dependents
}
proc rule { name } {
global definitions
global lexeme
global end
if { $end } return
foreach dep $definitions($name) {
if { $dep != "STRING" } {
rule $dep
} else {
puts "$name: $dep = $lexeme"
nextLexeme
}
}
}
proc nextLexeme {} {
global count
global input
global lexeme
global end
incr count
if { $count < [llength $input] } {
set lexeme [lindex $input $count]
} else {
set end 1
}
}
# main --
# Just let it happen ...
#
global end
global count
global input
global lexeme
set end 0
set count -1
set input {Arjen Markus My colleague Co Tclers}
define names {name names}
define name {first_name last_name}
define first_name STRING
define last_name STRING
nextLexeme
rule namesGPS: Here's an example of SMTP via Tcl:
-- Dec, Tue 16 1:44 gps ~ -- $ tclsh8.4 % set s [socket mail.xmission.com 25] sock3 % fconfigure $s -buffering line % puts $s "MAIL FROM: [email protected]" % gets $s 220 mgr1.xmission.com ESMTP Exim 3.35 #1 Tue, 16 Dec 2003 01:44:38 -0700 % puts $s "RCPT TO: <[email protected]>" % gets $s 250 <[email protected]> is syntactically correct % puts $s DATA % puts $s "I like magic elves and trolls." % puts $s ".\nQUIT" % flush $s % gets $s 250 <[email protected]> is syntactically correct % close $s
#GPS
proc blink.me {win i} {
set cur [$win curselection]
set fg [$win cget -foreground]
set bg [$win cget -background]
foreach {bg fg} [list $fg $bg] break
$win configure -foreground $fg
$win configure -background $bg
incr i
if {$i > 5} return
after 50 [list blink.me $win $i]
}
pack [listbox .l]; .l insert end Hello World
bind .l <<ListboxSelect>> {blink.me %W 0}hmm... Now that was a little annoying. It flashes too much. Let's make it only flash 2 colors or maybe even 3 and then reset. I think passing it a list of colors might work better.
#GPS
proc blink.this {win colList i} {
set cur [$win curselection]
foreach {bg fg} $colList break
$win itemconfigure $cur -selectforeground $fg -selectbackground $bg
incr i
if {$i > 5} {
$win itemconfigure $cur -selectforeground {} -selectbackground {}
return
}
after 50 [list blink.this $win [list $fg $bg] $i]
}
pack [listbox .l]; .l insert end Hello World this is George!
bind .l <<ListboxSelect>> {blink.this %W {red blue} 0}Abhishek I hope this helps:
#! /bin/wish8.3
proc toolbar:make {win arPtr} {
upvar $arPtr ar
set i 0;
foreach {name mem} [array get ar] {
set img [lindex $mem 0]
set cmd [lindex $mem 1]
pack [button $win.$name -image $img -command $cmd] -side left
incr i
}
}
proc toolbar:disable {win arPtr key disFile} {
upvar $arPtr ar
set img [lindex $ar($key) 0]
$img read ./$disFile
$win.$key config -state disabled
}
pack [frame .f -relief groove -bd 1]
set ar(hello) [list [image create photo -file ./hello.gif] {puts "Hello World"}]
set ar(goodbye) [list [image create photo -file ./goodbye.gif] exit]
toolbar:make .f ar
pack [button .b -text "Disable Hello" -command {toolbar:disable .f ar hello ./goodbye.gif}]
jmn 2003-08-27 Proc size performance
set bigStuff ""
for {set i 0} {$i <= 700} {incr i} {
append bigStuff "set x$i v$i ;\n"
}
proc small {args} {
set v1 [lindex $args 0]
if {$v1 eq "goFast"} { v$i ;\n"
return $v1;
} else {
return "slow"
}
}
proc big {args} [string map "@bigStuff@ [list $bigStuff]" {
set v1 [lindex $args 0]
if {$v1 eq "goFast"} { igStuff@ [list $bigStuff]" {
return $v1;
} else {
@bigStuff@
return "slow"
}
}]
small goFast v1 v2
small goSlow v1 v2
big goFast v1 v2
big goSlow v1 v2
proc dotimes {{n 1000}} {
puts "small goFast: [time {small goFast val1 val2} $n]"
puts "small goSlow: [time {small goSlow val1 val2} $n]"
puts "big goFast: [time {big goFast val1 val2} $n]"
puts "big goSlow: [time {big goSlow val1 val2} $n]"
}