I'd like to show some animated GIFs (mostly for "Tip-of-the-Day" screencasts) in my Tcl/Tk application.
Following https://stackoverflow.com/a/28797669/1169096, I've created this small script to play back an animated GIF in a loop:
proc nextFrame {image {time 500} {index 0}} {
if { [ catch {
$image configure -format "gif -index $index"
} stderr ] } {
set index -1
}
set nextIndex [expr $index + 1]
after $time nextFrame $image $time $nextIndex
}
set img [image create photo -file "animated.gif"]
label .w -image $img
pack .w
nextFrame $img 100
This basically works, but unfortunately it has problems with rendering the GIFs correctly.
Here's an animaged GIF i created with peek:
E.g.
Playing this back with my Tcl/Tk script, i get this:
As you can see, there are severe rendering issues: colors are displayed wrongly, parts of the frames are simply missing/left grey,...)
I think the problem might be related to the way peek stores the animation sequence, using some simple inter-frame compression (by using subimages to update frames that only partially change - something quite typical in screencasts of applications, i guess)
$ identify animated.gif
animated.gif[0] GIF 895x718 895x718+0+0 8-bit sRGB 256c 0.000u 0:00.001
animated.gif[1] GIF 1x1 895x718+894+717 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[2] GIF 1x1 895x718+894+717 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[3] GIF 1x1 895x718+894+717 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[4] GIF 45x31 895x718+87+25 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[5] GIF 21x27 895x718+94+29 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[6] GIF 18x23 895x718+99+35 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[7] GIF 188x160 895x718+87+28 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[8] GIF 186x20 895x718+88+72 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[9] GIF 1x1 895x718+894+717 8-bit sRGB 256c 0.010u 0:00.002
animated.gif[10] GIF 1x1 895x718+894+717 8-bit sRGB 256c 0.010u 0:00.002
If I recreate the animated GIF by dumping the sequence to PNG (convert -coalesce animate.gif) and then convert it back to GIF (convert *.png), it plays back correctly - but now the animated GIF has grown by a factor of 16 (2.5MB instead of 150kB), which I would like to avoid.
Any ideas how to correctly play back an animated GIF that has subframe updates?
I'm currently running Tcl/Tk-8.6.12 on Debian/sid (but I'd like to show my GIFs on macOS/Windows/Linux with Tcl/Tk>=8.6.10
The images in a multi-part GIF image have a bit indicating the disposal method. This bit indicates whether the new layer should replace the existing image, or be combined with it.
Your image contains layers that are supposed to be combined with the existing image, but your code simply switches to the new layer.
To combine the layers, you would need two images, and repeatedly copy the different layers from the GIF onto the target image:
set dir [file dirname [file normalize [info script]]]
proc nextFrame {image {time 500} {index 0}} {
if {[catch {tmpimg configure -format "gif -index $index"} stderr]} {
set nextIndex 0
} else {
set nextIndex [expr {$index + 1}]
if {$index == 0} {
$image copy tmpimg -compositingrule set
} else {
$image copy tmpimg -compositingrule overlay
}
}
after $time nextFrame $image $time $nextIndex
}
set img [image create photo -file [file join $dir animated.gif]]
# Create a helper image
image create photo tmpimg -file [$img cget -file]
label .w -image $img
pack .w
nextFrame $img 100
For some reason some colors seem to be off, but this comes much closer to what it should be.
The relevant Tk ticket now has an implementation to get the eventual missing information in the Tk8.7 metadata framework.
I would appreciate a review. It will unfortunately not help you with Tk 8.6.10, as this may be included in Tk 8.7b1.
Thank you and take care,
Harald
Related
I am trying to label, change shape, and change label-color of nodes in NS2 2.35/nam 1.15. I am able to add the label and change the color of the nodes correctly (although color requires 2 lines). However, I would like to make that node a square AND change the label color (the label color is lime green and difficult to read). Seems simple... via the manual/internet/sources out there, I have generated the following code to accomplish this:
set stime 0.0
#color works... but requires BOTH these lines
$ns at $stime "$BS color darkgreen"
$BS color darkgreen
#shape does NOT work. Shape stays a circle
$ns at $stime "$BS shape square"
$BS shape square
#Label works
$ns at $stime "$BS label \"BASE STATION\""
#label color does NOT. Moves the node to position 0,0
$ns at $stime "$BS label-color black"
$BS label-color black;
#base station position
set bsx [expr $val(x)/2]
set bsy [expr $val(y)/2]
$BS set X_ $bsx
$BS set Y_ $bsy
$BS set Z_ 0.0;
When I run the code, the node color changes and the label is added. However, the shape does not ever change - I have not been able to get it to change either (via changing stime, commenting out stuff, adding, trying different shapes, etc). In addition, when I leave in the label color, it SHIFTS the entire node position from (35, 35) to (0, 0). How would label color shift node position??? Why does my shape never change? What am I doing wrong with label color? Is this an initialization problem within the event scheduler?
As a final note, every node in my whole simulation before 'Play' in nam is pressed starts as a green circle. The colors and labels change AFTER play is hit.
The default node color is black. And when using energyModel it's green. The color setting is done in tcl/ns-lib.tcl line 1344 : For energyModel. The shape (circle) is set in line 1352 and 1357. My example: red, square ...
1343 if [info exists energyModel_] {
1344 set nodeColor "red"
1345 } else {
1346 set nodeColor "black"
1347 }
.
1352 -z $size -v square -c $nodeColor"
1353 } else {
1354 # Flat addressing
1355 $self puts-nam-config "n -t * -s [$nodep id] \
1356 -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size \
1357 -v square -c $nodeColor"
Build a new ns-allinone-2.35/, and save 'ns' to /usr/local/bin/ns-red-square. Patch: nam_red-square-node.patch (858B, 26 lines) https://drive.google.com/file/d/1PcCwp7bM_Z4208LIFquX3cbt4HNdOcX9/view?usp=sharing (Easy to edit to your preferred color.)
Note : You can have as many ns-allinone-2.xx as you want, installed at the same time https://drive.google.com/file/d/1FCjn-9fkR7tKeqClUpHsleaEdnoKRZzq/view?usp=sharing
My simulation / animation example: $ ns-red-square aodv-Soumia.tcl
P.S.: darkgreen works nice too !
Simulation examples with added square https://drive.google.com/file/d/17nYE9UIVQ7Ir7QUcsdbwSwF240nt0k-w/view?usp=sharing
Simulation example with color settings and square: D-Sq-kartiksd.tcl
$ grep -ni green D-Sq-kartiksd.tcl
$ grep -ni square D-Sq-kartiksd.tcl
Link https://www.dropbox.com/s/s7dvjg1wflz3xsj/D-Sq-kartiksd.tcl?dl=0
I am writing a basic script that moves a red square around a 500x500 window in random directions. However, the window does not appear when I run the code and no error message is displayed.
I've tried using both wish and terminal to run the code but neither work.
FYI: pass is my do nothing function
my code is:
#!/usr/bin/tclsh
proc pass {} {}
proc rand { min max } {
set maxFactor [expr [expr $max + 1] - $min]
set value [expr int([expr rand() * 100])]
set value [expr [expr $value % $maxFactor] + $min]
return $value
}
package require Img
wm geometry . 500x500
wm title . "move"
. configure -background "#333"
set x "250"
set y "250"
image create photo img1 -file "square.png"
label .l -image img1
place .l -x $x -y $y
while {"3" eq "3"} {
set command [rand 1 4]
if {$command eq 1} {
eval "if {$y ne 5} {\nincr y -5\nplace .l -x $x -y $y\n}"
} elseif {$command eq 2} {
eval "if {$y ne 475} {\nincr y 5\nplace .l -x $x -y $y\n}"
} elseif {$command eq 3} {
eval "if {$x ne 5} {\nincr x -5\nplace .l -x $x -y $y\n}"
} elseif {$command eq 4} {
eval "if {$x ne 475} {\nincr x 5\nplace .l -x $x -y $y\n}"
}
}
The only way anything works in a GUI is through a steady stream of events. Button clicks, scrolling, and even requests from the operating system to redraw the window are all events. Without being able to process these events, the GUI is either frozen or never appears.
Because of your infinite loop, these events are never processed. Thus, even the initial "draw yourself on the screen" event goes completely ignored.
Event-based programming is not the same as writing non-event-based programming. You can't just expect the code to run once from top to bottom. Instead, you must set up your GUI to properly generate and respond to events.
If you want to move the square around in random direction, the proper way to do that is to create a function that moves it once, and then arrange for that function to be called every so often. You do that last part -- running a function in the future -- with the after command. This lets you put an event on the event queue which instructs the program to run your function.
Example
To simplify the example, the following code will just move the label to a random location rather than use the convoluted logic of your original code. You can later modify the function to use your existing logic if you want. I want to remove as much complexity as possible so that you can understand the technique.
First, start with the function to move the label once:
proc move_label {} {
set x [rand 0 500]
set y [rand 0 500]
place .l -x $x -y $y
}
Next, create a function that calls this function, and then arranges for itself to be called again using after:
proc animate {} {
move_label
after 1000 animate
}
Finally, call this function once after you create the label and it will run every second until your program exits.
label .l -image img1
animate
By having the animate function call after on itself, you end up with a never-ending loop that runs approximately once per second. In-between iterations of the loop tcl is free to process all other events that allow the GUI to continue to respond to user and OS events.
Note: you need to run this with wish rather than tclsh, since wish includes the tk commands, and it will automatically start the event loop for you.
I am capturing form data from a html form using textarea in to a variable.
I have three of these. Code Swap & Morph
<form action="/::storyBuild/&Create" method="POST">
<textarea name="code" title="" cols="19" rows="12"></textarea>
<textarea name="swap" title="" cols="19" rows="12"></textarea>
<textarea name="morph" title="" cols="19" rows="12"></textarea>
<br>
<input type="submit" value="Generate">
</form>
Within the site you enter a script
Code Swap Morph
kCode %animal1 Woof! I am a dog
kCode %animal2 Meow! I am a cat
kCode %animal3 Squeak I am a mouse
I have it capturing the data perfectly fine as expected, however I am failing to get it to split text area.
For example, if I use the following script
kCode %animal1 the dog is very wet from the rain
kCode $animal2 the cat is very cold from the snow
kCode %animal3 the mouse is very warm from the fire
Using the code
### display form data
set i 0
foreach formPost $formDataCode {
set code [lindex $formDataCode $i]
set swap [lindex $formDataSwap $i]
set morph [lindex $formDataMorph $i]
storyWrite "$myPath" "$code" "$swap" "$morph"
incr i
}
proc storyWrite {path code swap morph} {
set myPath "/some/path/"
set fp [open "$myPath" a]
puts $fp "$code $swap $morph"
close $fp
}
I discovered that while this was working for code and swap field, because these are single words, it was only capturing the first few words of the morph field. The morph variable holds the whole content
puts "My formData output: $formDataMorph"
My formData output: the dog is very wet from the rain
the cat is very cold from the snow
the mouse is very warm from the fire
llindex would only loop three times because the code variable has single three entries, each outputting both code and swap correctly it would only place the third word of morph when I would like it to be the third line.
The overall output I would get is:
the :: dog :: is :: %animal4
rather than
the dog is very wet from the rain :: the cat is very cold from the snow :: the mouse is very warm from the fire :: %animal4
I've tried implementing conditions using if statements both of which don't seem to work.
if { $formDataMorph eq "\r" } { puts "I found a carriage return" }
if { $formDataMorph eq "\n" } { puts "I found a newline" }
How would I go about doing this? How can I separate the additional lines from the variable?
Do I need to add a line delimiter check when inputting the script?
Thanks,
mookie
Without knowing what the value in formData really is and how it got there, it's hard to be sure what's going wrong. However, it looks like the initial fix is to do:
foreach formPost ????? { # <<-- What you wrote looked wrong...
set morph [join [lassign $formPost code swap]]
storyWrite "$myPath" $code $swap $morph
}
For example, if the input data is in lines, we'd do:
foreach formPost [split $inputData "\n"] {
set morph [join [lassign $formPost code swap]]
storyWrite "$myPath" $code $swap $morph
}
But properly it's still wrong since it's still mixing up strings and lists. If the data was encoded correctly you'd instead do:
foreach formPost $inputData {
storyWrite "$myPath" {*}$formPost
}
Otherwise, the safe string-to-list conversion is with:
foreach line [split $inputData "\n"] {
set dataList [regexp -all -inline {\S+} $line]
set morph [join [lassign $dataList code swap]]
storyWrite "$myPath" $code $swap $morph
}
(I still worry about the handling of the input data in the first place; e.g., how can we be sure that there aren't spacs in the code or swap fields…?)
Doing some Tk canvas graphics I get this behaviour:
The upper '|' is not visible because of the line below crossing it. I would like to mask an area below the text to make sure it is always visible, and could not find a simple way to do this in Tk.
Q: What are my options to masking graphics below a canvas text widget?
Implemented one possible solution for it.
After creating the text widget I create a rectangle with background fill put. The rectangle is also added to a tag whose name is derived from the text widget name:
set anno [$canvas create text $acoords -text $text -justify $ajust]
set bgfill [$canvas itemcget background -fill]
set anno_bg [$canvas create rectangle {0 0 0 0} -tags ${anno}.bg -fill $bgfill -width 0]
$canvas raise $anno_bg tmplt_annotation; # tmplt_annotation is a layer of sorts
$canvas raise $anno $anno_bg
Then on updating the position of the text widget I set the rectangle coordinates using its tag handle to the text bounding box, plus a little extra for border:
set box [$canvas bbox $awidget]
$canvas coords ${awidget}.bg [- [lindex $box 0] 1] [- [lindex $box 1] 2] [+ [lindex $box 2] 1] [+ [lindex $box 3] 5]
What I don't like about this is using tags for finding the rectangle through the text widget name. Then again could be because of my inexperience with tags.
I want to save a base64 String retrieved from a HTML5 canvas via Javascript to a PDF file using Tcl.
I get the base 64 SDtring from the Canvas via JS: let data = chart.getImage('stream').data;
Meanwhile i saved this base64 Data in a File for testing. In my Tcl Script i load this File and try to convert this with the package pdf4tcl.
#! /bin/env tclsh
# import Tcl (optional) but makes script more portable
package require Tcl
# import pdf4tcl
lappend auto_path "C:/Users/ - deleted for privacy ^^ -"
package require pdf4tcl
# Read demo File (contains base64 encoded canvas)
set fp [open "singerGraph.txt" r]
set canvas_data [read $fp]
close $fp
# create a pdf object
pdf4tcl::new mypdf -paper a4 -margin 15mm
mypdf startPage
# this command doesnt work
# mypdf putRawImage $image_data 60 20 -height 40
# write pdf to a file
mypdf write -file mypdf.pdf
mypdf destroy
The putRawImage method yields
instead
while executing
"binary format H* $row"
(class "::pdf4tcl::pdf4tcl" method "putRawImage" line 88)
invoked from within
"mypdf putRawImage $canvas_data 60 20 -height 40"
(file "base64ToPdf.tcl" line 28)
But i think this is the wrong command anyway...
For a simple test, this base 64 might be sufficient
data = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAIAAAACDbGyAAAAAXNSR0IArs4c6QAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9oMCRUiMrIBQVkAAAAZdEVYdENvbW1lbnQAQ3JlYXRlZCB3aXRoIEdJTVBXgQ4XAAAADElEQVQI12NgoC4AAABQAAEiE+h1AAAAAElFTkSuQmCC";
However my Data starts with : data:application/octet-stream;base64, but i don't know if that's important or not. The test data is too long to paste here.
Can someone lead me in the right direction. So i can convert this data into a PDF or even a PNG would be sufficient for now.
You need to strip the metadata (i.e., the prefix data:image/png;base64,) before decoding that string.
Here's a procedure to do that:
proc decodeImage {string} {
if {[regexp {^data:image/(\w+);base64,(.*)$} $string type data]} {
# DEBUG: puts "we have image data of type $type"
return [binary decode base64 $data]
} elseif {[regexp {^data:image/(\w+),(.*)} $string type data]} {
# DEBUG: puts "we have image data of type $type"
return $data
} elseif {[regexp {^[0-9a-fA-F]+$} $string]} {
# Looks like hexadecimal data...
return [binary decode hex $string]
}
# It's in some other format. There's like a zillion of them so…
error "unrecognised format"
}
I suspect that's not enough, and that the data you're embedding is supposed to be hex-encoded (because of that binary format), but I don't know for sure as that might be a fallback for when it doesn't recognise the raw data.
Well, I was able to get a
PNG from my base64 String
then get that PNG onto a PDF
and save the PDF as a file
Since I am very new to Tcl this code might be awful but for now, it's a good starting point.
#! /bin/env tclsh
package require base64
package require Img
# import pdf4tcl
lappend auto_path "C:/Users/ *username* /Documents/Tcl-TK"
package require pdf4tcl
# Read demo File (with removed prefix: [data:application/octet-stream;base64,])
set fp [open "singerGraph.txt" r]
set canvas_data [read $fp]
close $fp
# Create PNG Image
set data [binary decode base64 $canvas_data]
set img [image create photo imgobj -data $data -format PNG]
# Display Image
puts $img
pack [label .myLabel]
.myLabel configure -image imgobj
# create a pdf object
pdf4tcl::new mypdf -paper a4 -margin 15mm
mypdf startPage
# add Image to PDF
set img_handle [mypdf addRawImage [imgobj data]]
mypdf putImage $img_handle 15 15 -width 210
# write pdf to a file
mypdf write -file heureka.pdf
mypdf destroy
#DonalFellows Thank you for your help. I need to adjust that decodeImage function for my needs but you brought me a step further.