# PB:------------------------------------------------------------------------
#
$PB{'tk_canvasImage.pl'}{'Author'}     ="Thomas M.P. Catsburg";
$PB{'tk_canvasImage.pl'}{'Class'}      ="subroutine";
$PB{'tk_canvasImage.pl'}{'Date'}       ="19Jun2018";
$PB{'tk_canvasImage.pl'}{'Description'}="Given a configuration - add an image to a given canvas or use a popup canvas - resize if needed to fit given or actual size";
$PB{'tk_canvasImage.pl'}{'Filename'}   ="tk_canvasImage.pl";
$PB{'tk_canvasImage.pl'}{'Version'}    ="1.0";
#
#  1.0  17Jun2019  Initial writing
#

sub tk_canvasImage
{
  # Get the incoming parameters
  my %NVP=&nvp(@_);


  #---------------------------------------------------------------------------

  ### #####
   #  #    #
   #  #    #
   #  #    #
   #  #    #
  ### #####

  # If not given a key
  if(! defined $NVP{'Id'})
  {
    # Generate a key
    $NVP{'Id'}=&newkey({'Join'=>''});
  }


  #---------------------------------------------------------------------------

   ####    ##   #    # #    #   ##    ####
  #    #  #  #  ##   # #    #  #  #  #
  #      #    # # #  # #    # #    #  ####
  #      ###### #  # # #    # ######      #
  #    # #    # #   ##  #  #  #    # #    #
   ####  #    # #    #   ##   #    #  ####

  # Set a default canvas width
  my $cw=200;

  # Set a default canvas height
  my $ch=200;

  # Need to look for config{'canvas'} and make that the tk{'canvas'} otherwise do the popup thing
  if(Tk::Exists($NVP{'Canvas'}))
  {
    # Make the current canvas the given canvas
    $TK{'canvas-'.$NVP{'Id'}}=$NVP{'Canvas'};

    # Update the main window so the canvas sizes
    $TK{'mw'}->update();

    # Get the canvas width
    $cw=$TK{'canvas-'.$NVP{'Id'}}->width();

    # Get the canvas height
    $ch=$TK{'canvas-'.$NVP{'Id'}}->height();
  }
  else
  {
    # Create the popupwindow
    $TK{'pw-'.$NVP{'Id'}}=$TK{'mw'}->Toplevel('-title' => $NVP{'Title'});

    # Create a geometry string for the popup
    my $geometry=$NVP{'Width'} . 'x' . $NVP{'Height'};

    # Size the popupwindow
    $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);

    # Set the maximum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->maxsize($NVP{'Width'}, $NVP{'Height'}) if($NVP{'Maxsize'} =~ /yes|true|1|on/i);

    # Set the minimum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->minsize($NVP{'Width'}, $NVP{'Height'}) if($NVP{'Minsize'} =~ /yes|true|1|on/i);

    # Add main window icon if icon is defined
    if($TK{'icon'})
    {
      # Have no idea what this does but the logo does not work without it
      $TK{'pw-'.$NVP{'Id'}}->idletasks;

      # Change the Tk window and idle icon to the supplied image
      $TK{'pw-'.$NVP{'Id'}}->iconimage($TK{'icon'});
    }

    # Configure the popup window with the new title
    $TK{'pw-'.$NVP{'Id'}}->configure('-title' => $NVP{'Title'});

    # Create the main canvas
    $TK{'canvas-'.$NVP{'Id'}}=$TK{'pw-'.$NVP{'Id'}}->Canvas(-background => $NVP{'Background'},
                                                            -bd         => 1,
                                                            -relief     => 'sunken')->pack(-fill   => 'both',
                                                                                           -anchor => 'center',
                                                                                           -expand => 1);

    # Set the canvas width
    $cw=$NVP{'Width'};

    # Set the canvas height
    $ch=$NVP{'Height'};
  }


  #---------------------------------------------------------------------------

  #####   ####  #####   ####  #    # #####
  #    # #    # #    # #    # #    #   #
  #    # #    # #    # #    # #    #   #
  #####  #    # #####  #    # #    #   #
  #      #    # #      #    # #    #   #
  #       ####  #       ####   ####    #

  # If popout button is true
  if($NVP{'Popout'} =~ /yes|true|^1$|on/i)
  {
    # If bitmappopoutnw does not exist
    if($TK{'bitmappopoutnw'} eq '')
    {
      # Create an xbm bitmap
      my $xbmbits = pack("b9" x 9,
                         ".........",
                         ".11111111",
                         ".1.......",
                         ".1.1111..",
                         ".1.11....",
                         ".1.1.1...",
                         ".1.1..1..",
                         ".1.....1.",
                         ".........");

      # Pack xbmbits into a popout arrow bitmap for the button
      $TK{'mw'}->DefineBitmap('bitmappopoutnw' => 9, 9, $xbmbits);

      # Set $TK{'bitmappopoutnw'} so we don't recreate the bitmappopoutnw
      $TK{'bitmappopoutnw'}='true';
    }

    # Create a popout button
    $TK{'popbutton-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Button(-bitmap  => 'bitmappopoutnw',
                                                                   -command => sub { &tk_canvasImage({'file'       => $NVP{'File'},
                                                                                                      'title'      => $NVP{'Title'},
                                                                                                      'boundary'   => $NVP{'Boundary'},
                                                                                                      'popout'     => 'false',
                                                                                                      'width'      => $NVP{'Width'},
                                                                                                      'height'     => $NVP{'Height'},
                                                                                                      'background' => $NVP{'Background'},
                                                                                                      'boundary'   => $NVP{'Boundary'}}); })->place(-x => 5, -y => 5, -anchor => 'nw');
  }

  #---------------------------------------------------------------------------

  #####  ######  ####  ### ######   ##   #####  #      ######
  #    # #      #       #      #   #  #  #    # #      #
  #    # #####   ####   #     #   #    # #####  #      #####
  #####  #           #  #    #    ###### #    # #      #
  #   #  #      #    #  #   #     #    # #    # #      #
  #    # ######  ####  ### ###### #    # #####  ###### ######

  # Add redraw capability bound to canvas resize event
  if($NVP{'Resizable'} !~ /no|false|^0$|off/i)
  {
    # Bind Canvas resizing to clear and redraw the donut graph
    $TK{'canvas-'.$NVP{'Id'}}->Tk::bind('<Configure>' => sub { # Clear the graph
                                                               $TK{'canvas-'.$NVP{'Id'}}->delete('all');

                                                               # Redraw the graph
                                                               &tk_canvasImage({'file'         => $NVP{'File'},
                                                                                'title'        => $NVP{'Title'},
                                                                                'boundary'     => $NVP{'Boundary'},
                                                                                'popout'       => $NVP{'Popout'},
                                                                                'background'   => $NVP{'Background'},
                                                                                'boundary'     => $NVP{'Boundary'},
                                                                                'canvas'       => $TK{'canvas-'.$NVP{'Id'}},
                                                                                'id'           => $NVP{'Id'}}); });
  }


  #---------------------------------------------------------------------------

  #####  ###### ######   ##   #    # #      #####  ####
  #    # #      #       #  #  #    # #        #   #
  #    # #####  #####  #    # #    # #        #    ####
  #    # #      #      ###### #    # #        #        #
  #    # #      #      #    # #    # #        #   #    #
  #####  ###### #      #    #  ####  ######   #    ####

  # Set the Tk title as the parameter
  $NVP{'Title'}='tk_canvasImage() View Image' if($NVP{'Title'} eq '');

  # Default background is white
  $NVP{'Background'}='white' if($NVP{'Background'} eq '');

  # Boundary
  $NVP{'Boundary'}=0 if($NVP{'Boundary'} eq '');

  # Default window to minimum of 200 pixels wide or tall
  $NVP{'Width'}=200 if($NVP{'Width'} < 200);
  $NVP{'Height'}=200 if($NVP{'Height'} < 200);


  #---------------------------------------------------------------------------

   ####  ###### ##### #    # #####
  #      #        #   #    # #    #
   ####  #####    #   #    # #    #
       # #        #   #    # #####
  #    # #        #   #    # #
   ####  ######   #    ####  #

  # Get the image extension
  my $extension=lc(&justext($NVP{'File'}));

  # Make a unique image name - so each picture is unique
  my $imagename=&newkey({'Join'=>''});

  # Set the canvas width minus 2x boundary
  $cw=$cw-2*$NVP{'Boundary'};

  # Set the canvas height minus 2x boundary
  $ch=$ch-2*$NVP{'Boundary'};

  # Set background color
  $TK{'canvas-'.$NVP{'Id'}}->configure(-background => $NVP{'Background'});

  # If the image can be read and is a gif or jpg
  if((-r $NVP{'File'}) && ($extension =~ /gif|jpg/i))
  {
    # Get file information
    %file=&getFileInfo($NVP{'File'});

    # Alter extension for jpg - a Tk thing
    $extension='jpeg' if($extension =~ /jpg/);

    # Create an image object for the ploc
    $TK{'image-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo($imagename,
                                                              -file   => $NVP{'File'},
                                                              -format => $extension);

    # Get original Photo width dimension
    my $picx=$TK{'image-'.$NVP{'Id'}}->width();

    # Get original Photo height dimension
    my $picy=$TK{'image-'.$NVP{'Id'}}->height();

    # Add size to file info
    $file{'width'}=$picx;
    $file{'height'}=$picy;

    # Create an x factor
    my $xfactor=1;

    # Create a y factor
    my $yfactor=1;

    # If the image width is greater than the canvas width - calculate a scaling
    if($picx > $cw)
    {
      # Make the scale factor based on the canvas width relative to the image width
      $xfactor=$picx/($cw+.001);
    }

    # If the image height is greater than the canvas height - calculate a scaling
    if($picy > $ch)
    {
      # Make the scale factor based on the canvas width relative to the image width
      $yfactor=$picy/$ch;
    }

    # Set scaling to x factor
    my $factor=int($xfactor+0.5);

    # Set scaling to greatest of x or y
    if($yfactor > $xfactor)
    {
      $factor=int($yfactor+0.5);
    }

    # Add scale to file info
    $file{'scale'}=$factor;

    #-------------------------------------------------------------------------
    #
    # Resize or not
    #

    # If picy < canvas height and picx < canvas width then display the unscaled image
    if(($picy < $ch) && ($picx < $cw))
    {
      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->createImage(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                            -image  => $TK{'image-'.$NVP{'Id'}},
                                                                            -anchor => 'c');
    }
    else
    {
      # Create a second Photo - scaled from information from the original image
      $TK{'resizedimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo('resized' . $imagename);

      # Rescale the Photo
      $TK{'resizedimage-'.$NVP{'Id'}}->copy($TK{'image-'.$NVP{'Id'}}, -shrink, -subsample => $factor, $factor );

      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->createImage(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                            -image  => $TK{'resizedimage-'.$NVP{'Id'}},
                                                                            -anchor => 'c');

      # Get the resized image width
      $picx=$TK{'resizedimage-'.$NVP{'Id'}}->width();

      # Get the resized image height
      $picy=$TK{'resizedimage-'.$NVP{'Id'}}->height();

      # If a popup then resize the popup!
      if(! $NVP{'Canvas'})
      {
        my $geometry=int($picx+2*$NVP{'Boundary'}) .'x' . int($picy+2*$NVP{'Boundary'});

        $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);
      }
    }
  }

  # Error could not read file
  else
  {
    # Set the error
    $file{'Error'}="ERROR: Could not read file=$NVP{'file'}";
  }

  # Return the parameter set - which includes the canvas - or just the id
#  return wantarray ? $NVP{'Id'} : $TK{'canvas-'.$NVP{'Id'}};
  return $NVP{'Id'};
}

# End

# Announce
print "execute file=" . __FILE__ . "\n";

## Require the test setup
require "C:/pb/lib/require_test_setup.pl";

# Return if called to not test code
return 1 if($0 ne __FILE__);

## Require included subroutines ... instead of pasting them in here
require "arraytext.pl";
require "data.pl";
require "getFileInfo.pl";
require "greaterof.pl";
require "hash2table.pl";
require "hashtext.pl";
require "justext.pl";
require "longest.pl";
require "newkey.pl";
require "nvp.pl";
require "loadColors.pl";
require "readFile.pl";
require "someday.pl";
require "tabletext.pl";

## Require the tk setup
require "C:/pb/lib/require_tk_setup.pl";

## Required tk subroutines
require "tk_chooseFile.pl";
require "tk_destroyImages.pl";
require "tk_helpAbout.pl";
require "tk_helpDump.pl";
require "tk_popupClose.pl";
require "tk_viewHash.pl";

# Divider
print '- ' x 40 , "\n\n";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Test cases
#
print "\n$0 Tests begin:\n\n";

# Announce
&tk_console($TK{'console'}, "$0\n");


#-----------------------------------------------------------------------------
#
# Test specific Tk code
#

# Create a geometry string for the main window
my $geometry='400x800+800+100';

# Size the popupwindow
$TK{'mw'}->geometry($geometry);

# Add an view table button
$TK{'dib'}=$TK{'mw'}->Button(-text    => 'Destroy Images',
                             -command => \&tk_destroyImages)->pack();

# Add a dump
$TK{'dump'}=$TK{'mw'}->Button(-text    => 'Dump TK',
                              -command => \&tk_helpDump)->pack();

# Add a canvas into the main window for embedded
$TK{'canvas'}=$TK{'mw'}->Canvas('-background' => 'white',
                                '-bd'         => 1,
                                '-relief'     => 'sunken')->pack('-fill'   => 'both',
                                                                 '-anchor' => 'center',
                                                                 '-expand' => 1);


#-----------------------------------------------------------------------------
#
# Test #1 - Configuration #1 in a popup window
#
# Add a canvas image button to the test window
my $canvasbutton1 = $TK{'mw'}->Button(-text    => 'Popup canvas image - config 1',
                                      -command => sub { &tk_canvasImage({'background' => 'white',

                                                                         # Link to the image file
                                                                         'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                         # Set the title and poup window height and width - this limits the image display size
                                                                         'Title'      => 'Our Future President',
                                                                         'Width'      => 500,
                                                                         'Height'     => 300,

                                                                         # Set popout false - since it's already a popout
                                                                         'Popout'     => 'false',

                                                                         # Set a background color
                                                                         'background' => $COLOR{'purple'},

                                                                         # Set a boundary around the image
                                                                         'boundary'   => 25,

                                                                         # Set the boundary in pixels around the image in the canvas
                                                                         'boundary'   => 5}); })->pack();


#-----------------------------------------------------------------------------
#
# Test #2 - Configuration #2 in the embedded window
#
# Add a canvas image button to the test window
my $canvasbutton2 = $TK{'mw'}->Button(-text    => 'Embeded canvas image - config 2',
                                      -command => sub { &tk_canvasImage({'canvas'     => $TK{'canvas'},

                                                                         # Link to the image file
                                                                         'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                         # Set popout true
                                                                         'Popout'     => 'true',

                                                                         # Set the title and poup window height and width - this limits the image display size
                                                                         'background' => $COLOR{'lightgray'},

                                                                         # Set the boundary in pixels around the image in the canvas
                                                                         'boundary'   => 20}); })->pack();

# Add a close button to the test window
my $clearbutton = $TK{'mw'}->Button(-text => 'Clear Embedded Canvas', -command => sub{ $TK{'canvas'}->delete('all'); })->pack();


#########################################################

#-----------------------------------------------------------------------------


# Start the GUI infinite loop.
MainLoop();


#-----------------------------------------------------------------------------

#########################################################


# Announce
print "\n$0 done.\n";

# End

<p>
In any case, here's the full code of tk_canvasImage() just for fun ...
<code>
# PB:------------------------------------------------------------------------
#
$PB{'tk_canvasImage.pl'}{'Author'}     ="Thomas M.P. Catsburg";
$PB{'tk_canvasImage.pl'}{'Class'}      ="subroutine";
$PB{'tk_canvasImage.pl'}{'Date'}       ="19Jun2018";
$PB{'tk_canvasImage.pl'}{'Description'}="Given a configuration - add an image to a given canvas or use a popup canvas - resize if needed to fit given or actual size";
$PB{'tk_canvasImage.pl'}{'Filename'}   ="tk_canvasImage.pl";
$PB{'tk_canvasImage.pl'}{'Version'}    ="1.0";
#
#  1.0  17Jun2019  Initial writing
#

sub tk_canvasImage
{
  # Get the incoming parameters
  my %NVP=&nvp(@_);


  #---------------------------------------------------------------------------

  ### #####
   #  #    #
   #  #    #
   #  #    #
   #  #    #
  ### #####

  # If not given a key
  if(! defined $NVP{'Id'})
  {
    # Generate a key
    $NVP{'Id'}=&newkey({'Join'=>''});
  }


  #---------------------------------------------------------------------------

   ####    ##   #    # #    #   ##    ####
  #    #  #  #  ##   # #    #  #  #  #
  #      #    # # #  # #    # #    #  ####
  #      ###### #  # # #    # ######      #
  #    # #    # #   ##  #  #  #    # #    #
   ####  #    # #    #   ##   #    #  ####

  # Set a default canvas width
  my $cw=200;

  # Set a default canvas height
  my $ch=200;

  # Need to look for config{'canvas'} and make that the tk{'canvas'} otherwise do the popup thing
  if(Tk::Exists($NVP{'Canvas'}))
  {
    # Make the current canvas the given canvas
    $TK{'canvas-'.$NVP{'Id'}}=$NVP{'Canvas'};

    # Update the main window so the canvas sizes
    $TK{'mw'}->update();

    # Get the canvas width
    $cw=$TK{'canvas-'.$NVP{'Id'}}->width();

    # Get the canvas height
    $ch=$TK{'canvas-'.$NVP{'Id'}}->height();
  }
  else
  {
    # Create the popupwindow
    $TK{'pw-'.$NVP{'Id'}}=$TK{'mw'}->Toplevel('-title' => $NVP{'Title'});

    # Create a geometry string for the popup
    my $geometry=$NVP{'Width'} . 'x' . $NVP{'Height'};

    # Size the popupwindow
    $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);

    # Set the maximum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->maxsize($NVP{'Width'}, $NVP{'Height'}) if($NVP{'Maxsize'} =~ /yes|true|1|on/i);

    # Set the minimum size for the popup
    $TK{'pw-'.$NVP{'Id'}}->minsize($NVP{'Width'}, $NVP{'Height'}) if($NVP{'Minsize'} =~ /yes|true|1|on/i);

    # Add main window icon if icon is defined
    if($TK{'icon'})
    {
      # Have no idea what this does but the logo does not work without it
      $TK{'pw-'.$NVP{'Id'}}->idletasks;

      # Change the Tk window and idle icon to the supplied image
      $TK{'pw-'.$NVP{'Id'}}->iconimage($TK{'icon'});
    }

    # Configure the popup window with the new title
    $TK{'pw-'.$NVP{'Id'}}->configure('-title' => $NVP{'Title'});

    # Create the main canvas
    $TK{'canvas-'.$NVP{'Id'}}=$TK{'pw-'.$NVP{'Id'}}->Canvas(-background => $NVP{'Background'},
                                                            -bd         => 1,
                                                            -relief     => 'sunken')->pack(-fill   => 'both',
                                                                                           -anchor => 'center',
                                                                                           -expand => 1);

    # Set the canvas width
    $cw=$NVP{'Width'};

    # Set the canvas height
    $ch=$NVP{'Height'};
  }


  #---------------------------------------------------------------------------

  #####   ####  #####   ####  #    # #####
  #    # #    # #    # #    # #    #   #
  #    # #    # #    # #    # #    #   #
  #####  #    # #####  #    # #    #   #
  #      #    # #      #    # #    #   #
  #       ####  #       ####   ####    #

  # If popout button is true
  if($NVP{'Popout'} =~ /yes|true|^1$|on/i)
  {
    # If bitmappopoutnw does not exist
    if($TK{'bitmappopoutnw'} eq '')
    {
      # Create an xbm bitmap
      my $xbmbits = pack("b9" x 9,
                         ".........",
                         ".11111111",
                         ".1.......",
                         ".1.1111..",
                         ".1.11....",
                         ".1.1.1...",
                         ".1.1..1..",
                         ".1.....1.",
                         ".........");

      # Pack xbmbits into a popout arrow bitmap for the button
      $TK{'mw'}->DefineBitmap('bitmappopoutnw' => 9, 9, $xbmbits);

      # Set $TK{'bitmappopoutnw'} so we don't recreate the bitmappopoutnw
      $TK{'bitmappopoutnw'}='true';
    }

    # Create a popout button
    $TK{'popbutton-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Button(-bitmap  => 'bitmappopoutnw',
                                                                   -command => sub { &tk_canvasImage({'file'       => $NVP{'File'},
                                                                                                      'title'      => $NVP{'Title'},
                                                                                                      'boundary'   => $NVP{'Boundary'},
                                                                                                      'popout'     => 'false',
                                                                                                      'width'      => $NVP{'Width'},
                                                                                                      'height'     => $NVP{'Height'},
                                                                                                      'background' => $NVP{'Background'},
                                                                                                      'boundary'   => $NVP{'Boundary'}}); })->place(-x => 5, -y => 5, -anchor => 'nw');
  }

  #---------------------------------------------------------------------------

  #####  ######  ####  ### ######   ##   #####  #      ######
  #    # #      #       #      #   #  #  #    # #      #
  #    # #####   ####   #     #   #    # #####  #      #####
  #####  #           #  #    #    ###### #    # #      #
  #   #  #      #    #  #   #     #    # #    # #      #
  #    # ######  ####  ### ###### #    # #####  ###### ######

  # Add redraw capability bound to canvas resize event
  if($NVP{'Resizable'} !~ /no|false|^0$|off/i)
  {
    # Bind Canvas resizing to clear and redraw the donut graph
    $TK{'canvas-'.$NVP{'Id'}}->Tk::bind('<Configure>' => sub { # Clear the graph
                                                               $TK{'canvas-'.$NVP{'Id'}}->delete('all');

                                                               # Redraw the graph
                                                               &tk_canvasImage({'file'         => $NVP{'File'},
                                                                                'title'        => $NVP{'Title'},
                                                                                'boundary'     => $NVP{'Boundary'},
                                                                                'popout'       => $NVP{'Popout'},
                                                                                'background'   => $NVP{'Background'},
                                                                                'boundary'     => $NVP{'Boundary'},
                                                                                'canvas'       => $TK{'canvas-'.$NVP{'Id'}},
                                                                                'id'           => $NVP{'Id'}}); });
  }


  #---------------------------------------------------------------------------

  #####  ###### ######   ##   #    # #      #####  ####
  #    # #      #       #  #  #    # #        #   #
  #    # #####  #####  #    # #    # #        #    ####
  #    # #      #      ###### #    # #        #        #
  #    # #      #      #    # #    # #        #   #    #
  #####  ###### #      #    #  ####  ######   #    ####

  # Set the Tk title as the parameter
  $NVP{'Title'}='tk_canvasImage() View Image' if($NVP{'Title'} eq '');

  # Default background is white
  $NVP{'Background'}='white' if($NVP{'Background'} eq '');

  # Boundary
  $NVP{'Boundary'}=0 if($NVP{'Boundary'} eq '');

  # Default window to minimum of 200 pixels wide or tall
  $NVP{'Width'}=200 if($NVP{'Width'} < 200);
  $NVP{'Height'}=200 if($NVP{'Height'} < 200);


  #---------------------------------------------------------------------------

   ####  ###### ##### #    # #####
  #      #        #   #    # #    #
   ####  #####    #   #    # #    #
       # #        #   #    # #####
  #    # #        #   #    # #
   ####  ######   #    ####  #

  # Get the image extension
  my $extension=lc(&justext($NVP{'File'}));

  # Make a unique image name - so each picture is unique
  my $imagename=&newkey({'Join'=>''});

  # Set the canvas width minus 2x boundary
  $cw=$cw-2*$NVP{'Boundary'};

  # Set the canvas height minus 2x boundary
  $ch=$ch-2*$NVP{'Boundary'};

  # Set background color
  $TK{'canvas-'.$NVP{'Id'}}->configure(-background => $NVP{'Background'});

  # If the image can be read and is a gif or jpg
  if((-r $NVP{'File'}) && ($extension =~ /gif|jpg/i))
  {
    # Get file information
    %file=&getFileInfo($NVP{'File'});

    # Alter extension for jpg - a Tk thing
    $extension='jpeg' if($extension =~ /jpg/);

    # Create an image object for the ploc
    $TK{'image-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo($imagename,
                                                              -file   => $NVP{'File'},
                                                              -format => $extension);

    # Get original Photo width dimension
    my $picx=$TK{'image-'.$NVP{'Id'}}->width();

    # Get original Photo height dimension
    my $picy=$TK{'image-'.$NVP{'Id'}}->height();

    # Add size to file info
    $file{'width'}=$picx;
    $file{'height'}=$picy;

    # Create an x factor
    my $xfactor=1;

    # Create a y factor
    my $yfactor=1;

    # If the image width is greater than the canvas width - calculate a scaling
    if($picx > $cw)
    {
      # Make the scale factor based on the canvas width relative to the image width
      $xfactor=$picx/($cw+.001);
    }

    # If the image height is greater than the canvas height - calculate a scaling
    if($picy > $ch)
    {
      # Make the scale factor based on the canvas width relative to the image width
      $yfactor=$picy/$ch;
    }

    # Set scaling to x factor
    my $factor=int($xfactor+0.5);

    # Set scaling to greatest of x or y
    if($yfactor > $xfactor)
    {
      $factor=int($yfactor+0.5);
    }

    # Add scale to file info
    $file{'scale'}=$factor;

    #-------------------------------------------------------------------------
    #
    # Resize or not
    #

    # If picy < canvas height and picx < canvas width then display the unscaled image
    if(($picy < $ch) && ($picx < $cw))
    {
      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->createImage(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                            -image  => $TK{'image-'.$NVP{'Id'}},
                                                                            -anchor => 'c');
    }
    else
    {
      # Create a second Photo - scaled from information from the original image
      $TK{'resizedimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->Photo('resized' . $imagename);

      # Rescale the Photo
      $TK{'resizedimage-'.$NVP{'Id'}}->copy($TK{'image-'.$NVP{'Id'}}, -shrink, -subsample => $factor, $factor );

      # Display the image
      $TK{'canvasimage-'.$NVP{'Id'}}=$TK{'canvas-'.$NVP{'Id'}}->createImage(int($cw/2)+$NVP{'Boundary'}, int($ch/2)+$NVP{'Boundary'},
                                                                            -image  => $TK{'resizedimage-'.$NVP{'Id'}},
                                                                            -anchor => 'c');

      # Get the resized image width
      $picx=$TK{'resizedimage-'.$NVP{'Id'}}->width();

      # Get the resized image height
      $picy=$TK{'resizedimage-'.$NVP{'Id'}}->height();

      # If a popup then resize the popup!
      if(! $NVP{'Canvas'})
      {
        my $geometry=int($picx+2*$NVP{'Boundary'}) .'x' . int($picy+2*$NVP{'Boundary'});

        $TK{'pw-'.$NVP{'Id'}}->geometry($geometry);
      }
    }
  }

  # Error could not read file
  else
  {
    # Set the error
    $file{'Error'}="ERROR: Could not read file=$NVP{'file'}";
  }

  # Return the parameter set - which includes the canvas - or just the id
#  return wantarray ? $NVP{'Id'} : $TK{'canvas-'.$NVP{'Id'}};
  return $NVP{'Id'};
}

# End

# Announce
print "execute file=" . __FILE__ . "\n";

## Require the test setup
require "C:/pb/lib/require_test_setup.pl";

# Return if called to not test code
return 1 if($0 ne __FILE__);

## Require included subroutines ... instead of pasting them in here
require "arraytext.pl";
require "data.pl";
require "getFileInfo.pl";
require "greaterof.pl";
require "hash2table.pl";
require "hashtext.pl";
require "justext.pl";
require "longest.pl";
require "newkey.pl";
require "nvp.pl";
require "loadColors.pl";
require "readFile.pl";
require "someday.pl";
require "tabletext.pl";

## Require the tk setup
require "C:/pb/lib/require_tk_setup.pl";

## Required tk subroutines
require "tk_chooseFile.pl";
require "tk_destroyImages.pl";
require "tk_helpAbout.pl";
require "tk_helpDump.pl";
require "tk_popupClose.pl";
require "tk_viewHash.pl";

# Divider
print '- ' x 40 , "\n\n";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Test cases
#
print "\n$0 Tests begin:\n\n";

# Announce
&tk_console($TK{'console'}, "$0\n");


#-----------------------------------------------------------------------------
#
# Test specific Tk code
#

# Create a geometry string for the main window
my $geometry='400x800+800+100';

# Size the popupwindow
$TK{'mw'}->geometry($geometry);

# Add an view table button
$TK{'dib'}=$TK{'mw'}->Button(-text    => 'Destroy Images',
                             -command => \&tk_destroyImages)->pack();

# Add a dump
$TK{'dump'}=$TK{'mw'}->Button(-text    => 'Dump TK',
                              -command => \&tk_helpDump)->pack();

# Add a canvas into the main window for embedded
$TK{'canvas'}=$TK{'mw'}->Canvas('-background' => 'white',
                                '-bd'         => 1,
                                '-relief'     => 'sunken')->pack('-fill'   => 'both',
                                                                 '-anchor' => 'center',
                                                                 '-expand' => 1);


#-----------------------------------------------------------------------------
#
# Test #1 - Configuration #1 in a popup window
#
# Add a canvas image button to the test window
my $canvasbutton1 = $TK{'mw'}->Button(-text    => 'Popup canvas image - config 1',
                                      -command => sub { &tk_canvasImage({'background' => 'white',

                                                                         # Link to the image file
                                                                         'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                         # Set the title and poup window height and width - this limits the image display size
                                                                         'Title'      => 'Our Future President',
                                                                         'Width'      => 500,
                                                                         'Height'     => 300,

                                                                         # Set popout false - since it's already a popout
                                                                         'Popout'     => 'false',

                                                                         # Set a background color
                                                                         'background' => $COLOR{'purple'},

                                                                         # Set a boundary around the image
                                                                         'boundary'   => 25,

                                                                         # Set the boundary in pixels around the image in the canvas
                                                                         'boundary'   => 5}); })->pack();


#-----------------------------------------------------------------------------
#
# Test #2 - Configuration #2 in the embedded window
#
# Add a canvas image button to the test window
my $canvasbutton2 = $TK{'mw'}->Button(-text    => 'Embeded canvas image - config 2',
                                      -command => sub { &tk_canvasImage({'canvas'     => $TK{'canvas'},

                                                                         # Link to the image file
                                                                         'file'       => "C:\\pb\\test\\images\\2018.06.15_EC_and_MP.jpg",

                                                                         # Set popout true
                                                                         'Popout'     => 'true',

                                                                         # Set the title and poup window height and width - this limits the image display size
                                                                         'background' => $COLOR{'lightgray'},

                                                                         # Set the boundary in pixels around the image in the canvas
                                                                         'boundary'   => 20}); })->pack();

# Add a close button to the test window
my $clearbutton = $TK{'mw'}->Button(-text => 'Clear Embedded Canvas', -command => sub{ $TK{'canvas'}->delete('all'); })->pack();


#########################################################

#-----------------------------------------------------------------------------


# Start the GUI infinite loop.
MainLoop();


#-----------------------------------------------------------------------------

#########################################################


# Announce
print "\n$0 done.\n";

# End