Richard Suchenwirth - Here's a minimalist first shot - black screen, mouse pointer still visible, no animation. Vanishes on keypress, button press, or mouse motion. BUG?: does not hide task bar when run under NT -- does when on Sun via Reflection under NT!

 proc screensaver {w} {
   destroy $w ;# just to make sure
   toplevel $w -bg black
   wm overrideredirect $w 1
   wm geometry $w [winfo screenwidth $w]x[winfo screenheight $w]+0+0
   focus $w ;# so it gets keypresses
   bind $w <Key>    [list destroy $w]
   bind $w <Button> [list destroy $w]
   bind $w <Motion> [list destroy $w]
   return $w

Unix/X only (and you need to have a screensaver installed - it works for me on CDE...) DKF

 exec xset s activate

RS: Sure, but the idea was to have a Tk widget in which to insert the real fun animations, or whatever, in Tcl ;-)

Also see Rolf Schroedter's screensaver example using ffidl.

Paul Walton 2/13/06

Here is a simple Windows screensaver I made. It makes the screen completely black, hides the mouse pointer, and bounces widgets randomly around the screen.

I´ve only tested it on Windows XP, and to install it, you'll need to make it an executable (Freewrap it or make a starpack), change the extension to .scr, and place it in the directory where Windows looks for screensavers. On my system, that directory is C:\Windows\system32. You can also right-click on the executable and choose "Install". Of course, you can also just run the Tcl script to check it out.

The only problem is it doesn't support "preview mode". That is when the user is in desktop properties choosing a screensaver and a small preview of each screensaver is displayed within the desktop properties window. The screensavers are executed with the /p command line option along with the window handle they are supposed to show the preview in. I think TWAPI or ffidl are needed to support this through Tcl. Maybe someone can contribute the code to do it. (MG If the 'window handle' is what I think it is (and I've not looked), you could use the -use option for [toplevel], which is also a command-line option for wish, to get the desired effect.)

You might have to save it to a file to get it to run or comment out the keypress event binding, because when I just paste the code into the Wish console like I usually do with demos on the Wiki, it immediately exits. I suppose a keypress event from the pasting is being processed by the code.

Anyways, here it is:

 # Handle command line options.
 switch -glob -- [lindex $argv 0] {
        "" { # Do nothing special. Start the screen saver }
        /s { # Same as above }
        /p { 
                # No preview mode
        /c* { 
                # No configuration options. Show a message box.
                wm withdraw .
                tk_messageBox -title "TclScreenSaver Configuration" -message "There are no configuration options available for this screen saver."

 proc InitScreenSaver {} {
        global CursorStartX
        global CursorStartY

        # Make the main window solid black.
        . configure -background black

        # Make the main window fill the entire screen.
        wm geometry . [winfo screenwidth .]x[winfo screenheight .]+0+0

        # Take away the window decoration.
        wm overrideredirect . 1

        # Make the screensaver ontop of all other windows.  Catch any errors in case we´re not running under Windows.
        catch {wm attributes . -topmost 1}

        # Make sure the window has the current focus.
        raise .

        # Save the starting position of the mouse pointer.
        set CursorStartX [winfo pointerx .]
        set CursorStartY [winfo pointery .]

        # Hide the mouse pointer in the lower-right corner of the screen.
        event generate . <Motion> -warp true -x [winfo screenwidth .] -y [winfo screenheight .]

        # Exit the application when mouse or keyboard activity is detected.
        bind . <KeyPress>         ExitScreenSaver
        bind . <ButtonPress>         ExitScreenSaver
        bind . <Motion>                 ExitScreenSaver


 proc ExitScreenSaver {} {
        global CursorStartX
        global CursorStartY

        # Erase previous binding on mouse motion so that we don´t get an infinite loop with the next line.
        bind . <Motion> {}

        # Move the mouse pointer back to the starting position.
        event generate . <Motion> -warp true -x $CursorStartX -y $CursorStartY

        # Close the application.  The 'after idle' is needed or the mouse pointer won't be re-positioned.
        after idle exit

 proc CreateAnimation {widget} {
        global PositionX PositionY
        global IncrementX IncrementY
        global IncrementThreshold

        # This is the maximum number of pixels the widget will move in any direction at a time.
        set IncrementThreshold        4

        # Set the amount the widget will initially move in the X and Y directions. Make sure both are not zero or the widget will stand still..
        set IncrementX($widget) 0
        set IncrementY($widget) 0
        while { $IncrementX($widget) == 0  &&  $IncrementY($widget) == 0 } {
                set IncrementX($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]
                set IncrementY($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]

        # The initital starting position coordinates of the widget, which will be a random spot on the screen.
        set PositionX($widget) [expr { int(rand()*[winfo screenwidth .]) }]
        set PositionY($widget) [expr { int(rand()*[winfo screenheight .]) }]

        RedisplayAnimation $widget


 proc RedisplayAnimation {widget} {
        global PositionX PositionY
        global IncrementX IncrementY
        global IncrementThreshold

        if { ![winfo exists $widget] } {

        # Increase/decrease the X and Y coordinates of the widget, according to the current increment values.
        incr PositionX($widget) $IncrementX($widget)
        incr PositionY($widget) $IncrementY($widget)

        if {$PositionX($widget) <= 0} {
                # The widget we are animating has hit the left edge of the screen.  

                # Make sure it isn´t past the edge.
                set PositionX($widget) 0

                # The new X increment value must be positive, but the new Y increment value can be positive, negative, or zero.
                set IncrementX($widget) [expr { int(rand()*$IncrementThreshold)+1 }]
                set IncrementY($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]

        if {$PositionX($widget) >= ([winfo screenwidth .] - [winfo width $widget]) } {
                # The widget has hit the right edge of the screen.

                set PositionX($widget) [expr { [winfo screenwidth .] - [winfo width $widget] }]

                # X must be negative, but Y can be any.
                set IncrementX($widget) [expr { int(rand()*-$IncrementThreshold)-1 }]
                set IncrementY($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]

        if {$PositionY($widget) <= 0} {
                # The widget has hit the top edge of the screen.

                set PositionY($widget) 0

                # Y must be positive, but X can be any.
                set IncrementX($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]
                set IncrementY($widget) [expr { int(rand()*$IncrementThreshold)+1 }]

        if {$PositionY($widget) >= ([winfo screenheight .] - [winfo height $widget]) } {
                # The widget has hit the bottom edge of the screen.

                set PositionY($widget) [expr { [winfo screenheight .] - [winfo height $widget] }]

                # Y must be negative, but X can be any.
                set IncrementX($widget) [expr { int(rand()*($IncrementThreshold*2)-$IncrementThreshold) }]
                set IncrementY($widget) [expr { int(rand()*-$IncrementThreshold)-1 }]

        # Adjust the position of the widget.
        place $widget -x $PositionX($widget) -y $PositionY($widget)

        # Call this procedure again in the near future.
        after 10 [list RedisplayAnimation $widget]


 proc UpdateTime {label} {
        $label configure -text [clock format [clock seconds] -format %c]
        after 1000 [list UpdateTime $label]

 CreateAnimation [label .title -text "Tcl Screen Saver" -font {-weight bold} -bg black -fg white -padx 0 -pady 0]
 CreateAnimation [label .author -text "by Paul Walton" -font {-weight bold} -bg black -fg white -padx 0 -pady 0]
 CreateAnimation [label .time -text "" -font {-weight bold} -bg black -fg green -padx 0 -pady 0]
 UpdateTime .time