This is a page for code that would be too long to paste in the Tcl Chatroom or #Tcl.
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]"
}