Serializing a photo

ulis, 2003-06-22 A photo image can be serialized by saving it in a string that can be used to create later a new photo with the same content.

The essence, as Maurice noted in a newsgroup posting, is

  image create photo img1 -file left.gif
  [image create photo img2] put [img1 data]

save and restore procs

  # ==============================
  #
  #   serializing a photo
  #
  # ==============================
  
  # ---------------------
  # options proc
  #
  # return a list of non empty options
  # ---------------------
  # parm: image name
  # ---------------------
  # return: list of non empty options
  # ---------------------

  proc options {name} \
  {
    set res {}
    foreach option [$name configure] \
    {
      set key [lindex $option 0]
      set value [lindex $option 3]
      if {$value != ""} { lappend res [list $key $value] }
    }
    return $res
  }
  
  # ---------------------
  # photo:save proc
  #
  # return a serialized photo
  # ---------------------
  # parm1: image name
  # parm2: optional option -getdata
  #   -getdata: force to save the data
  # ---------------------
  # return: serialized photo
  # ---------------------
  # use:
  #   photo:save name ?-getdata?
  # ---------------------
  
  proc photo:save {name args} \
  {
    # save name
    set res [list $name]
    # save options
    set options [options $name]
    lappend res $options
    # get data flag
    switch -glob -- $args \
    {
      -get*   { set getdata 1 }
      ""      \
      { 
        set n [lsearch $options -file]
        set getdata [expr {$n == -1 ? 1 : 0}]
      }
      default { error "unknown option \"$args\"" }
    }
    # save data
    if {$getdata} { lappend res [$name data] }
    # return string
    return $res
  }
  
  # ---------------------
  # photo:restore
  #
  # create a photo from a serialized one
  # ---------------------
  # parm1: serialized photo
  # parm2: optional name option
  #   -noname: don't restore the name
  #   non empty: set the name with parm2
  # ---------------------
  # use:
  #   photo:restore image_string ?-noname|name? 
  # ---------------------

  proc photo:restore {image args} \
  {
    # init cmd
    set cmd "image create photo"
    # set name
    switch -glob -- $args \
    {
      -non*   { }
      ""      { append cmd " [lindex $image 0]" }
      default { append cmd " $args" }
    }
    # set options
    foreach option [lindex $image 1] { append cmd " $option" }
    # create photo
    set img [eval $cmd]
    # put data
    if {[llength $image] > 2} { $img put [lindex $image 2] }
  }

The demo

  # ==============================
  #
  # demo
  #
  # ==============================
  
  # create a photo from a string
  image create photo _img1_ -data \
  {
    R0lGODdhCQAJAIAAAASCBPz+/CwAAAAACQAJAAACEYwPp5Aa3BBcMJrqHsua
    P1MAADs=
  }
  # create a photo from a file
  _img1_ write photo.gif
  image create photo _img2_ -file photo.gif
  # save photos
  set saved1 [photo:save _img1_]
  set saved2 [photo:save _img2_]
  # force to save data
  set saved3 [photo:save _img2_ -getdata]
  # delete photos
  image delete _img1_ _img2_
  # restore photos
  photo:restore $saved1
  photo:restore $saved2
  photo:restore $saved3 _img3_
  # show them
  pack [canvas .c]
  .c create image 10 10 -image _img1_
  .c create image 30 10 -image _img2_
  .c create image 50 10 -image _img3_