Updated 2013-08-18 20:10:52 by uniquename ▲

Keith Vetter 20060105 : There's a whole class of image affect programs that I've always wanted to write--affects where as you move your mouse across the image it morphs the image at that point in some way. Two classic examples of this are the spotlight and magnifying glass simulations. Unfortunately tk is not very good at this kind of computing--too many numbers to be crunched.

Be that as it may, this is my attempt at the spotlight simulation. How well it works depends a lot on your computer--it behaves great on my fast laptop and horrible on my old desktop. There's a bug when the spotlight would extend over the edge of the image that I got too lazy to correct.

I've included a image to demo with, but you can use your own image easily enough by editing this script and changing what img::org is.

uniquename 2013aug18:

For readers who do not have the time/facilities/whatever to setup the following code and execute it, here is an image to show what the code does.

I do not have the 'Img' extension package on my computer (and have no intention of ever installing it). The sample data that Vetter provided in the code below requires the 'Img' extension.

I changed the code a little to use the earthris.gif file of the Tk demo directory (/usr/share/doc/tk8.5/examples/images/ on most Linux installations). I simply changed the 'image create photo' statement to use '-file' instead of '-data'. And I commented out the 'package require Img' statement.

For this image, I turned on the 'Darken' checkbutton so that the 'spotlight' circle would be more noticeable. I took this screenshot when I had moved the mouse-cursor over the lower-left part of the image. Note that a portion of the moon's surface is spotlighted. And note that the black sky above that spot was not turned to gray. Apparently Vetter is multiplying colors by a factor but not adding to the pixel colors. (Of course, you could change the code to make the spotlight work 'as you like it'.)
 ##+##########################################################################
 #
 # Spotlight.tcl -- Shines a spotlight on a image
 # by Keith Vetter, January 2006
 #
 
 package require Tk
 package require Img
 
 set S(sz) 60                                    ;# Size of spotlight square
 set S(sz2) [expr {$S(sz)/2}]
 set S(sz22) [expr {$S(sz2)*$S(sz2)}]            ;# Square of radius
 set S(brightness) 200                           ;# How bright the spotlight
 set S(dark) 0                                   ;# Dark image flag
 set S(darker) 50                                ;# How much to darken image by
 
 proc DoDisplay {} {
    global S
    
    wm title . "Spotlight"
    canvas .c -width $S(w) -height $S(h) -highlightthickness 0
    .c create image 0 0 -image ::img::img -anchor nw
    .c create image 0 0 -image ::img::small -anchor c -tag small
    
    frame .buttons -bd 2 -relief ridge
    scale .bright -label "Brighness %" -from 0 -to 800 \
        -variable S(brightness) -orient h -command FMove -relief raised
    .bright configure  -font "[font actual [.bright cget -font]] -weight bold"
    option add *font [.bright cget -font]
    
    checkbutton .dark -text "Darkened Image" -variable S(dark) \
        -relief raised -command DarkenOriginal
    button .about -text "About" -command About
    
    pack .c .buttons -side top -fill both -expand 1
    pack .bright .dark .about -side left -expand 1 -in .buttons
    .c create oval -100 -100 -100 -100 -tag box -fill {} -outline black -width 2
    
    bind .c <Motion> [list MMove %x %y]
    bind .c <Leave> [list MLeave]
    update
    MLeave
 }
 proc MLeave {} {
    .c coords box -100 -100 -100 -100
    .c coords small -1000 -1000
 }
 proc MMove {x y} {
    global S
    
    .c coords small $x $y
    
    set xy [list [expr {$x-$S(sz2)}] [expr {$y-$S(sz2)}] [expr {$x+$S(sz2)}] [expr {$y+$S(sz2)}]]
    .c coords box $xy
    
    # Bug here when xy extends past edge of image. Too lazy to fix it.
    catch {
        eval ::img::small copy ::img::img -from $xy
        Recolor ::img::small $S(brightness)
    }
 }
 proc FMove {args} {
    foreach var {x y} val [.c coords small] {
        set $var [expr {int($val)}]
    }
    MMove $x $y
 }
 
 proc Recolor {img perc {circle 1}} {
    set w [image width $img]
    set h [image height $img]
    set cx [expr {$w/2}]
    set cy [expr {$h/2}]
 
    set d 0
    for {set x0 0; set x1 1} {$x0 < $w-2} {incr x0; incr x1} {
        set data [$img data -from $x0 0 $x1 $h]
        set y0 -1
        foreach rgb $data {
            incr y0
            if {$circle} {
                set d [expr {(($x0-$cx)*($x0-$cx)) + (($y0-$cy)*($y0-$cy))}]
            }
            if {$d <= $::S(sz22)} {
                lset data $y0 [::tk::Darken $rgb $perc]
            }
        }
        $img put $data -to $x0 0
    }
 }
 
 proc DarkenOriginal {} {
    if {[lsearch [image names] ::img::dark] == -1} {
        image create photo ::img::dark
        ::img::dark copy ::img::org
        
        destroy .warn
        toplevel .warn
        wm transient .warn .
        wm title .warn "Spotlight"
        wm protocol .warn WM_DELETE_WINDOW list
        label .warn.l1 -text "Please Wait" -fg red -font {Helvetica 36 bold}
        label .warn.l2 -text "This may take a while" -font {Helvetica 18 bold} \
            -anchor w
        grid rowconfigure .warn 0 -minsize 15
        grid .warn.l1 -row 2 -padx 20
        grid .warn.l2 -row 3
        grid rowconfigure .warn 999 -minsize 20
        wm withdraw .warn
        update
        set x [expr {[winfo rootx .] + [winfo width .]/2 - [winfo width .warn]/2}]
        set y [expr {[winfo rooty .] + 40}]
        wm geom .warn +$x+$y
        wm deiconify .warn
        update
        
        Recolor ::img::dark $::S(darker) 0
        destroy .warn
        
    }
    if {$::S(dark)} {
        ::img::img copy ::img::dark
        set ::S(brightness) [expr {$::S(brightness) / $::S(darker) * 100}]
    } else {
        ::img::img copy ::img::org
        set ::S(brightness) [expr {$::S(brightness) * $::S(darker) / 100}]
    }
 }
 proc About {} {
    set msg "Spotlight\nby Keith Vetter, January 2006"
    tk_messageBox -message $msg
 }
 ################################################################
 
 set idata {
    /9j/4AAQSkZJRgABAQEASABIAAD//gAmRmlsZSB3cml0dGVuIGJ5IEFkb2JlIFBob3Rvc2hvcKgg
    NS4y/9sAQwAcExUYFREcGBYYHx0cISlFLSkmJilUPEAyRWRYaWdiWGBfbnyehm51lndfYIq7i5aj
    qbGzsWuEwtDBrM6errGq/9sAQwEdHx8pJClRLS1RqnJgcqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
    qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq/8AAEQgBUgHCAwEiAAIRAQMRAf/EABkAAQEBAQEB
    AAAAAAAAAAAAAAABAgMEBf/EADkQAAICAQIEBAQEBgICAgMAAAABAhEhEjEDQVFhInGBkQQTMqEU
    QlKxI2LB0eHwM/FDggWSFWNy/8QAFwEBAQEBAAAAAAAAAAAAAAAAAAECA//EABwRAQEBAQEAAwEA
    AAAAAAAAAAARASESAjFBUf/aAAwDAQACEQMRAD8A2CWE87nVGrKZTLYGhZEygUXkAgFQAUAKBAUA
    QcgUCAoAEZQEBeAABGUAZe4RaRazkDPIGqFAT1HqKoldgLZLIALYMjmBqxZmxYG7KYTNWBoGbLYF
    BLLZAAsoEIaAEIUgAhQFRkL6AIhC+g5gZIWiFEBQBgu4KUQoKABORQLZbMgDVlsyUg1ZTBbCtAli
    wigliwqgCwgWiAC0KIWwFEooAUC2QgAEKAYAGWZNkAyC1kUUQFoUBCii0BLFloUAstmSkFspkAaK
    Z9S8iCk5AAAAFAABCFIAohQBnINAI5Aoo2IWxQ5sgFIAKUAAUhSKFIUCAAItghQKCACghQqgACgl
    giKCWLKKCACkAAhCgCApKAhR6igBruZLzAoJ6gBQwQmQLYsgAtiyZAFspkbEVqxZmy2BbJYsl4At
    gy2WwLZCWAi2DOQUQpAUUhQBNigAEykCCtAzZbIKAAKUyWwKKAAAqQIJzAotAQFoAQGhQGbFloAQ
    oAAAACFAEAoAQoZAKAAKAAFCgAFCi2SwGkaQAJRGjRkCcxyLzAE9CUaJYEoFsl9wgQpAAKAMgFo0
    qFsVgV3AWLFCnuQUUKAChQKBBZRQGbKmWkSsgXV3LZKAGrLZgpBqwZLyA0CWLApCgCFoABRKKAIC
    kADkABAUgAgAAdQUAUgAtggAAgsALBALZL6DmALZLIALZCECL/cEJeQNWLMWLA1YM3/tgo1TGe5b
    LqQVkpbLgDNsqZcCsgAAALRPUAWhQFgKFCxZAAHqAA5ABzKSxYFHkQAUpkoFsWZsWBuxZjULA3gU
    Y1F1AaoUZ1F1dwKShqGoBRKLYsDINCkBlFFEAAACWPUpAJ6gV3DQRLwLBLAoszbJYg3fkSzN9haL
    Bq2SzNi+4FYJY3AvqCADYICjQIVNAPUFtFtdAqUKNWug1LoBmi0W2R5IAFDZgWhpJ7C2BqvMUZti
    33AtCiWWwLQ0omotgNIoljUAoo1DUAolFsJgShRcFvsBmuxDVi1TCMlotpbIjbAAgA0DN4FkVsGN
    RdQGmQzqJYGhijNlTVhFZKY1IXgKjRKZtR5kdrZFRmiaTa6tBp+QGNJlo6Okudmc0BmiUbqzOO5R
    KFFJ7gQUUgCvMFsAdNPdDSZ1MupsKUKYsqaAlFz0CkuhdarYgmS5GpCwKT0BQFse4royctwKPYll
    sC2ACCFoDHUBQ2Y9SAVtj0CLgCUNJcUS6Aulkpl1FAzTGTQqNdwMWxZqhS6lGbKKBAFFvpRKfVAG
    l3M4N0hSA5g3piNKLUYBvSqFeQoykXQ+wzySLb7EVlprkNVcka8yUA19QpImhdBo7BFckZcrLofQ
    ji1yAe403/2Mpi+wBw7mXE16SFMozX+0K8zTT7C2tgMNexDbV7/uRpdRRi+wNaV2AotkZrRLqvcu
    iXUoyQ0oO90XQ63QGcls1pfWJNMul+oEtdBcejLT6BJvkFTHQuC6X0LoedgM4GDWh9iaepBMdC47
    jS6zhDSuoCvMCu5VGwJ6sV3K4tchpfQCFtkotdgFvsS2Whpa3iQL8hfcU0MsoX3G/wCYaX0JpILX
    8wJSFMIvr9x6oma2JqdbAavuL8yXLYPV0YVdTJbGe6JkC2+wvyJT7Cn0QRc9RbJTrYf7sAt9GNT6
    DN4RHYF1eYsiUnyGl9AKpZGp9jLT2zYcZdwNapDUzFNCnRRvWxqZzze4SfVCDep9DLkq6Ez1sZAt
    92R+YsX2AerLgzb6DPQC2i6l0M56EvPL2A3rj1Bi/IAb1eY1dD5z+PnF0+HH3H/5D/8AUv8A7D1h
    H0tZNVs+a/8A5CV+GMY/cL46fVf/AFRPWLH0lIuo+evjm2swz1Wx1h8XF4enV0Ui58sI9eot92eZ
    8dfov1D4/wDJv1ZeI9N/7YUjy/PlmtON2YlOUk7k6+xLg9r48FhyRPxPD2T90fPcop02Jy4kVa4d
    p5vdEuLNfRfEi86l7kfEit5r0Pl3KUfptt3erJdTT8VprdVRn3i+X0vmw/V9guNHqfP+f/Jfk2h8
    /on5Nj3h519NceNbj50eUkfNfHdJ4d4w7LHjKStSSa/K4svrEmvofNj1Rl8aC3keJzTV6JLtuRcT
    rBoe/iTXrn8TL/x+FdWc/n8X9bOOuO+a8hrh1NXEmuy4/EX52+zEuNOW8qXbBx+ZH9RXJJXyfPkL
    g6fMl+uV+Z0h8ROL8XjXc82uC/PFDVGvqVC4PTP4hy+i4r7mVxpp25Nrozjqje+Rqj+oXB6X8S/y
    xXqF8Tz0Z8zz6o/qQUlya9xweh/FcTNUr7HN8Sby5yvzMY8yX5lHePHmt/F35nRcWDWpyS7Hj1eY
    1PoB24nG1Yjaic9cv1P3MW+gtgb1u71O/M6R+IkvqSkvY4ADrxOM5uknGPS9/MkeNOGzvs8o5j3A
    6/ieLdqXpWDpD4qTxL7HmGSD1/Pis6n7EfxKb+lv1o8tvqNS6r3A9D+Ib2gl6hfEfqj7HntdV7kc
    0t5FHsXF4bWGzWqPVnz3xVythcdx+n7k4Pfa60TUup4n8VxOSiu9GHx+N+slI+i5eotdT5z4/Fe/
    Ef7E+dPqvOhSPo+TB4F8RNck/LBpfE3upL1LR7L7kweX8VWNN+Zn8TLpH3Fwj24B4/xPZ+4HBjTB
    23NSW26OfE4fDjprhvO6dlfE1Wq4a/8ARMwklszjuttVwar5ST7WZSik0owafNp2Vaa8Wp+RuPAl
    KN47K8sUYjHhJp/Lc1zTZdUXiMIR79DpwptLRw+EnN51Se3qY4uvVq4kEm8WlgC/LlXgnwHXS3/Q
    6fJ+IValw/N3/Y5anOX8RPQ8NLCRZx4Uf+Hi8R3smqQGnwuI8y4vCbapfxXgzLCqXGfEly05X3EI
    wUXq0a7/ADWq9EZ4kuG5YWOquvYaNJ3hu0/YjT2ab7GbvpXYqlVbGeqY56kXw6t5X5CpN/UlZNvz
    X/60Qak0l4W0ZvtfoX5jTzXlyC4j3vBFVSWbaj3rJZNxlTmpPtky+IpPEm30Y3WX7IqOkrjmUk7X
    IxGTnKotN87dEVK7jqXK8HaXxc5RVxWMK+RZgiik8y4zvotKM8TVGT03XJXZmXEnL65J8+whKCdN
    JLfqW4iKbeywt6In0056zR0lxsf8fDbX5pKwuNySbbzUX/goxfOk12ZYu8qKXXxFlJNvXw1q72mZ
    xya9UBtxnzjh87TMRWp1Gl3cqGmUliF947exvhqSk0o6Zrk1kfYieiVJyUuqkbi+HK1Nzl6h6p2n
    KKj33T/c5JNfpk17Adq4FXGT9WZ8caUfGnzTMupN1Gm9lyMtK/FGlaTrAo3rnu9Xa0wpzzbll4bM
    NNNqGUnTaz9ywUmsQUms3zLSNLiONXqb5r/UFxJO7kkuu/8AQzFSw9Kd4yzT+bF/TJJ4wxdSK5y0
    34mr3pJGfmSrErb7IU1dwbcd1qtpeRqXGcd+B5NxVMXRFOTX1R/Ymp3me3Q3/C4q18OHLK2yc4zj
    4rqDj+V5f7CjWp1vLPOsGbT3VvzNRqeeHKpP9TaZiWN5Qb+woY/Sxa5sP5abuUW96p+wg0ttPty9
    RdC0ldrHLmS1WLflRJTjF+BybXU5ubk75sUdpUsO78yYf5X3HB4fE4sNW0e7o9HB+F40248NQwrt
    zLR5uJcFFpJNq0nk5S1N3szXEb4fGlBvKbi03ZuHwvG4vDlPhKMlFpNKWckEg5JVKvM3mvqjnlRm
    PwfxUpKMeE3Jq0lJGZpxbjOV8ROq32A3busewVy2abOCk+hpSvdL7ijpb7e4z29znaqqQv8AlLR0
    1eXuDF9XFAUaz0K6vKoNIV3Zhpl1sEl0LXdl0yW8Z11aCF0sVE0+JN/+SVbVeDMUu3qWuyCjzyS8
    lRYylF2nkml9PZinvp+4G1xuLFOuJJGXOclniSl2siUv0/dEetcvuOiot1zM3z58kWOqbemLddEB
    NKLoOkeDJfW1BvbZlXBct+LFNbpiI5aX2Gl89Pqd5zjF6Z8KLxusnKTUn4eHp7J2IouG9LfhVdzF
    d39zp8vi/Vpru2R68KT3yryBik0KS/V5s2o39UkPUgzXJbnTh8HiTeYSgt7aMrDu8+VmtU9FapU8
    lqHF4K4UblxJRf8A/Df3Myl8t6YcW084Ve4Up7a20+pK7eg0HKMnc0m/uZxuqT7inySJqaa5V0GY
    NrW7e6XNIjhFpatS5XkzraeMeav7COtNPUq3w7LBdHSTxyYquX2EoJrOb5rBmXCrebTEHT6t011Z
    VHh3u30pUccwpSfvguvC1JEg6Y2V+4UU5eJNL+V5Ob4iVJe4U75L0Q6On8LK+VrvZylTXoiTjbVP
    Vjrg5tquYbfbsUdnqh4XTXJxyYm4SXii7fOLocPiRgnq4UJXz2O8XCaqtK9MFGeHxoqEY8SEpSX5
    01dGXxG81nk+aOnyXKNxn9jLhV604rqk2idHPD+puxssW12dC4XV46qyutopaeqyQIcTSsTnGXLo
    Zko3q0JNb1sW47N+4jLRJ5j3yBiUIt3T75wI8OL5R9Zm5O/zVX6TMs7++kqNrjcSEVFJUsK0cuNx
    uNOOiXEtdI4RqO9/5Rai3UoLPoKODnKS8T1Pq8kU5JUrinvmrPU+JL5a4aXCrpopnNQi/qpd1yFI
    fC8ZcDjx4iq07zkfE6XOUsuUnqbi1WTUODcNUWpPosmaSVNOuwHHPQqre7Oz0NeFUlzb3MuGvEIx
    9GBhtd6M6ujwb+TOrST8mT5PE5xoCa5dQND7gDvi8Sx5inyyjo/iOK3apJdrMcTj8Se6jfVcNJhU
    tp5x5i+7sRktNTb7OSFeHVh+W6JBF/2V2LTWz9hpfJv1YUXbYuNs2RxdciLDINOuhMJ87G4QF1cl
    t3LbrDwZpinQFqvzZFeRP9oauy9wLeOYt9Wa4cHxMpxS28TpMk18q9fshNGazsa8ySvtXIl5A1jO
    cIq9zm88kaTrGANNvcl75JdvYJrnYGk83gmCY5seEC/uW+y9DLddKIppbvD2A0utBpPsS09mKfTD
    wu4CujRKrk2b+XxNOrRjrZjVmmnZRdUqz98nTUpcNwpJ+SZzWR6+gsQTUcR4jUebovEm5RUXbS2b
    M1joPIUTNbYDVrZ+dGZKTeJFUXVt58wI0trx5FvSmq9S5535mZdbi33LUdOHxVq0pKC5bs9CalVy
    i+63PEm1+Sjs3KMVGS4U+7d12LR6ZxU61Qd9Vv8AY4P4Ram4zrnTOanOK0pxa75K/iOIl9PDVcow
    oVXSXBcnbjwnz+ozpraEMe33Hz+JJfQo30WSfOmvrbklurJcIktN3KMI+u/kRSco4xfNPc7RnwJ2
    1L5bWXe3+ThOMLuLj5rCfoNRalX1IVyx6MlP/smef7mVMX0Ja5xaa5N2He9fazNmsR108NrVD+HN
    LvTNcODlw25Rmq/Oqf2OcG4yUoq2uTVk1OLt2n12FFb5YkS3f056FfDrxKOqPZ0Gv0Ntb1J3Qgmq
    LxVNdC6Y1bmvvZFbVte1MallU231dBW1PiVuDPg6P3YA2uDxXn5csd0Fw53/AMc36D8RPrHz0ml8
    VNcoNeQ4C4c0tUoxjFbuTMXJy8MXV4dHf8WmlmaaW1GJ/FcSSahLTHpu36jgxw5QUn8yMne/RHSb
    +HyoxjNvm00jzJtbFqTe2ewGotKVz4cWukXR3XG4Oz4Dz1lZ5cXVNrsiqK5xa7geqvhp3+VdNjHy
    +En4eMnXLS2zgpK92bcb2k35LAFVqeJtp/ylkoY0y4j80jNtZ0zbXM3DicP5UpcT4ecqdOVtRAmO
    aJTvBmXG4cpXGFLag4trlnvRINOCbSbUa6sy4zb8Mk+7ZFwm2qcc4eTtw+DxFFpQ4PEb6yT0lg5K
    47yXpkqae2TU+Go5VwadUrr0s55TrfrRIOkYxcknhc2zUeFObSjw34tnWGcYt6k/sSScZXUtPIcH
    SfDcG1JGovgabl8zV2ZzXEcY6c10ZNTT+oDbfCcqjOSjyvc0ocPNuTxjNf0Oeq+nojS8S/Mv2A68
    OXBpaoU9nJ3Kg/iJL/ji1ir02v2OVZdPD5FjOaT0OUetOhRJ8Rz+qUn3Im3TV2uZXLxZWWRy5gSs
    3L98iMU34nKv5UmWLTy3pXVZO/4XjQUeLDhrjcN7OOb9BgxxPh3CKlGWtPdVlexxdRl4lT74Ov4i
    SWXlbcq7GYcV1UWmtmmrLwZq+nob4qhDhxcd3h+O79ORh5bwkn0MqOcr02ZAUk9sDV3OrnGtMIRU
    eV7ruYcpc2ATT3bLFpJpN099jmqbtM1hc2EbpXfPzMUt6yW8cyqTqs+pFZSXZ+o8T3pepW2939gi
    jPiWdeelFbnz9y/f1Dja5Ac2n2KtSyn6WdPlvlkzod7CiqUt/CNV50p90yafPyozVeRJg1JrbayO
    ueR6fYl+RR2/CyfDc1ODXRO2cnFaVV97EZNJpWr3oiVbSoqNa5aVFNJIeJbP7mb835IN4y/sB0tt
    +JW+rJO4uk0nzTObvkzLn+rPctHdRtJ6H6MHLU/1MCjXZ1ZNXJ0KW7sdaJFWsKvCvMXGLzZmucka
    vsvQguq8xiZUrdNV3Y3ErV8/JgW3F4VP2YtXmPqZTbeROMuSdAb1xTt36HRcKXFzCo4/MzzXF+56
    YxqCldSb3exZhXWScHUJ8Sq+pqr/AMGVPicNN6313x7czpqjOUFJvhyX6l/QPhwm1Fx32a5mhxm4
    ceWqfh4jedKpMw/h3FalK4batPPoTiRhCbilJNbqT2ZtfEJ4f2ZKOcW/CtKajs7o6R4HElFNKr2b
    kqODu2VWnsKOjcoPQ9SfSTtG5wj8vU5wb2ajPP33Rxt1umn2LFpPYlHWcOGpx0vEl3x77nOb0Taj
    t1qjo+P4NKVLvkkuDNRU1LXF9N0XcGdeuVNV3QcFylfmjN1yi152FNp+FU35mRtRdf1RiqlVuzVT
    1U5JXzbwV8KENppS6VsOiKLq2sLmVbrLRn6X9We25rEmq4mf5lX3JujcZcOKalHVb5ujLjw5bSab
    2TyjFvOxi2t37jo78PhL5n8bUoP9J6eNxPwcox4KTuNrN6TxanVXixqXWu5aOs/iuPN3KmnypJex
    z+ZKU7mlJ9GqoNq8GXq3dCi78qfYd3p6NcyZ/wACr7AVwjWNV9bx7EWGtnklXtkuh3sBvjcRcSSf
    hpKrUUjnSb2SLlLKGGBnT3wNtpHSpSjajhc0RXJ1ddQMantk0j2Q+BjPhqUPik7zWj/Nnm43CfBl
    olKLfYQZT7LzJLS1uZ1tPYrvZrS+jQgqWMNtmv4iX0uu25zrnbCre8+Qg1qfYmtPDQ1S1L92VRg+
    JXFVRfOCrIzA8PcNRaw7Ziaip1HVXfc1OKSwotdUWBoXdE0vlkznNqvMqb/yTo0r5q0Rt7rBLb7l
    3X9QJ5ik90mHFdXRKV4CNeHowLfVgC4e1kqjUk1zwZpypRz07lUxtyHh6s0uDNq5rSuu5r8M3KKj
    J55v9xBhOCTw/Nsza3TdcrOr4EYNqfE9lhiXD4UYxqbk+auxByhUnvXc3Ti3eUjbknhQqiSTW6Qo
    zppeGKz2NKelVJ5bz3M02shSrGleqJRtuMpqatPmmztwJ8SOJKco7NpZXqeRSb5I3D5mrwLxdnRa
    PRxuHHiylabmnWrn7Hl4nBlw5K2mn+ZHo4XzVJPicWlvV5PRbeVCE097V2ij5yttWbx0yeni8DhS
    ypx4cuqVpnm0SSvWn2RnVhSvmiNK+pqPDcn9Wk2+DFWpSla6GbCOUU6bD3uq7o1NJLd4MWm/ItRt
    8Wbq3rrC1ZI3JprwxT3EZL1/YVGTw7vmX0sZUUnd55B3zk6e5tRTpSrzZjTnGfIlFVc+fMqlFUpR
    fmmYqVYNpJJfcv2jcVpXgk66TRW46U9K1bNf7uc2pXmkyxcsrXh8k7JFFGN7NIulLeMvMuqdU5Jp
    dciOqrbaXcl0jNqsJmc8mak46sqkFGKzTl2UqKjO4pf6zquLw1j8PHHU5ykpSbUVFdFkonJFyS08
    pURyt+RDGtT01mmSuasPH9yJsDWbxZLzlBS9AATUfpbV709w8u277sl8tgms49aKGVt9tySbb8Vt
    9Xktht9AJa5rYWnRc80H3SAV05EvmK7hpgdeHw1xIuX8TGXoVmNcmqlK/sXhcWXC+nmqZhtfl9jV
    Qkt27ZVG4uUZY7oeN3pjKSWXSJTS2VPuhAulVr2EUnacmny7klp2CSf05JBHaxWReNi7LJLAn+7A
    3qXcBUU+TyXXnw1XkY01u0/Iw23gQrv86dVdryCnq8WX5s4xl1NtWgNak97DeMUZ0Puwk7yqQFcv
    URfK/Si6bY0R3dgE31wEpFwsCUuXLoQdIR4Tj/G4zjfKMbo0uAoyxxoNcns/Y4Kv8Byp4KPZq4Ud
    k208+KySnw3mEXT21Hk1S6m1Jyf9uRLquqtptSj/AFRlp6s1XRbGFJanrz6FU+kr9DEWtUo1bglu
    lTDmlGqz+5hzTabXZqg4p1mn0oT+lJNvyZKWdTZl6U6y66FjJZyzeYyr01mXpRU6zG13ZhuuWRdi
    DWqV82FNbUmZymVK/MRaNz2p4Hij9WF3LhZ5kScugxFcsUsMzvhv3Ko5aa9HksordrHICbK9VBXB
    +Fr3piOHurNOSunHyJVTZ3ut9zcYxpYeemSeJLmlzSyRU3zxsNxFcZJ/TaJLTyXkbblGPNpqtqJr
    jp8ULvmZzdVilsnnzGn3RaWnoI6t000aqM06qhWS6lWS4e33RRmlyGPUWryW1dLAE5BPkKFZ/sAa
    JsViyBfkS8gmGUXUGyUOQFTSoNr1I6obAVPvLzsspqTtRSfXqZFii6tW+3lgjUSUKKNxhGcq1qP/
    AKmnwlbriRfen/Q5ZQYo6aX+uHuwZ+a/1AVFdLKRhxXS2a1PmLXPJKrOLWMFq9kaw/NC8Vgomnm2
    0W982h3xWwvuvMInMeqLS5URpbVXqQMX1K0ufsjLXsM9PcK14ehNNpq36ET6mray/YCfLpXlMtNZ
    V9RZG75XYG7X515UG1F3Fv8AYymrp4JeVzSJFactTv8AoLerbBLS873I3kI6Xe68sGHHOLTXMlsN
    3sqAYrLsUnsxS7Fqlvv3KCelVWXzEnhXY02rWA4U174JwZcla3NRed7L8tW1JOLCjGLd5LROI33M
    63vsbbjfn0wTS1bX9wM3fK0aVrZehNNKraroVSvLugNw4kobJPzRpyc5LXny5HOM6ezqsFjxOiSV
    cjO4uOjqMmtVruznJRdOlb5GFLNdBaeM+gzCtQaV16F57JsxSrAr/ssStYfJ+bHMnZvA2v2KLyyS
    v+iX7ltgTKWArKn1Lq6gSxjqR+wpV1A1WDLS9xaoX9wFk7luxQE/YZFV1HPcDJcooAlsLzDotLqg
    FkdE28hqTKKC+n3ARa/2hgu5KVvDZFMY2Qal0VPoRLnizWXgAk0s+4dJka7hpBFFdGiehehAp+pM
    Luw2/clZsqqmuYb8iUv9RVtdqiiW1eWS31NYayGkBMrdEoq37B3fRERLqWxcvshXXYtZ/uASGV7l
    pJ7r0LayksEVLrNGU7ZptEpWgLaS2avuNXhWFXNktbbi+qQK1c+tDU57JKiF1ZEEdZ2TZMrag2u2
    CWv7FFe+3pdjfFV/QB3fcCJZs1aXWtzDz5FphFw1V1fMUtqCw9i6u23cCYqqz9hbTFouPIKid8gn
    XMPpt3I76BFxWBdOjNO7b3N3yAb7Ef8AqHpkjYVQr9hQTrf3CJSspAFXYWxfVeobbwAu/Qu5CKuo
    FfoTyLvhkWAFEKzL3Ao5jkTYItAzqQKOlpvNhSh+i10bMgg05KsQS7kcmHT7kUQL9hsEigS3QX2G
    4xyAtoN7kBFXcjoBK8lFQslMte4Bk8rK2L6oBQd7INi8MDL+xUmMlT58wJdMdy2rJfUIXd2Ke4wL
    AWFnH2D6EAqRHH1Za6FCp/QqF0he3QC2qJbJaeBgA7I2aJjkA9QrTLjkQC7oW2Rqx5pAVcyWPIea
    QQvqW+hH7AKJ9WM3ZcUQBu+gD+w8ioLYNojIyDdksyVVsBbJkY3BQYDoXkgEwaSk9k3W9Ep90AsE
    AG6/wZpWa62SuYUpivYe5b6AQBJ6ew5AKtlVil3DYFw85I2icyNU6A1zTe5HkPeuuQ7AbC16jO/U
    gFvkHXoOorADPJepU3sTF/2LdbALfUrW9mWnYAofkM5rYjABbjAqneAhZUZbLYU57jsOYyA7C/UE
    SwELwEVpInMDWScypciUFVJhrO6ILCNacf0JWaJZchSsOtvuF0sfsADVbgXWMEsBu/3K9hjYm4DF
    BrAXexQRAVqyVjswJ7FyR9xQFsEcegSaWX9ygK6E26lAW98+ZdX+onn+4zLa2BcdGC6Z/okAHMcg
    CCcy/mYAVXux/cAgr5EAKC+pBbgAR7l/sAPwHyL18wAM9fM1yAAzz9QABeRQAgQAKstyLYAA9yLl
    5gFQ5s1zQBFYe5fyxAAgACNR39RLcAKj+pj8wBUXkRgAPy+pprxegBFZlyJ1AAP6S8gAJzL0ACHI
    LZgAZf10WOdwCjMm1KrKtgBofl9DK2YAHo4SX4aUqV6lnmdJZmm8t0AawZAAV//Z}
 
 ################################################################
 
 image create photo ::img::org -data $idata
 image create photo ::img::img
 ::img::img copy ::img::org
 image create photo ::img::small -width $S(sz) -height $S(sz)
 set S(w) [image width ::img::img]
 set S(h) [image height ::img::img]
 DoDisplay
 return

Category Image Processing