3dphoto

 

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::3dphoto

La 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 1

Voir aussi


Discussion


Catégorie Paquet | Catégorie Traitement d'image