Canvas puppy

Source code:


#--------------------------------------------------------
# An "animated puppy" application on the canvas widget.
# The user drags a bone with the mouse, the puppy's eyes
# follow it and pants. An example of how to create interactive
# pictures on the canvas widget.  By Hattie Schroeder.
#
#  Copyright (c) 1997 Eolas Technologies Inc.
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details
#--------------------------------------------------------



#--------------------------------------------------------
# Colors the tongue, moves eyes  
#--------------------------------------------------------

proc move_eyes { x y } {

  tongue

.c coords eyel 155 155 165 165 
.c coords eyer 205 155 215 165
if {$x > 225} { 
	set x 5	
} elseif {$x > 150} {
	set x 0
         } else {
	set x -5
	 }	

if {$y > 175} {
	set y 5
     } elseif { $y > 150} {
	  set y 0
      } else {
	   set y -5
 	    }
.c move eyel $x $y 
.c move eyer $x $y

}


#--------------------------------------------------------
# Moves bone with the x y coordinates of the mouse. 
#--------------------------------------------------------

proc move_bone { x y } {
   global draglocation
    move_eyes $x $y		
    set dx [expr $x - $draglocation(x)]
    set dy [expr $y - $draglocation(y)]
    .c move bone $dx $dy
    set draglocation(x) $x
    set draglocation(y) $y	

}


#--------------------------------------------------------
# Picks up the bone and moves the eyes
#--------------------------------------------------------

proc grab_bone { x y } {
	global draglocation
	move_eyes $x $y
	set draglocation(x) $x
	set draglocation(y) $y
	}

#--------------------------------------------------------
# Colors the tongue and hides it again. 
#--------------------------------------------------------	

proc pant { } {
	no_tongue
	for {set i 100} {$i < 1000} {incr i 100} {
		after $i {tongue}
		incr i 100
		after $i { no_tongue}
	}	
}
	


#--------------------------------------------------------
# Procedures to color or hide the tongue
#--------------------------------------------------------

proc no_tongue { } {
.c itemconfigure tongue -outline white \
	-fill white
.c itemconfigure tongueline -fill white
}

proc tongue { } {
.c itemconfigure tongue -outline black \
	-fill red
.c itemconfigure tongueline -fill black	
}

#---------------------------------------------------
# Creates the parent canvas widget.
#----------------------------------------------------


canvas .c -height 500 -width 500 -background white
pack .c

#-----------------------------------------------------
#  Creates the eyes. Notice the patch is listed last in
#  the display list with the command ".c lower patch", so 
# it won't cover up the other elements of the eye.
#-----------------------------------------------------


.c create oval 150 150 175 175 -outline black -fill white
.c create oval 200 150 225 175 -outline black -fill white

.c create oval 155 155 165 165 -fill black -tag eyel
.c create oval 205 155 215 165 -fill black -tag eyer

.c create oval 140 130 180 200 -outline black    \
			-fill black -tag patch
.c lower patch

#-----------------------------------------------------
#  Creates the tongue. The parts of the tongue are 
#  initially the same color as the background. The 
#  procedures of the application will 
#  change their color, causing them to appear. 
#-----------------------------------------------------

.c create arc 180 215 200 245 -style pieslice \
	 -extent 180 -start 180 -tag tongue \
	 -outline white -fill white

.c create line 190 235 190 245 -tag tongueline \
	 -fill white

#-----------------------------------------------
# Creates the smile
#-------------------------------------------------

.c create arc 150 200 225 230 -style arc \
	-extent 180	-start 180 -tag smile \
	-outline black

#------------------------------------------------
# Creates the nose. The nostrils are 4 pixels wide.
# Notice the -smooth attribute determines the 
# polygon will be curved. 
#-------------------------------------------------

.c create polygon 180 188 180 184 184 180 188 180 190\
	 184 192 180 196 180 200 184 200 188 \
	 -outline black -fill black -smooth 1 
.c create oval 184 184 188 188 -fill white
.c create oval 192 184 196 188 -fill white
.c create line 190 188 190 215

#--------------------------------------------------
# Creates the ears. 
#---------------------------------------------------
.c create polygon 100 140 110 130 120 130 130 135 140 140 140 150 120 145 125 190 120 200 110 210 100 210 90 200   -fill black -smooth 1
.c create polygon 230 140 250 130 260 130 270 140 280 200 270 210 260 210 250 200 245 190 250 145 230 150  -fill black -smooth 1


#-------------------------------------------------
# Creates the bone
#--------------------------------------------------

.c create polygon               \
	5 10 10 5 15 5 20 10 20 15 45 15 45 10 \
	50 5 55 5 60 10 60 15 55 20 60 25 60 30 \
	55 35 50 35 45 30 45 25 20 25 20 30\
	15 35 10 35 5 30 5 25 10 20 5 15   \
	-fill white -outline black -tag bone -smooth 1



#-------------------------------------------------
# Bindings for the bone polygon
#--------------------------------------------------

.c bind bone  {grab_bone %x %y}
.c bind bone  {move_bone %x %y}
.c bind bone  {pant}