images.tcl

::pwtk::imageTile

::pwtk::imageTile

SYNOPSIS

proc ::pwtk::imageTile {args} {

USAGE

   ::pwtk::imageTile  ?OPTIONS?  INPUT_IMAGE_LIST  OUTPUT_IMAGE  ?LABEL_LIST?

PURPOSE

Tile a set of graphics images into a matrix form, and, if requested, entitle each constituent image with a label.

ImageMagick (https://imagemagick.org/) is used to manipulate images.

OPTIONS

-lspecs LABEL_SPECS ... specs for the image labels; LABEL_SPECS are options passed to ImageMagick "convert", e.g., "-pointsize 35 -font Arial -gravity center -fill {#aa0000} -background {#ffffaa}"
-lpos LABEL_POSITION ... position of image labels: top or botom
-tile NXxNY ... tile specs {#-of-columns}x{#-of-rows}, i.e., the -tile option of ImageMagick "montage"
-size SIZE ... size of constituent figures (in px); associated with -size & -geometry of ImageMagick "convert"
-gap +X+Y? ... gap between constituent figures (in px); associated with -geometry of ImageMagick "convert"
-b BORDER_THICKNESS? ... border thickens around constituent images; the -border option of ImageMagick "convert
-bc BORDER_COLOR ... border color around constituent images; the -bordercolor option of ImageMagick "convert

ARGUMENTS

INPUT_IMAGE_LIST --- list of images to tile with optional labels; this list has the following syntax: {image1 ?label1?} {image2 ?label2?} ... where label1, label2... are optional
OUTPUT_IMAGE --- name of the output image
LABEL_LIST --- (optional) list of labels associated with INPUT_IMAGE_LIST; if labels are specified in both INPUT_IMAGE_LIST and LABEL_LIST, the latter has priority

RETURN VALUE

The filename of the output image.

SOURCE

    set nargmin 2
    set nargmax 3
    set usage "?-lspecs LABEL_SPECS?  ?-lpos LABEL_POSITION?  ?-tile NXxNY?  ?-size SIZE?  ?-gap +X+Y?  ?-b BORDER_THICKNESS?  ?-bc BORDER_COLOR?  INPUT_IMAGES  OUTPUT_IMAGE"
    set options {
        {lspecs.arg {-font Arial -gravity center -pointsize 35} "specs for image labels, e.g., {-pointsize 35 -font Arial -gravity center -fill {#aa0000} -background {#ffffaa}}"}
        {lpos.arg   top    "position of labels (top | bottom)"}
        {tile.arg   {}     "number of tiles per row and column, i.e. NXxNY"}
        {size.arg   {}     "set size of constituent (source) images"}
        {gap.arg    +10+10 "separation between constituent images"}
        {b.arg      {}     "border thickness around each constituent image"}
        {bc.arg     black  "border color around each constituent image"}
    }
    ::pwtk::parseOpt_
    ::pwtk::checkOType_ -lpos $opt(lpos) {optionlist top bottom}

    lassign $args imageLabels output labelList
    
    set preOpts {}
    set opts    {}
    set size    {}
    
    ifnotempty opt(b) {
        set preOpts [list -bordercolor $opt(bc) -border $opt(b)]
    }
    ifnotempty opt(size) {
        set size    [list -size [lindex [split $opt(size) x] 0]]
        set preOpts [concat $preOpts -geometry $opt(size)]
        set opts    [concat $opts    -geometry $opt(size)]
    }
    ifnotempty opt(gap) {
        set opts [concat $opts -geometry $opt(gap)]
    }

    # count images & check for labels in imageLabels?
    set nimages 0
    set ilabels 0; # boolean for labels in imageLabels
    foreach it $imageLabels {
        incr nimages
        lappend images [lindex $imageLabels 0]
        if { [llength $it] > 1 } { set ilabels 1 }
    }

    # -tile
    ifempty opt(tile) {
        # nimages <= 4  ... 2x2
        # nimages <= 9  ... 3x3
        # nimages <= 16 ... 4x4
        # ...        
        set NX [expr int(sqrt($nimages))]
        if { sqrt($nimages) > $NX } {
            set NX [expr $NX + 1]
        }
        set opt(tile) ${NX}x${NX}
    }
    set opts [concat $opts -tile $opt(tile)]
               
    set convert  [getExecutable convert]
    set montage  [getExecutable montage]
    set identify [getExecutable identify] 

    # pre-processing of images
    
    if { $preOpts ne {} || $ilabels || $labelList ne {} } {
        ifempty convert {
            ::pwtk::warning "cannot preprocess images because ImageMagick 'convert' program is not available."
        } else {
            set imagesOrig $images
            set images     {}

            print imageTile "preprocessing images ...\n"
            
            if { ! $ilabels && $labelList eq {} } {
                # no labels, just border
                
                foreach image $imagesOrig {
                    set ext  [file extension $image]
                    set head [file rootname  $image]
                    lappend images ${head}_pp$ext
                    execute $convert {*}$preOpts $image ${head}_pp$ext
                }
            } else {
                # labels
                
                foreach it $imageLabels t $labelList {
                    incr i
                    lassign $it image label
                    ifnotempty t { set label $t}
                    ifset label { }
                    set ext  [file extension $image]
                    set head [file rootname  $image]
                    lappend images ${head}_pp${i}$ext

                    if { $size eq {} } {
                        # -size was not specified; try to get the image size from the image
                        ifnotempty identify {
                            set w [try_exec -i $identify -format %w $image]
                            ifnotempty w {
                                set size [list -size $w]
                            }
                        }
                    }
                    execute $convert {*}$opt(lspecs) {*}$size pango:$label label.png
                    
                    if { [regexp top $opt(lpos)] } {
                        execute $convert label.png $image -append {*}$preOpts ${head}_pp${i}$ext
                    } else {
                        execute $convert $image label.png -append {*}$preOpts ${head}_pp${i}$ext
                    }
                }
            }
        }
    }
    
    print imageTile "tiling images ...\n"
    
    ifempty montage {
        ::pwtk::warning "cannot montage images because ImageMagick 'montage' program is not available."
        return {}
    } else {
        execute $montage {*}$images {*}$opts $output
        print "Output image written to:  $output\n"
    }
    return $output
}

TABLE OF CONTENTS

::pwtk::imageTile