Rolling credits

Richard Suchenwirth 2007-01-23 - Waiting for a lengthy zipping, I hacked up this plaything that simulates credits of a movie, rolling over the canvas screen.

Jeff Smith 2020-11-06 : Below is an online demo using CloudTk. This demo runs Rolling credits in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Rolling-credits.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.

 package require Tk
 proc titleshow {w title} {
    set -fill black
    set -font {Helvetica 16}
    set x [expr {[winfo width $w]/2}]
    set y [winfo height $w]
    foreach line [split $title \n] {
        set line [string trim $line]
        if [string match -* $line] {
            eval [linsert $line 0 set]
        } else {
            $w create text $x $y -text $line -fill ${-fill} -font ${-font} \
                -justify center -tag title
            incr y 48
        }
    }
    every 40 "if !\[titleshow'roll $w title -2\] return"
 }
 proc titleshow'roll  {w tag dy} {
    $w move $tag 0 $dy ;# (1)
    foreach i [$w find withtag $tag] {
        set y1 [lindex [$w bbox $i] end]
        if {$y1<0} {$w delete $i}
    }
    llength [$w find withtag $tag]
 }
 proc every {ms body} {eval $body; after $ms [info level 0]}

# That's all the code, here's a testing demo. Lines starting with - set parameters, the others are displayed:

 pack [canvas .c -bg black]
 tkwait visibility .c

 titleshow .c {
    -fill white
    -font {Helvetica 18 italic}
    Richard Suchenwirth presents
    -font {Helvetica 24 bold}
    -fill yellow
    THE IMPORTANCE
    OF BEING UNEARNEST
    -font {Helvetica 18}
    -fill white
    with
    -font {Helvetica 24}
    -fill yellow
    MARILYN MONROE
    GARY COOPER
    PETER SELLERS

    -font {Helvetica 18}
    Camera     Alphonse de Lumiere
    Gaffer     Joe Smith

    -font {Helvetica 10}
    (c) United Hackers, Inc. MMVII
 }

JM Richard, this is very nice!

do we have something in the wiki to scroll text in the same line? like the news at the bottom of the TV screen? - RS: You mean, what is sometimes called a Ticker? You could either modify the code above (the line marked (1) in titleshow'roll has 0 for horizontal movement, put your desired value there); or, you can do it with a plain label like this. First, a proc that "cycles" a string variable, so that "abcd" becomes "bcda":

 proc string'cycle _str {
    upvar 1 $_str str
    set str [string range $str 1 end][string index $str 0]
 }

# Example for test and demo:

 pack [label .l -textvar ticker -anchor w -width 50]
 set ticker "For all those who like to read news while watching a movie, \
 here is a little ticker that displays at the bottom +++ "
 every 100 {string'cycle ::ticker}

HE and here is every

JM thanks Richard, thanks HE, but in fact, "every" proc is in this very same page.

btw, homework (based on RS hints) is done, and text runs smoother than the label solution. I will publish tomorrow, giving the credit to Richard, of course (-: - RS: For smoother scrolling in the label, use a fixed-pitch font.

HE Found it. I tried only the second example. As I missed "every" I looked for the side where it reside. I know RS saves everything about tcl anywhere on the wiki :-)

nscerqueira

in order to repeat the text scrolling just change the lines

in the titleshow proc

        every 40 "if !\[titleshow'roll $w title -2\] return"

to

       every 40 [list titleshow'roll $w $y title -2]n"

and in the the titleshow'roll proc

                if {$y1<0} {$w delete $i}

to

                  if {$y1<0} {$w move $i 0 $y}

schelte gave most of the help to make this possible.

And don't forget to add the argument to the titleshow'roll proc , i.e.,

proc titleshow'roll {w y tag dy} {