ulis, 2007-04-29. Un package pour habiller une image comme une photo sur papier.
Pourquoi
Pour tous ceux qui, comme moi, veulent mettre en album les photos d'un animal qui leur tient à coeur.
Comment
En dessinant une bordure et une petite ombre autour de la photo.
L'idée originale vient de Keith Vetter : http://wiki.tcl.tk/ShadowPhoto
Le package
if {[info exists ::3dphoto::version]} { return }
namespace eval ::3dphoto \
{
#####################################
#
# 3dphoto widget
# -----------------------------------
#
# From Shadow Photo by Keith Vetter
# (see http://wiki.tcl.tk/ShadowPhoto)
#
variable version 1.0
#
# ulis, (C) 2005
# NOL Licence
#
#####################################
# ==========================
#
# package
#
# ==========================
package provide 3dphoto $version
package require Tk
# ====================
#
# entry point
#
# ====================
namespace export 3dphoto
# ====================
#
# global variables
#
# ====================
variable {}
set (map) \
{
fdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfd
fdfdf7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7fdfd
fdf7f7eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeef7f7fd
fdf7eeeed0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0eeeef7fd
fdf7eed0d0bebebebebebebebebebebebebebebebebebed0d0eef7fd
fdf7eed0bebe8d8d8d8d8d8d8d8d8d8d8d8d8d8d8d8dbebed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0be8dffffffffffffffffffffffffffffffff8dbed0eef7fd
fdf7eed0bebe8d8d8d8d8d8d8d8d8d8d8d8d8d8d8d8dbebed0eef7fd
fdf7eed0d0bebebebebebebebebebebebebebebebebebed0d0eef7fd
fdf7eeeed0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0eeeef7fd
fdf7f7eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeef7f7fd
fdfdf7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7fdfd
fdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfdfd
}
# ====================
#
# 3dphoto proc
#
# ====================
proc 3dphoto {photo {bg1 ""} {bg2 ""}} \
{
variable {}
if {$bg1 == ""} { set bg1 [. cget -bg] }
if {$bg2 == ""} { set bg2 $bg1 }
if {![info exists (borders:$bg1:$bg2)]} \
{ set (borders:$bg1:$bg2) [map2img $(map) $bg1 $bg2] }
set width [image width $photo]
set height [image height $photo]
set width1 [incr width 14]
set height1 [incr height 14]
incr width 14
incr height 14
set new [image create photo -width $width -height $height]
set bds $(borders:$bg1:$bg2)
$new copy $bds -from 0 0 14 14 -to 0 0
$new copy $bds -from 14 0 15 14 -to 14 0 $width1 14
$new copy $bds -from 14 0 28 14 -to $width1 0
$new copy $bds -from 0 14 14 15 -to 0 14 28 $height1
$new copy $photo -to 14 14
$new copy $bds -from 14 14 28 15 -to $width1 14 $width $height1
$new copy $bds -from 0 14 14 28 -to 0 $height1
$new copy $bds -from 14 14 15 28 -to 14 $height1 $width1 $height
$new copy $bds -from 14 14 28 28 -to $width1 $height1
return $new
}
# ====================
#
# map2img proc
#
# ====================
proc map2img {map bg1 bg2} \
{
# v3d
# get data
set data [list]
foreach {(R) (G) (B)} [winfo rgb . $bg1] break
foreach C {R G B} { set ($C) [expr {$($C) & 255}] }
foreach {r g b} [winfo rgb . $bg2] break
foreach c {r g b} { set v [set $c]; set $c [expr {$v & 255}] }
set bg2 [format #%2.2x%2.2x%2.2x $r $g $b]
# create pixels map
set y 0
foreach line $map \
{
set x 0
set row [list]
foreach {pix1 pix2} [split $line {}] \
{
if {[string equal -nocase $pix1$pix2 ff]} \
{
lappend row $bg2
} \
else \
{
set m [expr 0x$pix1$pix2 / 255.0]
foreach C {R G B} c {r g b} \
{
set ($c) [expr {round($($C) * $m)}]
if {$($c) > 255} { set ($c) 255 }
}
lappend row [format #%2.2x%2.2x%2.2x $(r) $(g) $(b)]
}
incr x
}
lappend data $row
incr y
}
# create photo
set photo [image create photo]
$photo put $data
# return photo
return $photo
}
}
namespace import ::3dphoto::3dphotoLa démo
#####################################
#
# 3dphoto demo
#
#####################################
package require 3dphoto
# http://www.huskyhaven.net/images/album/ulis/photo_1.jpg
# http://www.huskyhaven.net/images/album/ulis/photo_2.jpg
# http://www.huskyhaven.net/images/album/ulis/photo_3.jpg
# http://www.huskyhaven.net/images/album/ulis/photo_4.jpg
set width [winfo pixel . 21c]
set height [winfo pixel . 27c]
set bg1 white
set bg2 beige
. config -bg $bg1
wm geometry . =${width}x$height
foreach i {1 2 3 4} \
{
set img [image create photo -file photo_$i.gif]
frame .f$i
label .f$i.i -image [3dphoto $img $bg1 $bg2] -padx 0 -pady 0
label .f$i.t -text photo_$i.gif
pack .f$i.i .f$i.t
}
grid .f1 .f2
grid .f3 .f4
grid rowconfig . {0 1} -weight 1
grid columnconf . {0 1} -weight 1Voir aussi
Discussion
Catégorie Paquet | Catégorie Traitement d'image