# ------------------------------------------------------------------------------
# All scripts presented in this page are under BSD License
# Part of TopTcl_1.tcl, see also http://wiki.tcl.tk/27347
# copyright (C) 2012 by Sedat Serper
#
# Permission is hereby granted, free of charge, to any person obtaining a copy of 
# this software and associated documentation files (the ``Software''), to deal in 
# the Software without restriction, including without limitation the rights to use, 
# copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the 
# Software, and to permit persons to whom the Software is furnished to do so, 
# subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included in all 
# copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 
# FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL ROGER E CRITCHLOW 
# JR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF 
# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Purpose : creates centred image on any toplevel, with transparency to mimick a watermark
# ------------------------------------------------------------------------------
proc TLWmark {im {w .}} {
  set wmrk ${w}wmrk
  toplevel $wmrk
  wm geo $wmrk 1x1+5000+5000
  wm attribute $wmrk -alpha 0.1
  wm overrideredirect $wmrk 1
  wm deiconify $wmrk
  
  pack [label $wmrk.l  -image $im] -expand 1 -fill both ;# this will hold the image
  bind $w <FocusIn> "+; raise $wmrk"
  bind $w <Configure> "+; 
    raise $wmrk
    set tmp \[split \[split \[wm geo $w] x] +]
    set wW \[lindex \$tmp 0 0]
    set wH \[lindex \$tmp 0 1]
    if {\$wH>60} {wm geo $wmrk +\[expr \[lindex \$tmp 1]+\$wW/2]+\[expr \[lindex \$tmp 2]+\$wH/2]}
  "

  set imW 30 ;# image width in pixels
  set imH 30 ;# image width in pixels
  wm geo $wmrk ${imW}x${imH}
  
  # In case of rounded images, one can actually trim the toplevel to it's circular form with DLL calls
  # in tG2 there is a wrapper which can perform this, see TopTcl_1.tcl
  catch {
    source $::dev_folder/procedures/TopTcl_1.tcl ;# to generate this wrapper, see Project Properties
    TopTcl $wmrk elliptic ${imW} ${imH} {0 0} 1
    wm attribute ${wmrk}copy -alpha 0.01 
  }
  event generate $w <Configure>
}


# DEMO:
# ALl code developed within Windows Vista, using ActiveTcl v8.4.19, tG² v1.06.01.43
#
image create photo pause_icon -data {
R0lGODlhHgAeAP8AAAUFBgIUmg8QEABVyQBGuAEKmQEqqGt6zAA7sj3E+i2x
93yK1CSn9DxDU9ze4QAjngYGFcHM8t7h4guG6ABn1wM1qgN35CUpKomi4tLS
02yC0zQ5RVd10zpCWYL2/3x+gwgIJAIZopqboTtFZhua8Dl1tUXN+y4zQkVM
WXyH0BCM7mLZ/YyW1lVqwmJ2y7nD1gUOpnKL1I2RmYWQ1UNJV32UxDZVwQRj
ylBmwVptxDtHdVNuynOE0WB70goYs7u7vnZ6goKVzBEZRg0QQIur9Iya2ict
OEtpuUhUg4Sj8F14uC5PtX2AiLLF8rrG8Hh8iBseIdjc7HnQ7XyLwEar7Gtu
ddTa7DtIfhw1gUp+uhUuvxaT7nWLvG18tBUrmRUgorjM+ExalBY8pWLP+EzY
/3X1/1hnnjuk/FfU/B5LpRI2rzVbkg0TjTRIi6zB8yo8rTNIphUYGja794iK
krvL9DCF61VYW01SXt3e3q670khOWg4QPmaG4xBRy05tzKaw4V10zJ6n3klN
VnKK2M7Q1WaA1zQ7SomW2IGL04CV3UJFRdHU2ZGc2liYyRAVckJjxUJmyXOL
yEhoxxwwcIObym7A5V9iaGRpcgsNNhQlbxcmcCwwMmtxejY/Vio0VzlGfDA8
YzdAYoCCinyAhUlTai86YjI1NXN3fT4/QGlqbGlwgKOv1ZCY1pao1J2s1Jag
2qu02qWw1miD2M3Nz21/0L3CzsfKzyNe1CNg1MfK0LC80X6e7a2+7svW6puy
7KTA+oXv/7bJ96G9+dba3qGq3weC3oOZ3snO55at6nWU4HiX4iA/tiBAtiBa
tBxJtR5ruhBYu6CpuTtXukhgoyhHpR0+n0leohQ5sFZ0syFCq6Worj1kx3KH
x1uGxUtnxn2TylRwzMTGyXyMylZtvF5zvlZ6uz1avDV1xGZ5xLy/wi9Zw/7+
/gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAACH5BAEAAOsALAAAAAAeAB4AAAj/ANcJHEiwoMGD
CAk6SCfiw6VLQET8cJAwYQYmNGh06NShYwcUKJhkqEgQzwc9DUYgMdNlypQu
ZpCMaIDiAx6SGVCOCBOkSYSfQHkFCTNT0EiEGe400BEJDJ0/gVixYMHo1R8n
wbjpoHEHYbgNKD5hAENsKqIFKVIsQDTjUCA6GK4YenJQVYMrGJwwSpT2gN+/
PBbMKNIEg44GhApG2xAqhpsiM3gcAIQDR4sWOHLkOBD4kJsYnjgVJGVo2i8M
CzS4yIHOyrEW5sStg9XCBa0FRYRZOyGD4AZQynyldgFIWiyBlLJFEUjOmwsN
MZAlK3VioK0NbYgY09Bjh58lqwQG/xGzfN24Rzt6aEhEpM2GXAKBnIBDZFAh
cJIeLXEl8JsYKwIdYYMk6Q2SBBy8rfOCESC8kYQsHHAAyTbOtCJQJBX0EqA6
kPjBQSG7vAFBFevUcgEEX/DBgQ3MqKHGAzUIpEQALwhETQXXLGMDB3x8AcEm
6yxiCggBwBBAAQGEYEAAXEggATYB5OGAA9WEEEIAWPpQAAgXCKQIBEci+YAB
FTzAhYwP6CKBA2kY8MADYQYAgSIC2QEAGzAUEMIDFSBQQYzrlFOBlMOkgQAC
BoRQAAxsAGCHQKMA4IgPARiAAAGY1iDBOt0g8IIDEjSDKaIB+OAIAKcI9EMc
Q2hhKQEDxO2axToSnDMAJQpCEysBiGqxhwC9CXSBAF70ASsFFFhAQQklUDDB
DVk8k+yufXgBgBEEpQLAELjckOwEKmwxwQQkkLBFMSqoMIEFA9xwyx4AfEDQ
LAIIkEkdFqhAAgMMKODvvwowQMK6dWgCACoGWQKAAFicwa8cCUQsccRy8HsG
FgIA8MNBVWQ8CRVkmGACGiuUvAIaIpNBxSQZi5DQExkLUcIYZXhgMzA2lzFG
CUMsLApJc0ABAABCrNFIJVJIUUkjawgxNBRzkCTQIh9cMDQEIGCCCQgQDH0B
EIlJTZAIgsRRb71GWKKN2GyLHRAAOw==
}

TLWmark pause_icon