tcl tk new program announcment
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
posted by Unknown @ 2:41 PM
1 Comments:
At Thu Mar 17, 02:47:00 PM 2005,
Unknown said…
i will add some more features, as mouse bindongs, mouse rezise, font resize and other stuff as time goes by. stay tuned!
--fel
Post a Comment
<< Home