TCL/javascript/php stuff

no longer live here

2006-10-19T11:44:00.000-07:00

https://whatagreatday.wordpress.com/

no longer into TCL that much either, now its just PHP.

PHP DOC 0.0.0.0.0.0.0.0.0.0.1

2005-10-04T15:09:00.000-07:00

so, this is the code for the documenter, and some examples of its usage at the bottom, im hoping to improve its lousy colors, and shitty layout soon enough,
if anyone has any ideas on how to improve this , please...


<?php
        # vim: :set wrap!
        # and
        # a whole lot of other stuff

function make($path="./",$mask="*.php",$mode="doc",$key="function",$ch="#"){
        #path must have a trailing slash        , there is no recursion.
        $pat1="/^\s*${key}\s+([^(]*)\s*\(([^\)]*)\)\s*[^{]*{/";
        $pat3="/^\s*$ch(.*)/";
        //$pat1="/^\s*${key}[^{]{/";
        $list=array();  //data list
        $fn=0;//file number
        foreach (glob("$path$mask") as $filename){
                $fun=0;//function number
                ///echo("<hr>");
                if($mode=="doc"){       //documentation
                        $all=file($filename);
                        $list[$fn]=array();
                        $list[$fn]["filename"]=$filename;
                        $list[$fn]["comments"]="";
                        for($i1=1;$i1<count($all);$i1++){       //starts at 1: so that it ignores the <?php tag
                                $list[$fn]["comments"].="\n<br>";
                                if(preg_match($pat3,$all[$i1],$mt)){
                                        $list[$fn]["comments"].="\n<br>".trim($mt[1]);
                                }else{
                                        break;
                                }
                        }
                        $list[$fn]["functions"]=array();

                        $all2=0;
                        for($i=0;$i<count($all);$i++){
                                $mt2=array();
                                if(preg_match($pat1,$all[$i],$mt2)){
                                        //echo("<br><font color=red>funk $all[$i]</font>");
                                        $list[$fn]["functions"][$fun]=array();
                                        $list[$fn]["functions"][$fun]["name"]=trim($mt2[1]);
                                        $list[$fn]["functions"][$fun]["parameters"]=explode(",",trim($mt2[2]));
                                        $list[$fn]["functions"][$fun]["comments"]="";
                                        for($k=$i+1;$k<count($all);$k++){
                                                $mt=array();
                                                if(preg_match($pat3,$all[$k],$mt)){
                                                        $list[$fn]["functions"][$fun]["comments"].="\n<br>".trim($mt[1]);
                                                        //echo("<br><font color=blue>comment $all[$k]</font>");
                                                }else{
                                                        break;
                                                }
                                        }
                                        $i=$k;
                                        $fun++; //yeah, right
                                }else{
                                        //echo("<br>$i:$all[$i] :::".preg_match($pat1,$all[$i]));
                                }

                        }

                }
                if($mode=="make"){      //callerID

                }
                //echo "$filename size " . filesize($filename) . "<br>";
                $fn++;
        }
        //echo("<pre>");print_r($list);echo("</pre>");
        return($list);

}

function show_html_list($list){
        #this function recieves a structured representation
        #of a program and displays it in html.
        $all3="";
        for($i=0;$i<count($list);$i++){
                $fn=$list[$i]["filename"];//filename
                $fc=$list[$i]["comments"];//file comments
                echo("<table width=100% border=1 cellspacing=0 cellpadding=0><tr><td valign=top colspan=2 style='background-color:blue;color:white'><h3>$fn</h3></td></tr>");
                echo("<tr><td style='background-color:rgb(100,100,255);color:white'>comments</td><td>$fc</td></tr>");
                if(count($list[$i]["functions"])>0){
                        echo("<tr><td width=10% valign=top style='background-color:rgb(150,150,200);color:white'>Functions</td><td valign=top>");
                        echo("<table border=1 cellspacing=0 cellpadding=0 width=100% height=100%>");
                        echo("<tr><th style='background-color:darkblue;color:white' width=10%>name</th><th style='background-color:darkblue;color:white'>parameters</th><th style='background-color:darkblue;color:white'>comments</th></tr>");
                        for($i1=0;$i1<count($list[$i]["functions"]);$i1++){
                                $funname=$list[$i]["functions"][$i1]["name"];
                                echo("<tr><td valign=top><b>");
                                echo("$funname</b></td><td valign=top>");
                                $all3.="\ncall[\"$funname\"]=\"$fn\"";

                                $i2=0;
                                echo("<ul>");
                                for($i2=0;$i2<count($list[$i]["functions"][$i1]["parameters"]);$i2++){
                                        echo("<li>".$list[$i]["functions"][$i1]["parameters"][$i2]);
                                        //echo("<br>");
                                }
                                echo("</ul>");
                                echo("</td><td valign=top><pre>");
                                echo($list[$i]["functions"][$i1]["comments"]);
                                echo("</pre></td></tr>");
                                //echo("<pre>");        print_r($list[$i]["functions"]);

                                //echo($list[$i]["functions"][$i1]["name"]);
                        }
                        echo("</table>");
                }
                echo("</td></tr></table><br>");
        }
        echo("<hr>");
        echo("<pre>$all3</pre>");

}
//$l=make("./","f1.php");
$l2=make("../","*.php","doc","function","#");
show_html_list($l2);
$l2=make("../include/","*.php","doc","function","#");
show_html_list($l2);
$l2=make("../modules/","*.php","doc","function","#");
show_html_list($l2);
$l2=make("../media/","*.js","doc","function","//");
show_html_list($l2);

?>

new stuff comming soon!

2005-08-31T09:08:00.000-07:00

wow, its been a while since i dont post, i have been focusing on my old webpage, at geocities, thats basicly a link list of old programs i made 2 years ago, when i was in college.

so anyway, ill be posting new stuff soon enough so stay tuned!,
basicly php and javascript stuff....

perhaps i should have tought that i would expand my programing language interests, when i named the damn thing, now inm stuck with tcl, (not that i dont like tcl, wich is about one of the greatest thing that ever happened to scripting and gui programming since the win32api, in my humble opinion (IMHO , in geekspeak).)

im focusing these days on AJAX programming , testing stuff here and there, who knows, maybe something good will come out from that framework/plattform/whatever

btw, everyone seems to be saying these days "o yeah, i did that 3 years ago", or stuff like "o yeah, i remember doing things like that before anyone else", and i really dont want to fall into that, but...

i did a program that used iframes, and lots of javascript, to connect to php and mysql, and show data without reloading, like in january of 2004, or something like that, it was pretty complex, having 3000+ lines of code, and lots of crazy stuff, like skins and round-shaped buttons, and dhtml menus, and all that javascript crap u can find on the net, just condensed into one huge un-maintainable and just plain ugly, not object oriented program, that ended up not being used by the one who bought it.

so, ill be posting that kind of stuff, in later days,
also i intend to post the newest coolest thing: a php javadoc-like program, that users regexps and things of that nature, to create nice html documents from the source.

see ya

version 2.2.1.4 mar 28 2005

2005-03-28T09:48:00.001-08:00

new in this version:
+font size changeable
+eps support
+delete items
-removed the colors, to make the code clearer
+added the "ts" button for easy access
+real size


#felipevaldez@@ ggmail.ccommmm

#todo: convertir colores a 0,0,0 de rgb OK, tamanyo fuenteOK
#todo: text alignOK text changeOK saveOK load font-changeOk
#
#set f [open /home/keith/.profile]
#while {[gets $f line] >= 0} {
#    puts [string length $line]
#}
#close $f
#

set maxscale 250

set version "2.2.1.4"

set page_wmax 612
set page_hmax 792

set mainfont {fixedsys 10}
set mainbg "black"
set maincolor "blue"

set n 0 ;#element number
set xx 20
set yy 20
set ww 400
set hh 300
set items [list ]       ;#xml
set items2 [list ]      ;#html
set items3 [list ]      ;#php
set cli 0               ;#current List Item (n)
set cf "Courier"        ;#current font
set txt "Data Here"     ;#current data text
set align1 "left"       ;#current data text alignemnt
set x "20"      ;#left
set y "20"
set w "400"
set h "400"
set textcolor "#000000"
set bgcolor "#ffffff"
set bordercolor "#000080"
set border 1
set fontsize 12 ;#default font todo change.
set cn ".g.main.up.d"   ;#canvas name

proc status2 {txt} {
        .g.all.status configure -text $txt
}

proc save_eps {} {
        global cn
        $cn postscript -file "./mine.eps"
}

proc get_decimal {hex} {
        set a1 [string index $hex 0]
        set a2 [string index $hex 0]

        set hexa [list 0 1 2 3 4 5 6 7 8 9 a b c d e f]
        for {set h 0} {$h < [llength $hexa]} {incr h} {
                if {$a1 == [lindex $hexa $h]} {set a11 $h}
                if {$a2 == [lindex $hexa $h]} {set a22 $h}
                }

        set a3 [expr (($a11*16.0)+$a22)/255.0 ]
        return $a3
}
proc fix_color {color} {

        #remove the # char
        set c [string range $color 1 end]
        set red [string range $c 0 1]
        set green [string range $c 2 3]
        set blue [string range $c 4 5]

        set red [get_decimal $red]
        set green [get_decimal $green]
        set blue [get_decimal $blue]
        return "$red,$green,$blue"
}

proc del_all {} {
        #resets the image.      
        global n items items2 items3 cn
        set items [list ]
        set items2 [list ]
        set items3 [list ]
        for {set i 0} {$i<$n} {incr i 1} {
                $cn delete "tx$i"
                $cn delete "el$i"
        }
        .g.all.f23.f7.list delete 0 end
        .g.all.f23.f7.list insert 0 "0"

        update2
}

proc del_item {i} {
        #deletes an specified item, 
        global n items items2 items3 cn
        status2 " del $i : "
        if {$i < $n} {
                #[join $items] 
                set items [lreplace $items $i $i ""]
                set items2 [lreplace $items2 $i $i ""]
                set items3 [lreplace $items3 $i $i ""]
                $cn delete "tx$i"
                $cn delete "tx$i"
                $cn delete "el$i"

                for {set r 0} {$r < [.g.all.f23.f7.list index end]} {incr r} {
                        if {$i == [.g.all.f23.f7.list get $r]} {
                                break;
                        }
                }
                .g.all.f23.f7.list delete $r
                update2
        } else {
                status2 " cant delete:$i "

        }
}

proc change_align {x y} {
        global align1
        set align1 [.g.all.f23.f2.list get @$x,$y]
        status2 "Align set to: $align1"
        update2
        #.g.all.f2.list delete 0 end
        #.g.all.f2.list insert end "op"
}
proc change_item {x y} {
        global cli
        set cli [.g.all.f23.f7.list get @$x,$y]
        status2 "item is now: $cli"
        update2
}
proc change_font_size {x y} {
        global fontsize
        set fontsize [.g.all.f23.f8.list get @$x,$y]
        status2 "font size changed to: $fontsize"
        update2
}

proc change_font_family {x y} {
        global cf
        set cf [.g.all.f23.f9.list get @$x,$y]
        status2 "font  changed to: $cf"
        update2
}

proc setcolor {op} {
        global textcolor bgcolor bordercolor
        if {$op=="text"} {
                set textcolor1 [tk_chooseColor -initialcolor $textcolor -parent . -title "Select Text Color..."]
                if {$textcolor1 != ""} {set textcolor $textcolor1}
                .g.all.c1.btn1 configure -text "tx $textcolor"
                .g.all.c1.btn1 configure -background $textcolor
        } elseif {$op=="bgcolor"} {
                set bgcolor1 [tk_chooseColor -initialcolor $bgcolor -parent . -title "Select Background Color..."]
                if {$bgcolor1 != ""} {set bgcolor $bgcolor1}
                .g.all.c1.btn2 configure -text "bg $bgcolor"
                .g.all.c1.btn2 configure -background $bgcolor
        } elseif {$op=="border"} {
                set bordercolor1 [tk_chooseColor -initialcolor $bordercolor -parent . -title "Select Border Color..."]
                if {$bordercolor1 != ""} {set bordercolor $bordercolor1}
                .g.all.c1.btn3 configure -text "bd $bordercolor"
                .g.all.c1.btn3 configure -background $bordercolor
        }
        update2
}

proc open_file {} {
        set file [tk_getOpenFile  -parent .]
        #file data
        status2 "opening $file"
}
proc save_file {mode} {
        global items items2 items3 n
        set file [tk_getSaveFile  -parent .]
        if {$file != ""} {
                #file data
                if {$mode == "xml"} {
                        set res [regexp ".*\.xml$" $file]
                        if {$res == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.xml"
                        }
                        set f [open $file "w+"]

                        puts $f "<?xml version=\"1.0\"?>\n<pdfdoc>"
                        foreach el $items {
                                puts $f $el
                        }
                        puts $f "\n</pdfdoc>"

                }
                if {$mode == "html"} {
                        set res [regexp ".*\.html$" $file]
                        set res2 [regexp ".*\.htm$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.html"
                        }

                        set f [open $file "w+"]

                        puts $f "<html><head><title>no title</title></head><body>"
                        foreach el $items2 {
                                puts $f $el
                        }
                        puts $f "\n</body></html>"
                }

                if {$mode == "php"} {
                        set res [regexp ".*\.php$" $file]
                        set res2 [regexp ".*\.inc$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.php"
                        }

                        set f [open $file "w+"]

                        puts $f "<?php\n\ninclude(\"pclib34.php\");\n//stuff."
                        foreach el $items3 {
                                puts $f $el
                        }
                        puts $f "\n\n?>"
                }

                close $f
                status2 "saved $n elements to $file in mode:$mode"
        } else {
                status2 "no file selected."
        }
}

proc ts {} {
        #add an item.
        global x y w h n cf items items2 items3 bordercolor textcolor bgcolor align1 fontsize page_hmax
        update2 ;#just in case, just in time.   
        set txt [.g.all.f3.text get 0.0 end]
        #fix colors for compilance with the pdf standards.
        set bc2 [fix_color $bordercolor]
        set tx2 [fix_color $textcolor]
        set bg2 [fix_color $bgcolor]

        set y2 [expr $page_hmax-$y]

        lappend items "\n<item>\n\t<type>text</type>\n\t<id>$n</id>\n\t<x>$x</x>\n\t<y>$y2</y>\n\t<w>$w</w>\n\t<h>$h</h>\n\t<family>$cf</family>\n\t<bordercolor>$bc2</bordercolor>\n\t<color>$tx2</color>\n\t<bgcolor>$bg2</bgcolor>\n\t<format>$txt</format>\n\t<align>$align1</align>\n\t<fontsize>$fontsize</fontsize>\n</item>";
        lappend items2 "\n<div id=a$n style='position:absolute;left:$x;top:$y;width:$w;height:$h;font-family:$cf;font-size:$fontsize;text-size:$fontsize;border:1px solid $bordercolor;color:$textcolor;background-color:$bgcolor;text-align:$align1'> $txt</div>";
        lappend items3 " \n//php$n"

        incr n 1

        .g.all.f23.f7.list insert end "$n"      ;#add to select list

        status2 "created element $n"
        #x:$x y:$y w:$w h:$h cf:$cf"
        #set respuesta [tk_messageBox -message "Desea abandonar la aplicacion?" -type yesno -title Pregunta -icon question ] 

}

#scale stuff: if u want "real" sized data: uncomment line 2 anc comment line 1 
proc sc {s} {
        #return [expr $s/2]
        return $s
}
#special scale for zooming effect
proc sc2 {s} {

        return [expr $s/2]
        #return $s
}

proc dis_check {} {
        #global x y w h page_wmax page_hmax
        #if {$w+$x >= $page_wmax } {
        #       set w [expr $page_wmax-$x];
        #       set ww [expr $page_wmax-$x]
        #}
        #if {$h+$y >= $page_hmax } {
        #       set h [expr $page_hmax-$y]
        #       set hh [expr $page_hmax-$y]
        #       wm title . "beyond"
        #}
        #.g.all.a3.pw set $w
        #.g.all.a4.ph set $h
        #.g.all.a3.txtw configure -text $w
        #.g.all.a4.txth configure -text $h

}
proc pagex { w1 } {

        global x;
        set x $w1;
        dis_check
        update2
}
proc pagey { h } {
        global y;set y $h;
        dis_check
        update2
}
proc pagew { w1 } {
        global w x ww page_wmax;
        set w $w1;
        dis_check
        update2

}
proc pageh { h1 } {
        global h y page_hmax
        set h $h1;
        dis_check
        update2
}

proc gw {a b} {
#gets the width [deprecated]
        if {$b > $a} {
                return [expr $b-$a];
        }
        return [expr $a-$b];
}

proc update2 {} {       ;#make 
        global x y w h cf n textcolor bgcolor bordercolor border txt align1 fontsize cn
        set txt [.g.all.f3.text get 0.0 end]
        $cn delete "el$n"
        $cn delete "tx$n"
        $cn create rectangle [sc $x] [sc $y] [sc [expr $x+$w ]] [sc [expr $y+$h]] -fill $bgcolor -tag "el$n" -outline $bordercolor

        if {$align1=="left"} {
                set s2 "nw"
                set s3 "left"
                set x1 $x
        } elseif {$align1=="center"} {
                set s2 "n"
                set s3 "center"
                set x1 [expr $x+$w/2]
                #set x1 $x

        } elseif {$align1=="right"} {
                set x1 [expr $x+$w]
                set s2 "ne"
                set s3 "right"
        }

        $cn create text  [sc $x1] [sc $y] -tag "tx$n" \
        -text "$txt" -font [list $cf $fontsize] -fill $textcolor \
        -width [sc $w]  -anchor $s2  -justify $s3

        #$cn create oval 10 10 80 80 -fill red -width 4 -tag ovalo 
        #$cn create line 200 10 200 80 300 80 300 10 350 10 -arrow last -tag linea 
        #$cn create text 350 50 -text "Tcl/Tk 8.0" -tag texto 
}
proc st23 {} {
        global xx x
        set xx 40;
        set x 40;
        update2
}
proc exit1 {} {

        #
}

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


######################################################################
        #frame
frame .g
frame .g.all -borderwidth 2
frame .g.all.a1 -borderwidth 2
frame .g.all.a2 -borderwidth 2
frame .g.all.a3 -borderwidth 2
frame .g.all.a4 -borderwidth 2

frame .g.all.c1 -borderwidth 2
#frame .g.all.c2 -borderwidth 2 
#frame .g.all.c3 -borderwidth 2 

frame .g.all.f3 -width 100 -height 40

frame .g.main
frame .g.main.up

frame .g.all.f23
frame .g.all.f23.f2
frame .g.all.f23.f7
frame .g.all.f23.f8
frame .g.all.f23.f9

frame .mBar

        #text entry
entry .g.all.a1.txtx -textvariable xx -width 4
entry .g.all.a2.txty -textvariable yy -width 4
entry .g.all.a3.txtw -textvariable ww -width 4
entry .g.all.a4.txth -textvariable hh -width 4

        #scrolls

scale .g.all.a1.px -from 0 -to $page_wmax -length $maxscale -variable xx -orient horizontal  -command pagex -showvalue 0
scale .g.all.a2.py -from 0 -to $page_hmax -length $maxscale -variable yy -orient horizontal -command pagey -showvalue 0
scale .g.all.a3.pw -from 0 -to $page_wmax -length $maxscale -variable ww -orient horizontal -command pagew -showvalue 0
scale .g.all.a4.ph -from 0 -to $page_hmax -length $maxscale -variable hh -orient horizontal -command pageh -showvalue 0

        #color buttons

button .g.all.c1.btn1 -text "tx $textcolor" -command {setcolor text} -background $textcolor -foreground "white"
button .g.all.c1.btn2 -text "bg $bgcolor" -command {setcolor bgcolor} -background $bgcolor -foreground "white"
button .g.all.c1.btn3 -text "bd $bordercolor" -command {setcolor border} -background $bordercolor -foreground "white"

        #function buttons

button .g.all.c1.btn4 -text "Add" -command {ts}
button .g.all.c1.btn5 -text "Delete" -command {del_item $cli}

#button .g.all.mk -text "make0" -command {ts} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk1 -text "make1" -command {st23} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk2 -text "save" -command {save_file} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk3 -text "open" -command {open_file} -background $mainbg -foreground $maincolor -font $mainfont

#set scc [list "0" "0" $page_hmax $page_wmax]
set scc [list "0" "0" [sc $page_wmax]  [sc $page_hmax]]

canvas $cn -relief sunken  -borderwidth 2 -background white -width [sc2 $page_wmax] -height [sc2 $page_hmax] -scrollregion $scc -xscrollcommand ".g.main.hscroll set" -yscrollcommand ".g.main.up.vscroll set"

scrollbar .g.main.up.vscroll -command "$cn yview"
scrollbar .g.main.hscroll -orient horiz -command "$cn xview"

        #list boxes:align

listbox .g.all.f23.f2.list -width 10 -height 3
#scrollbar .g.all.f2.scroll -command ".g.all.f2.list yview" -background $mainbg 

.g.all.f23.f2.list insert 0 "left"
.g.all.f23.f2.list insert 0 "right"
.g.all.f23.f2.list insert 0 "center"

#item select
#
listbox .g.all.f23.f7.list -width 3 -height 3 -yscrollcommand ".g.all.f23.f7.scroll set"
scrollbar .g.all.f23.f7.scroll -command ".g.all.f23.f7.list yview"
.g.all.f23.f7.list insert 0 "0"

listbox .g.all.f23.f8.list -width 3 -height 3 -yscrollcommand ".g.all.f23.f8.scroll set"
scrollbar .g.all.f23.f8.scroll -command ".g.all.f23.f8.list yview"

.g.all.f23.f8.list insert end "8"
.g.all.f23.f8.list insert end "9"
.g.all.f23.f8.list insert end "10"
.g.all.f23.f8.list insert end "11"
.g.all.f23.f8.list insert end "12"
.g.all.f23.f8.list insert end "14"
.g.all.f23.f8.list insert end "16"
.g.all.f23.f8.list insert end "18"
.g.all.f23.f8.list insert end "20"
.g.all.f23.f8.list insert end "24"
.g.all.f23.f8.list insert end "32"
.g.all.f23.f8.list insert end "48"
.g.all.f23.f8.list insert end "72"
.g.all.f23.f8.list insert end "144"

listbox .g.all.f23.f9.list -width 15 -height 3 -yscrollcommand ".g.all.f23.f9.scroll set"
scrollbar .g.all.f23.f9.scroll -command ".g.all.f23.f9.list yview"

.g.all.f23.f9.list insert end "Courier"
.g.all.f23.f9.list insert end "Helvetica"
#.g.all.f23.f9.list insert end "a0100131"
.g.all.f23.f9.list insert end "Symbol"
.g.all.f23.f9.list insert end "Times-Roman"
#.g.all.f23.f9.list insert end "Times New Roman"
.g.all.f23.f9.list insert end "ZapfDingbats"

.g.all.f23.f9.list insert end "Courier"

entry .g.all.f -textvariable cf
label .g.all.status -text "Ready..."
        #document text
text .g.all.f3.text -width 20 -relief sunken \
        -bd 2 -yscrollcommand ".g.all.f3.scroll set" -setgrid 1 -height 12 -wrap none

.g.all.f3.text insert 0.0 "$txt"

scrollbar .g.all.f3.scroll -command ".g.all.f3.text yview"
                ##-background $mainbg -highlightcolor "red" -highlightbackground "blue"
###########################################
#       menu

menubutton .mBar.file -text File -underline 0 -menu .mBar.file.m
menu .mBar.file.m
#.mBar.file.m add cascade -label "Options" -underline 0 -accelerator => -menu .mBar.file.m.apps
.mBar.file.m add command -label "Add"                   -underline 0 -command {ts}
.mBar.file.m add command -label "Defaults"              -underline 0 -command {st23}
.mBar.file.m add command -label "Open"                  -underline 0 -command {open_file}
.mBar.file.m add command -label "Save XML"              -underline 0 -command {save_file xml}
.mBar.file.m add command -label "Save HTML"             -underline 0 -command {save_file html}
.mBar.file.m add command -label "Save PHP"              -underline 0 -command {save_file php}
.mBar.file.m add command -label "Delete All"            -underline 0 -command {del_all}
.mBar.file.m add command -label "Save PostScript"       -underline 0 -command {save_eps}
.mBar.file.m add command -label "Quit"                  -underline 0 -command {exit1}
#menu .mBar.file.m.apps 
#.mBar.file.m.apps add command -label "add" -command {ts}
#.mBar.file.m.apps add command -label "del_all" -command {del_all}


proc pack_all {} {
        global cn
        pack .g.all.a1.px -side "right"
        pack .g.all.a2.py -side "right"
        pack .g.all.a3.pw -side "right"
        pack .g.all.a4.ph -side "right"

        pack .g.all.a1.txtx -side "right"
        pack .g.all.a2.txty -side "right"
        pack .g.all.a3.txtw -side "right"
        pack .g.all.a4.txth -side "right"


        pack .g.all.c1.btn1 -side "left"
        pack .g.all.c1.btn2 -side "left"
        pack .g.all.c1.btn3 -side "left"
        pack .g.all.c1.btn4 -side "left"
        pack .g.all.c1.btn5 -side "left"

        pack .g.all.a1 -fill x
        pack .g.all.a2 -fill x
        pack .g.all.a3 -fill x
        pack .g.all.a4 -fill x
        pack .g.all.c1 -fill x
        pack .g.all.f -fill x

        pack .g.all.f23.f2.list -fill x
        #pack .g.all.f23.f2.scroll -side right -fill y -expand 1 -fill x
        pack .g.all.f23.f2  -side right

        pack .g.all.f23.f8.scroll -side right -fill y -expand 1
        pack .g.all.f23.f8.list -side right
        pack .g.all.f23.f8 -side right

        pack .g.all.f23.f9.scroll -side right -fill y -expand 1
        pack .g.all.f23.f9.list -side right
        pack .g.all.f23.f9 -side right

        pack .g.all.f23.f7.scroll -side right -fill y -expand 1
        pack .g.all.f23.f7.list -side right
        pack .g.all.f23.f7 -side right


        pack .g.all.f23 -fill x

        pack .g.all.f3.scroll -side right -fill y
        pack .g.all.f3.text -fill x
        #-expand yes -fill both 
        pack .g.all.f3 -fill x

        pack .mBar.file -side left
        pack .mBar -anchor nw -side top

        pack .g.all.status -side bottom -anchor s -fill x
        pack .g.all -side left

        pack $cn -side left -expand yes -fill both
        pack .g.main.up.vscroll -side right -fill y
        pack .g.main.up -side top -expand yes -fill both
        pack .g.main.hscroll -side bottom -fill x
        pack .g.main -side right -expand yes -fill both

        #pack $cn -side left

        #pack .g.grid2  -side right -expand yes -fill both -padx 1 -pady 1 
        #grid rowconfig    .g.grid2 0 -weight 1 -minsize 0
        #grid columnconfig .g.grid2 0 -weight 1 -minsize 0

        #grid $cn -in .g.grid2          -padx 1 -pady 1 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
        #grid .g.vscroll -in .g.grid2   -padx 1 -pady 1 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
        #grid .g.hscroll -in .g.grid2   -padx 1 -pady 1 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news

        #pack $cn -padx 5 -pady 5

        pack .g -side top -fill x
}

proc bind_all {} {
        bind .g.all.f23.f2.list <Double-1> "change_align %x %y"
        bind .g.all.f23.f7.list <Button-1> "change_item %x %y"
        bind .g.all.f23.f8.list <Double-1> "change_font_size %x %y"
        bind .g.all.f23.f9.list <Double-1> "change_font_family %x %y"

        bind .g.all.f3.text <KeyRelease> "update2"
        bind .g.all.f <KeyRelease> "update2"
        bind .g.all.a1.txtx <KeyRelease> {set x $xx;update2}
        bind .g.all.a2.txty <KeyRelease> {set y $yy;update2}
        bind .g.all.a3.txtw <KeyRelease> {set w $ww;update2}
        bind .g.all.a4.txth <KeyRelease> {set h $hh;update2}
}


        wm title . "pdf format editor: v$version"
        #textarea: text, list:font

pack_all
bind_all

version 2.2.1.4 mar 28 2005

2005-03-28T09:48:00.000-08:00

new in this version:
+font size changeable
+eps support
+delete items
-removed the colors, to make the code clearer
+added the "ts" button for easy access
+real size


#felipevaldez@@ ggmail.ccommmm

#todo: convertir colores a 0,0,0 de rgb OK, tamanyo fuenteOK
#todo: text alignOK text changeOK saveOK load font-changeOk
#
#set f [open /home/keith/.profile]
#while {[gets $f line] >= 0} {
#    puts [string length $line]
#}
#close $f
#

set maxscale 250

set version "2.2.1.4"

set page_wmax 612
set page_hmax 792

set mainfont {fixedsys 10}
set mainbg "black"
set maincolor "blue"

set n 0 ;#element number
set xx 20
set yy 20
set ww 400
set hh 300
set items [list ]       ;#xml
set items2 [list ]      ;#html
set items3 [list ]      ;#php
set cli 0               ;#current List Item (n)
set cf "Courier"        ;#current font
set txt "Data Here"     ;#current data text
set align1 "left"       ;#current data text alignemnt
set x "20"      ;#left
set y "20"
set w "400"
set h "400"
set textcolor "#000000"
set bgcolor "#ffffff"
set bordercolor "#000080"
set border 1
set fontsize 12 ;#default font todo change.
set cn ".g.main.up.d"   ;#canvas name

proc status2 {txt} {
        .g.all.status configure -text $txt
}

proc save_eps {} {
        global cn
        $cn postscript -file "./mine.eps"
}

proc get_decimal {hex} {
        set a1 [string index $hex 0]
        set a2 [string index $hex 0]

        set hexa [list 0 1 2 3 4 5 6 7 8 9 a b c d e f]
        for {set h 0} {$h < [llength $hexa]} {incr h} {
                if {$a1 == [lindex $hexa $h]} {set a11 $h}
                if {$a2 == [lindex $hexa $h]} {set a22 $h}
                }

        set a3 [expr (($a11*16.0)+$a22)/255.0 ]
        return $a3
}
proc fix_color {color} {

        #remove the # char
        set c [string range $color 1 end]
        set red [string range $c 0 1]
        set green [string range $c 2 3]
        set blue [string range $c 4 5]

        set red [get_decimal $red]
        set green [get_decimal $green]
        set blue [get_decimal $blue]
        return "$red,$green,$blue"
}

proc del_all {} {
        #resets the image.      
        global n items items2 items3 cn
        set items [list ]
        set items2 [list ]
        set items3 [list ]
        for {set i 0} {$i<$n} {incr i 1} {
                $cn delete "tx$i"
                $cn delete "el$i"
        }
        .g.all.f23.f7.list delete 0 end
        .g.all.f23.f7.list insert 0 "0"

        update2
}

proc del_item {i} {
        #deletes an specified item, 
        global n items items2 items3 cn
        status2 " del $i : "
        if {$i < $n} {
                #[join $items] 
                set items [lreplace $items $i $i ""]
                set items2 [lreplace $items2 $i $i ""]
                set items3 [lreplace $items3 $i $i ""]
                $cn delete "tx$i"
                $cn delete "tx$i"
                $cn delete "el$i"

                for {set r 0} {$r < [.g.all.f23.f7.list index end]} {incr r} {
                        if {$i == [.g.all.f23.f7.list get $r]} {
                                break;
                        }
                }
                .g.all.f23.f7.list delete $r
                update2
        } else {
                status2 " cant delete:$i "

        }
}

proc change_align {x y} {
        global align1
        set align1 [.g.all.f23.f2.list get @$x,$y]
        status2 "Align set to: $align1"
        update2
        #.g.all.f2.list delete 0 end
        #.g.all.f2.list insert end "op"
}
proc change_item {x y} {
        global cli
        set cli [.g.all.f23.f7.list get @$x,$y]
        status2 "item is now: $cli"
        update2
}
proc change_font_size {x y} {
        global fontsize
        set fontsize [.g.all.f23.f8.list get @$x,$y]
        status2 "font size changed to: $fontsize"
        update2
}

proc change_font_family {x y} {
        global cf
        set cf [.g.all.f23.f9.list get @$x,$y]
        status2 "font  changed to: $cf"
        update2
}

proc setcolor {op} {
        global textcolor bgcolor bordercolor
        if {$op=="text"} {
                set textcolor1 [tk_chooseColor -initialcolor $textcolor -parent . -title "Select Text Color..."]
                if {$textcolor1 != ""} {set textcolor $textcolor1}
                .g.all.c1.btn1 configure -text "tx $textcolor"
                .g.all.c1.btn1 configure -background $textcolor
        } elseif {$op=="bgcolor"} {
                set bgcolor1 [tk_chooseColor -initialcolor $bgcolor -parent . -title "Select Background Color..."]
                if {$bgcolor1 != ""} {set bgcolor $bgcolor1}
                .g.all.c1.btn2 configure -text "bg $bgcolor"
                .g.all.c1.btn2 configure -background $bgcolor
        } elseif {$op=="border"} {
                set bordercolor1 [tk_chooseColor -initialcolor $bordercolor -parent . -title "Select Border Color..."]
                if {$bordercolor1 != ""} {set bordercolor $bordercolor1}
                .g.all.c1.btn3 configure -text "bd $bordercolor"
                .g.all.c1.btn3 configure -background $bordercolor
        }
        update2
}

proc open_file {} {
        set file [tk_getOpenFile  -parent .]
        #file data
        status2 "opening $file"
}
proc save_file {mode} {
        global items items2 items3 n
        set file [tk_getSaveFile  -parent .]
        if {$file != ""} {
                #file data
                if {$mode == "xml"} {
                        set res [regexp ".*\.xml$" $file]
                        if {$res == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.xml"
                        }
                        set f [open $file "w+"]

                        puts $f "<?xml version=\"1.0\"?>\n<pdfdoc>"
                        foreach el $items {
                                puts $f $el
                        }
                        puts $f "\n</pdfdoc>"

                }
                if {$mode == "html"} {
                        set res [regexp ".*\.html$" $file]
                        set res2 [regexp ".*\.htm$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.html"
                        }

                        set f [open $file "w+"]

                        puts $f "<html><head><title>no title</title></head><body>"
                        foreach el $items2 {
                                puts $f $el
                        }
                        puts $f "\n</body></html>"
                }

                if {$mode == "php"} {
                        set res [regexp ".*\.php$" $file]
                        set res2 [regexp ".*\.inc$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.php"
                        }

                        set f [open $file "w+"]

                        puts $f "<?php\n\ninclude(\"pclib34.php\");\n//stuff."
                        foreach el $items3 {
                                puts $f $el
                        }
                        puts $f "\n\n?>"
                }

                close $f
                status2 "saved $n elements to $file in mode:$mode"
        } else {
                status2 "no file selected."
        }
}

proc ts {} {
        #add an item.
        global x y w h n cf items items2 items3 bordercolor textcolor bgcolor align1 fontsize page_hmax
        update2 ;#just in case, just in time.   
        set txt [.g.all.f3.text get 0.0 end]
        #fix colors for compilance with the pdf standards.
        set bc2 [fix_color $bordercolor]
        set tx2 [fix_color $textcolor]
        set bg2 [fix_color $bgcolor]

        set y2 [expr $page_hmax-$y]

        lappend items "\n<item>\n\t<type>text</type>\n\t<id>$n</id>\n\t<x>$x</x>\n\t<y>$y2</y>\n\t<w>$w</w>\n\t<h>$h</h>\n\t<family>$cf</family>\n\t<bordercolor>$bc2</bordercolor>\n\t<color>$tx2</color>\n\t<bgcolor>$bg2</bgcolor>\n\t<format>$txt</format>\n\t<align>$align1</align>\n\t<fontsize>$fontsize</fontsize>\n</item>";
        lappend items2 "\n<div id=a$n style='position:absolute;left:$x;top:$y;width:$w;height:$h;font-family:$cf;font-size:$fontsize;text-size:$fontsize;border:1px solid $bordercolor;color:$textcolor;background-color:$bgcolor;text-align:$align1'> $txt</div>";
        lappend items3 " \n//php$n"

        incr n 1

        .g.all.f23.f7.list insert end "$n"      ;#add to select list

        status2 "created element $n"
        #x:$x y:$y w:$w h:$h cf:$cf"
        #set respuesta [tk_messageBox -message "Desea abandonar la aplicacion?" -type yesno -title Pregunta -icon question ] 

}

#scale stuff: if u want "real" sized data: uncomment line 2 anc comment line 1 
proc sc {s} {
        #return [expr $s/2]
        return $s
}
#special scale for zooming effect
proc sc2 {s} {

        return [expr $s/2]
        #return $s
}

proc dis_check {} {
        #global x y w h page_wmax page_hmax
        #if {$w+$x >= $page_wmax } {
        #       set w [expr $page_wmax-$x];
        #       set ww [expr $page_wmax-$x]
        #}
        #if {$h+$y >= $page_hmax } {
        #       set h [expr $page_hmax-$y]
        #       set hh [expr $page_hmax-$y]
        #       wm title . "beyond"
        #}
        #.g.all.a3.pw set $w
        #.g.all.a4.ph set $h
        #.g.all.a3.txtw configure -text $w
        #.g.all.a4.txth configure -text $h

}
proc pagex { w1 } {

        global x;
        set x $w1;
        dis_check
        update2
}
proc pagey { h } {
        global y;set y $h;
        dis_check
        update2
}
proc pagew { w1 } {
        global w x ww page_wmax;
        set w $w1;
        dis_check
        update2

}
proc pageh { h1 } {
        global h y page_hmax
        set h $h1;
        dis_check
        update2
}

proc gw {a b} {
#gets the width [deprecated]
        if {$b > $a} {
                return [expr $b-$a];
        }
        return [expr $a-$b];
}

proc update2 {} {       ;#make 
        global x y w h cf n textcolor bgcolor bordercolor border txt align1 fontsize cn
        set txt [.g.all.f3.text get 0.0 end]
        $cn delete "el$n"
        $cn delete "tx$n"
        $cn create rectangle [sc $x] [sc $y] [sc [expr $x+$w ]] [sc [expr $y+$h]] -fill $bgcolor -tag "el$n" -outline $bordercolor

        if {$align1=="left"} {
                set s2 "nw"
                set s3 "left"
                set x1 $x
        } elseif {$align1=="center"} {
                set s2 "n"
                set s3 "center"
                set x1 [expr $x+$w/2]
                #set x1 $x

        } elseif {$align1=="right"} {
                set x1 [expr $x+$w]
                set s2 "ne"
                set s3 "right"
        }

        $cn create text  [sc $x1] [sc $y] -tag "tx$n" \
        -text "$txt" -font [list $cf $fontsize] -fill $textcolor \
        -width [sc $w]  -anchor $s2  -justify $s3

        #$cn create oval 10 10 80 80 -fill red -width 4 -tag ovalo 
        #$cn create line 200 10 200 80 300 80 300 10 350 10 -arrow last -tag linea 
        #$cn create text 350 50 -text "Tcl/Tk 8.0" -tag texto 
}
proc st23 {} {
        global xx x
        set xx 40;
        set x 40;
        update2
}
proc exit1 {} {

        #
}

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


######################################################################
        #frame
frame .g
frame .g.all -borderwidth 2
frame .g.all.a1 -borderwidth 2
frame .g.all.a2 -borderwidth 2
frame .g.all.a3 -borderwidth 2
frame .g.all.a4 -borderwidth 2

frame .g.all.c1 -borderwidth 2
#frame .g.all.c2 -borderwidth 2 
#frame .g.all.c3 -borderwidth 2 

frame .g.all.f3 -width 100 -height 40

frame .g.main
frame .g.main.up

frame .g.all.f23
frame .g.all.f23.f2
frame .g.all.f23.f7
frame .g.all.f23.f8
frame .g.all.f23.f9

frame .mBar

        #text entry
entry .g.all.a1.txtx -textvariable xx -width 4
entry .g.all.a2.txty -textvariable yy -width 4
entry .g.all.a3.txtw -textvariable ww -width 4
entry .g.all.a4.txth -textvariable hh -width 4

        #scrolls

scale .g.all.a1.px -from 0 -to $page_wmax -length $maxscale -variable xx -orient horizontal  -command pagex -showvalue 0
scale .g.all.a2.py -from 0 -to $page_hmax -length $maxscale -variable yy -orient horizontal -command pagey -showvalue 0
scale .g.all.a3.pw -from 0 -to $page_wmax -length $maxscale -variable ww -orient horizontal -command pagew -showvalue 0
scale .g.all.a4.ph -from 0 -to $page_hmax -length $maxscale -variable hh -orient horizontal -command pageh -showvalue 0

        #color buttons

button .g.all.c1.btn1 -text "tx $textcolor" -command {setcolor text} -background $textcolor -foreground "white"
button .g.all.c1.btn2 -text "bg $bgcolor" -command {setcolor bgcolor} -background $bgcolor -foreground "white"
button .g.all.c1.btn3 -text "bd $bordercolor" -command {setcolor border} -background $bordercolor -foreground "white"

        #function buttons

button .g.all.c1.btn4 -text "Add" -command {ts}
button .g.all.c1.btn5 -text "Delete" -command {del_item $cli}

#button .g.all.mk -text "make0" -command {ts} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk1 -text "make1" -command {st23} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk2 -text "save" -command {save_file} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk3 -text "open" -command {open_file} -background $mainbg -foreground $maincolor -font $mainfont

#set scc [list "0" "0" $page_hmax $page_wmax]
set scc [list "0" "0" [sc $page_wmax]  [sc $page_hmax]]

canvas $cn -relief sunken  -borderwidth 2 -background white -width [sc2 $page_wmax] -height [sc2 $page_hmax] -scrollregion $scc -xscrollcommand ".g.main.hscroll set" -yscrollcommand ".g.main.up.vscroll set"

scrollbar .g.main.up.vscroll -command "$cn yview"
scrollbar .g.main.hscroll -orient horiz -command "$cn xview"

        #list boxes:align

listbox .g.all.f23.f2.list -width 10 -height 3
#scrollbar .g.all.f2.scroll -command ".g.all.f2.list yview" -background $mainbg 

.g.all.f23.f2.list insert 0 "left"
.g.all.f23.f2.list insert 0 "right"
.g.all.f23.f2.list insert 0 "center"

#item select
#
listbox .g.all.f23.f7.list -width 3 -height 3 -yscrollcommand ".g.all.f23.f7.scroll set"
scrollbar .g.all.f23.f7.scroll -command ".g.all.f23.f7.list yview"
.g.all.f23.f7.list insert 0 "0"

listbox .g.all.f23.f8.list -width 3 -height 3 -yscrollcommand ".g.all.f23.f8.scroll set"
scrollbar .g.all.f23.f8.scroll -command ".g.all.f23.f8.list yview"

.g.all.f23.f8.list insert end "8"
.g.all.f23.f8.list insert end "9"
.g.all.f23.f8.list insert end "10"
.g.all.f23.f8.list insert end "11"
.g.all.f23.f8.list insert end "12"
.g.all.f23.f8.list insert end "14"
.g.all.f23.f8.list insert end "16"
.g.all.f23.f8.list insert end "18"
.g.all.f23.f8.list insert end "20"
.g.all.f23.f8.list insert end "24"
.g.all.f23.f8.list insert end "32"
.g.all.f23.f8.list insert end "48"
.g.all.f23.f8.list insert end "72"
.g.all.f23.f8.list insert end "144"

listbox .g.all.f23.f9.list -width 15 -height 3 -yscrollcommand ".g.all.f23.f9.scroll set"
scrollbar .g.all.f23.f9.scroll -command ".g.all.f23.f9.list yview"

.g.all.f23.f9.list insert end "Courier"
.g.all.f23.f9.list insert end "Helvetica"
#.g.all.f23.f9.list insert end "a0100131"
.g.all.f23.f9.list insert end "Symbol"
.g.all.f23.f9.list insert end "Times-Roman"
#.g.all.f23.f9.list insert end "Times New Roman"
.g.all.f23.f9.list insert end "ZapfDingbats"

.g.all.f23.f9.list insert end "Courier"

entry .g.all.f -textvariable cf
label .g.all.status -text "Ready..."
        #document text
text .g.all.f3.text -width 20 -relief sunken \
        -bd 2 -yscrollcommand ".g.all.f3.scroll set" -setgrid 1 -height 12 -wrap none

.g.all.f3.text insert 0.0 "$txt"

scrollbar .g.all.f3.scroll -command ".g.all.f3.text yview"
                ##-background $mainbg -highlightcolor "red" -highlightbackground "blue"
###########################################
#       menu

menubutton .mBar.file -text File -underline 0 -menu .mBar.file.m
menu .mBar.file.m
#.mBar.file.m add cascade -label "Options" -underline 0 -accelerator => -menu .mBar.file.m.apps
.mBar.file.m add command -label "Add"                   -underline 0 -command {ts}
.mBar.file.m add command -label "Defaults"              -underline 0 -command {st23}
.mBar.file.m add command -label "Open"                  -underline 0 -command {open_file}
.mBar.file.m add command -label "Save XML"              -underline 0 -command {save_file xml}
.mBar.file.m add command -label "Save HTML"             -underline 0 -command {save_file html}
.mBar.file.m add command -label "Save PHP"              -underline 0 -command {save_file php}
.mBar.file.m add command -label "Delete All"            -underline 0 -command {del_all}
.mBar.file.m add command -label "Save PostScript"       -underline 0 -command {save_eps}
.mBar.file.m add command -label "Quit"                  -underline 0 -command {exit1}
#menu .mBar.file.m.apps 
#.mBar.file.m.apps add command -label "add" -command {ts}
#.mBar.file.m.apps add command -label "del_all" -command {del_all}


proc pack_all {} {
        global cn
        pack .g.all.a1.px -side "right"
        pack .g.all.a2.py -side "right"
        pack .g.all.a3.pw -side "right"
        pack .g.all.a4.ph -side "right"

        pack .g.all.a1.txtx -side "right"
        pack .g.all.a2.txty -side "right"
        pack .g.all.a3.txtw -side "right"
        pack .g.all.a4.txth -side "right"


        pack .g.all.c1.btn1 -side "left"
        pack .g.all.c1.btn2 -side "left"
        pack .g.all.c1.btn3 -side "left"
        pack .g.all.c1.btn4 -side "left"
        pack .g.all.c1.btn5 -side "left"

        pack .g.all.a1 -fill x
        pack .g.all.a2 -fill x
        pack .g.all.a3 -fill x
        pack .g.all.a4 -fill x
        pack .g.all.c1 -fill x
        pack .g.all.f -fill x

        pack .g.all.f23.f2.list -fill x
        #pack .g.all.f23.f2.scroll -side right -fill y -expand 1 -fill x
        pack .g.all.f23.f2  -side right

        pack .g.all.f23.f8.scroll -side right -fill y -expand 1
        pack .g.all.f23.f8.list -side right
        pack .g.all.f23.f8 -side right

        pack .g.all.f23.f9.scroll -side right -fill y -expand 1
        pack .g.all.f23.f9.list -side right
        pack .g.all.f23.f9 -side right

        pack .g.all.f23.f7.scroll -side right -fill y -expand 1
        pack .g.all.f23.f7.list -side right
        pack .g.all.f23.f7 -side right


        pack .g.all.f23 -fill x

        pack .g.all.f3.scroll -side right -fill y
        pack .g.all.f3.text -fill x
        #-expand yes -fill both 
        pack .g.all.f3 -fill x

        pack .mBar.file -side left
        pack .mBar -anchor nw -side top

        pack .g.all.status -side bottom -anchor s -fill x
        pack .g.all -side left

        pack $cn -side left -expand yes -fill both
        pack .g.main.up.vscroll -side right -fill y
        pack .g.main.up -side top -expand yes -fill both
        pack .g.main.hscroll -side bottom -fill x
        pack .g.main -side right -expand yes -fill both

        #pack $cn -side left

        #pack .g.grid2  -side right -expand yes -fill both -padx 1 -pady 1 
        #grid rowconfig    .g.grid2 0 -weight 1 -minsize 0
        #grid columnconfig .g.grid2 0 -weight 1 -minsize 0

        #grid $cn -in .g.grid2          -padx 1 -pady 1 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
        #grid .g.vscroll -in .g.grid2   -padx 1 -pady 1 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
        #grid .g.hscroll -in .g.grid2   -padx 1 -pady 1 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news

        #pack $cn -padx 5 -pady 5

        pack .g -side top -fill x
}

proc bind_all {} {
        bind .g.all.f23.f2.list <Double-1> "change_align %x %y"
        bind .g.all.f23.f7.list <Button-1> "change_item %x %y"
        bind .g.all.f23.f8.list <Double-1> "change_font_size %x %y"
        bind .g.all.f23.f9.list <Double-1> "change_font_family %x %y"

        bind .g.all.f3.text <KeyRelease> "update2"
        bind .g.all.f <KeyRelease> "update2"
        bind .g.all.a1.txtx <KeyRelease> {set x $xx;update2}
        bind .g.all.a2.txty <KeyRelease> {set y $yy;update2}
        bind .g.all.a3.txtw <KeyRelease> {set w $ww;update2}
        bind .g.all.a4.txth <KeyRelease> {set h $hh;update2}
}


        wm title . "pdf format editor: v$version"
        #textarea: text, list:font

pack_all
bind_all

tcl tk new program announcment

2005-03-17T14:41:00.001-08:00

here.

a


#felipevaldez@@ ggmail.ccommmm


#todo: text alignOK text changeOK saveOK load font-changeOk
#
#set f [open /home/keith/.profile]
#while {[gets $f line] >= 0} {
#    puts [string length $line]
#}
#close $f
#

set version "2.2"

set page_wmax 612
set page_hmax 792

set mainfont {fixedsys 10}
set mainbg "black"
set maincolor "blue"

set n 0 ;#element number
set xx 20
set yy 20
set ww 400
set hh 300
set items [list ]       ;#xml
set items2 [list ]      ;#html
set items3 [list ]      ;#php
set cf "Times New Roman" ;#current font
set txt "Data Here"     ;#current data text
set align1 "left"       ;#current data text alignemnt
set x "20"      ;#left
set y "20"
set w "400"
set h "400"
set textcolor "#000000"
set bgcolor "#0000ff"
set bordercolor "#ff00ff"
set border 1

proc del_all {} {
        #resets the image.      
        global n items items2 items3
        set items [list ]
        set items2 [list ]
        set items3 [list ]
        for {set i 0} {$i<$n} {incr i 1} {
                .g.d delete "tx$i"
                .g.d delete "el$i"
        }
        update2
}

proc change_align {x y} {
        global align1
        set align1 [.g.all.f2.list get @$x,$y]
        .status configure -text "Align set to: $align1"
        update2
        #.g.all.f2.list delete 0 end
        #.g.all.f2.list insert end "op"
}

proc setcolor {op} {
        global textcolor bgcolor bordercolor
        if {$op=="text"} {
                set textcolor1 [tk_chooseColor -initialcolor $textcolor -parent . -title "Select Text Color..."]
                if {$textcolor1 != ""} {set textcolor $textcolor1}
                .g.all.c1.btn configure -text $textcolor
                .g.all.c1.btn configure -background $textcolor
        } elseif {$op=="bgcolor"} {
                set bgcolor1 [tk_chooseColor -initialcolor $bgcolor -parent . -title "Select Background Color..."]
                if {$bgcolor1 != ""} {set bgcolor $bgcolor1}
                .g.all.c2.btn configure -text $bgcolor
                .g.all.c2.btn configure -background $bgcolor
        } elseif {$op=="border"} {
                set bordercolor1 [tk_chooseColor -initialcolor $bordercolor -parent . -title "Select Border Color..."]
                if {$bordercolor1 != ""} {set bordercolor $bordercolor1}
                .g.all.c3.btn configure -text $bordercolor
                .g.all.c3.btn configure -background $bordercolor
        }
        update2
}

proc open_file {} {
        set file [tk_getOpenFile  -parent .]
        #file data
        .status configure -text "opening $file"
}
proc save_file {mode} {
        global items items2 items3 n
        set file [tk_getSaveFile  -parent .]
        if {$file != ""} {
                #file data
                if {$mode == "xml"} {
                        set res [regexp ".*\.xml$" $file]
                        if {$res == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.xml"
                        }
                        set f [open $file "w+"]

                        puts $f "<?xml version=\"1.0\"?>\n<pdfdoc>"
                        foreach el $items {
                                puts $f $el
                        }
                        puts $f "\n</pdfdoc>"

                }
                if {$mode == "html"} {
                        set res [regexp ".*\.html$" $file]
                        set res2 [regexp ".*\.htm$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.html"
                        }

                        set f [open $file "w+"]

                        puts $f "<html><head><title>no title</title></head><body>"
                        foreach el $items2 {
                                puts $f $el
                        }
                        puts $f "\n</body></html>"
                }

                if {$mode == "php"} {
                        set res [regexp ".*\.php$" $file]
                        set res2 [regexp ".*\.inc$" $file]
                        if {$res == 1 || $res2 == 1} {
                                ##wm title . "yes"
                        } else {
                                ##wm title . "no"
                                set file "$file.php"
                        }

                        set f [open $file "w+"]

                        puts $f "<?php\n\ninclude(\"pclib34.php\");\n//stuff."
                        foreach el $items3 {
                                puts $f $el
                        }
                        puts $f "\n\n?>"
                }

                close $f
                .status configure -text "saved $n elements to $file in mode:$mode"
        } else {
                .status configure -text "no file selected."
        }
}

proc ts {} {
        global x y w h n cf items items2 items3 bordercolor textcolor bgcolor align1
        update2 ;#just in case, just in time.   
        set txt [.g.all.f3.text get 0.0 end]
        lappend items "\n<item>\n\t<id>$n</id>\n\t<x>$x</x>\n\t<y>$y</y>\n\t<w>$w</w>\n\t<h>$h</h>\n\t<font>$cf</font>\n\t<bordercolor>$bordercolor</bordercolor>\n\t<textcolor>$textcolor</textcolor>\n\t<bgcolor>$bgcolor</bgcolor>\n\t<text>$txt</text>\n\t<align>$align1</align>\n</item>";
        lappend items2 "\n<div id=a$n style='position:absolute;left:$x;top:$y;width:$w;height:$h;font-family:$cf;border:1px solid $bordercolor;color:$textcolor;background-color:$bgcolor;text-align:$align1'> $txt</div>";
        lappend items3 " \n//php$n"

        incr n 1
        .status configure -text "created element $n"
        #x:$x y:$y w:$w h:$h cf:$cf"
        #set respuesta [tk_messageBox -message "Desea abandonar la aplicacion?" -type yesno -title Pregunta -icon question ] 
}

#scale stuff: if u want "real" sized data: uncomment line 2 anc comment line 1 
proc sc {s} {
        return [expr $s/2]
        #return $s
}

proc dis_check {} {
        #global x y w h page_wmax page_hmax
        #if {$w+$x >= $page_wmax } {
        #       set w [expr $page_wmax-$x];
        #       set ww [expr $page_wmax-$x]
        #}
        #if {$h+$y >= $page_hmax } {
        #       set h [expr $page_hmax-$y]
        #       set hh [expr $page_hmax-$y]
        #       wm title . "beyond"
        #}
        #.g.all.a3.pw set $w
        #.g.all.a4.ph set $h
        #.g.all.a3.txtw configure -text $w
        #.g.all.a4.txth configure -text $h

}
proc pagex { w1 } {

        global x;
        set x $w1;
        dis_check
        update2
}
proc pagey { h } {
        global y;set y $h;
        dis_check
        update2
}
proc pagew { w1 } {
        global w x ww page_wmax;
        set w $w1;
        dis_check
        update2

}
proc pageh { h1 } {
        global h y page_hmax
        set h $h1;
        dis_check
        update2
}

proc gw {a b} {
#gets the width [deprecated]
        if {$b > $a} {
                return [expr $b-$a];
        }
        return [expr $a-$b];
}

proc update2 {} {       ;#make 
        global x y w h cf n textcolor bgcolor bordercolor border txt align1
        set txt [.g.all.f3.text get 0.0 end]
        .g.d delete "el$n"
        .g.d delete "tx$n"
        .g.d create rectangle [sc $x] [sc $y] [sc [expr $x+$w ]] [sc [expr $y+$h]] -fill $bgcolor -tag "el$n" -outline $bordercolor

        if {$align1=="left"} {
                set s2 "nw"
                set s3 "left"
                set x1 $x
        } elseif {$align1=="center"} {
                set s2 "n"
                set s3 "center"
                set x1 [expr $x+$w/2]
                #set x1 $x

        } elseif {$align1=="right"} {
                set x1 [expr $x+$w]
                set s2 "ne"
                set s3 "right"
        }

        .g.d create text  [sc $x1] [sc $y] -tag "tx$n" \
        -text "$txt" -font [list $cf 12] -fill $textcolor \
        -width [sc $w]  -anchor $s2  -justify $s3

        #.g.d create oval 10 10 80 80 -fill red -width 4 -tag ovalo 
        #.g.d create line 200 10 200 80 300 80 300 10 350 10 -arrow last -tag linea 
        #.g.d create text 350 50 -text "Tcl/Tk 8.0" -tag texto 
}
proc st23 {} {
        global xx x
        set xx 40;
        set x 40;
        update2
}
proc exit1 {} {

        #
}
        #frame
frame .g -background $mainbg
frame .g.all -borderwidth 2 -background $mainbg
frame .g.all.a1 -borderwidth 2 -background $mainbg
frame .g.all.a2 -borderwidth 2 -background $mainbg
frame .g.all.a3 -borderwidth 2 -background $mainbg
frame .g.all.a4 -borderwidth 2 -background $mainbg
frame .g.all.c1 -borderwidth 2 -background $mainbg
frame .g.all.c2 -borderwidth 2 -background $mainbg
frame .g.all.c3 -borderwidth 2 -background $mainbg
frame .g.all.f3 -width 100 -height 40

        #labels
label .g.all.a1.lbl -text "Left" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.a2.lbl -text "Top" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.a3.lbl -text "Width" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.a4.lbl -text "Height" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.c1.lbl -text "Text" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.c2.lbl -text "Background" -background $mainbg -foreground $maincolor -font $mainfont
label .g.all.c3.lbl -text "Border" -background $mainbg -foreground $maincolor -font $mainfont

        #text entry
entry .g.all.a1.txtx -textvariable xx -width 4 -background $mainbg -foreground $maincolor -font $mainfont
entry .g.all.a2.txty -textvariable yy -width 4 -background $mainbg -foreground $maincolor -font $mainfont
entry .g.all.a3.txtw -textvariable ww -width 4 -background $mainbg -foreground $maincolor -font $mainfont
entry .g.all.a4.txth -textvariable hh -width 4 -background $mainbg -foreground $maincolor -font $mainfont

        #scrolls
scale .g.all.a1.px -from 0 -to $page_wmax -length 100 -variable xx -orient horizontal  -command pagex -showvalue 0 -background $mainbg -foreground $maincolor -font $mainfont
scale .g.all.a2.py -from 0 -to $page_hmax -length 100 -variable yy -orient horizontal -command pagey -showvalue 0 -background $mainbg -foreground $maincolor -font $mainfont
scale .g.all.a3.pw -from 0 -to $page_wmax -length 100 -variable ww -orient horizontal -command pagew -showvalue 0 -background $mainbg -foreground $maincolor -font $mainfont
scale .g.all.a4.ph -from 0 -to $page_hmax -length 100 -variable hh -orient horizontal -command pageh -showvalue 0 -background $mainbg -foreground $maincolor -font $mainfont

        #color buttons
button .g.all.c1.btn -text $textcolor -command {setcolor text} -background $textcolor -foreground "white"
button .g.all.c2.btn -text $bgcolor -command {setcolor bgcolor} -background $bgcolor -foreground "white"
button .g.all.c3.btn -text $bordercolor -command {setcolor border} -background $bordercolor -foreground "white"

        #function buttons
#button .g.all.mk -text "make0" -command {ts} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk1 -text "make1" -command {st23} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk2 -text "save" -command {save_file} -background $mainbg -foreground $maincolor -font $mainfont
#button .g.all.mk3 -text "open" -command {open_file} -background $mainbg -foreground $maincolor -font $mainfont

canvas .g.d -background white -width [sc $page_wmax] -height [sc $page_hmax]

        #list boxes:align
frame .g.all.f2 -background $mainbg
#-yscrollcommand ".g.all.f2.scroll set"
listbox .g.all.f2.list -width 20 -height 0 -background $mainbg -foreground $maincolor -font $mainfont
#scrollbar .g.all.f2.scroll -command ".g.all.f2.list yview" -background $mainbg 

.g.all.f2.list insert 0 "left"
.g.all.f2.list insert 0 "right"
.g.all.f2.list insert 0 "center"

entry .g.all.f -textvariable cf -background $mainbg -foreground $maincolor -font $mainfont
label .status -text "mine" -background $mainbg -foreground $maincolor -font $mainfont
        #document text
text .g.all.f3.text -width 20 -relief sunken \
        -bd 2 -yscrollcommand ".g.all.f3.scroll set" -setgrid 1 -height 5 -wrap none \
        -background $mainbg -foreground $maincolor -font $mainfont
scrollbar .g.all.f3.scroll -command ".g.all.f3.text yview"
                ##-background $mainbg -highlightcolor "red" -highlightbackground "blue"
###########################################
#       menu
frame .mBar -background $mainbg
menubutton .mBar.file -text File -underline 0 -menu .mBar.file.m
menu .mBar.file.m -background $mainbg -foreground $maincolor -font $mainfont
#.mBar.file.m add cascade -label "Options" -underline 0 -accelerator => -menu .mBar.file.m.apps
.mBar.file.m add command -label "Add"           -underline 0 -command {ts}
.mBar.file.m add command -label "Defaults"      -underline 0 -command {st23}
.mBar.file.m add command -label "Open"          -underline 0 -command {open_file}
.mBar.file.m add command -label "Save XML"      -underline 0 -command {save_file xml}
.mBar.file.m add command -label "Save HTML"     -underline 0 -command {save_file html}
.mBar.file.m add command -label "Save PHP"      -underline 0 -command {save_file php}
.mBar.file.m add command -label "Delete All"    -underline 0 -command {del_all}
.mBar.file.m add command -label "Quit"          -underline 0 -command {exit1}
#menu .mBar.file.m.apps 
#.mBar.file.m.apps add command -label "add" -command {ts}
#.mBar.file.m.apps add command -label "del_all" -command {del_all}

pack .g.all.a1.lbl -side "left"
pack .g.all.a2.lbl -side "left"
pack .g.all.a3.lbl -side "left"
pack .g.all.a4.lbl -side "left"

pack .g.all.a1.px -side "right"
pack .g.all.a2.py -side "right"
pack .g.all.a3.pw -side "right"
pack .g.all.a4.ph -side "right"

pack .g.all.a1.txtx -side "right"
pack .g.all.a2.txty -side "right"
pack .g.all.a3.txtw -side "right"
pack .g.all.a4.txth -side "right"

pack .g.all.c1.lbl -side "left"
pack .g.all.c2.lbl -side "left"
pack .g.all.c3.lbl -side "left"

pack .g.all.c1.btn -side "right"
pack .g.all.c2.btn -side "right"
pack .g.all.c3.btn -side "right"

pack .g.all.a1 -fill x
pack .g.all.a2 -fill x
pack .g.all.a3 -fill x
pack .g.all.a4 -fill x
pack .g.all.c1 -fill x
pack .g.all.c2 -fill x
pack .g.all.c3 -fill x
pack .g.all.f -fill x

pack .g.all.f2.list -fill x
#pack .g.all.f2.scroll -side right -fill y -expand 1 -fill x
pack .g.all.f2 -fill x

#pack .g.all.mk 
#pack .g.all.mk1 
#pack .g.all.mk2 
#pack .g.all.mk3 

pack .g.all.f3.scroll -side right -fill y
pack .g.all.f3.text -fill x
#-expand yes -fill both 
pack .g.all.f3 -fill x

pack .mBar.file -side left
pack .mBar -anchor nw -side top

pack .status -side bottom -anchor sw -fill x
pack .g.all -side left
pack .g.d -side right -padx 5 -pady 5
pack .g -side top -fill x

bind .g.all.f2.list <Double-1> "change_align %x %y"
bind .g.all.f3.text <KeyRelease> "update2"
bind .g.all.f <KeyRelease> "update2"
bind .g.all.a1.txtx <KeyRelease> "update2"
bind .g.all.a2.txty <KeyRelease> "update2"
bind .g.all.a3.txtw <KeyRelease> "update2"
bind .g.all.a4.txth <KeyRelease> "update2"

# Se inserta el texto en el widget 
.g.all.f3.text insert 0.0 "$txt"

. configure -background $mainbg

wm title . "pdf format editor: v$version"
#textarea: text, list:font