# Module:         poFti
# Copyright:      Paul Obermeier 2026 / obermeier@poSoft.de
# First Version:  2026 / 03 / 11
#
# Distributed under BSD license.
#
# Module for handling FTI (File Type Icon) vector files. 
# FTI files are used on Silicon Graphics IRIX systems to display
# scalable program icons.

namespace eval poFti {
    variable ns [namespace current]

    namespace ensemble create

    # Static procedures.
    namespace export GetColorNumFromRgb
    namespace export GetColorNumFromRgbString
    namespace export GetPointSize
    namespace export GetRgbFromColor
    namespace export GetRgbFromColorNum
    namespace export GetRgbFromFromRgbString
    namespace export GetRgbStringFromColor
    namespace export GetRgbStringFromRgb
    namespace export GetSpecialColorNum
    namespace export GetSpecialColors
    namespace export GetTypeNames
    namespace export IsSpecialColor

    # Classes.
    namespace export Item
    namespace export Icon

    variable _poFtiIntro {
        # poFti - FTI handling with Tcl

        `poFti` offers functionality to handle
        [File Type Icons (FTI)](https://techpubs.jurassic.nl/library/manuals/2000/007-2167-006/sgi_html/ch02.html)
        using the [Tcl](http://www.tcl-lang.org/) scripting language.

        For this purpose, `poFti` implements two
        [TclOO classes](https://www.tcl-lang.org/man/tcl/TclCmd/class.html) `Icon` and `Item`,
        as well as some static commands.

        File Type Icons can be read from file or string, written to file or created by 
        using a Tcl script (see demo `createSpiralColored.tcl`).

        An icon can be displayed in a Tk canvas (see script `ftiBatch.tcl`)
        and captured from the canvas into a Tk photo image or written to an image file.
        Additionally a square or isometric grid can be drawn into the canvas.

        Colors can be specified in three different ways:
        * Color number: Integer number in the range \[-255 .. 15\] or
                        special strings `iconcolor`, `shadowcolor` or `outlinecolor`.
        * RGB color: Integer values for the red, green and blue color components in the range \[0 .. 255\].
        * RGB color string: Hexadecimal string specified in format `#RRGGBB`.

        Important links:
        * [poFti homepage](https://www.tcl3d.org/poPkgs/poFti.html)
        * [BAWT homepage](https://www.tcl3d.org/bawt)
    }

    variable sPointSize   5
    variable sCurColorNum 0
    variable sLastColorNumWritten 1000
    variable sColorMap

    # Color mapping taken from svg2fti:
    # https://github.com/sgidevnet/svg2fti
    array set sColorMap { 
          15 {170 170 170}
          14 {56 142 142}
          13 {142 56 142}
          12 {113 113 198}
          11 {142 142 56}
          10 {113 198 113}
           9 {198 113 113}
           8 {85 85 85}
           7 {255 255 255}
           6 {0 255 255}
           5 {255 0 255}
           4 {0 0 255}
           3 {255 255 0}
           2 {0 255 0}
           1 {255 0 0}
           0 {0 0 0}
         -16 {127 0 0}
         -17 {255 0 0}
         -32 {0 127 0}
         -33 {127 127 0}
         -34 {0 255 0}
         -48 {127 127 0}
         -49 {255 127 0}
         -50 {127 255 0}
         -51 {255 255 0}
         -64 {0 0 127}
         -65 {127 0 127}
         -66 {0 127 127}
         -67 {127 127 127}
         -68 {0 0 255}
         -80 {127 0 127}
         -81 {255 0 127}
         -82 {127 127 127}
         -83 {255 127 127}
         -84 {127 0 255}
         -85 {255 0 255}
         -96 {0 127 127}
         -97 {127 127 127}
         -98 {0 255 127}
         -99 {127 255 127}
        -100 {0 127 255}
        -101 {127 127 255}
        -102 {0 255 255}
        -112 {127 127 127}
        -113 {255 127 127}
        -114 {127 255 127}
        -115 {255 255 127}
        -116 {127 127 255}
        -117 {255 127 255}
        -118 {127 255 255}
        -119 {255 255 255}
        -128 {42 42 42}
        -129 {170 42 42}
        -130 {42 170 42}
        -131 {170 170 42}
        -132 {42 42 170}
        -133 {170 42 170}
        -134 {42 170 170}
        -135 {170 170 170}
        -136 {85 85 85}
        -144 {99 56 56}
        -145 {226 56 56}
        -146 {99 184 56}
        -147 {226 184 56}
        -148 {99 56 184}
        -149 {226 56 184}
        -150 {99 184 184}
        -151 {226 184 184}
        -152 {141 99 99}
        -153 {198 113 113}
        -160 {56 99 56}
        -161 {184 99 56}
        -162 {56 226 56}
        -163 {184 226 56}
        -164 {56 99 184}
        -165 {184 99 184}
        -166 {56 226 184}
        -167 {184 226 184}
        -168 {99 141 99}
        -169 {155 155 113}
        -170 {113 198 113}
        -176 {71 71 28}
        -177 {198 71 28}
        -178 {71 198 28}
        -179 {198 198 28}
        -180 {71 71 155}
        -181 {198 71 155}
        -182 {71 198 155}
        -183 {198 198 155}
        -184 {113 113 70}
        -185 {170 127 84}
        -186 {127 170 84}
        -187 {142 142 56}
        -192 {56 56 99}
        -193 {184 56 99}
        -194 {56 184 99}
        -195 {184 184 99}
        -196 {56 56 226}
        -197 {184 56 226}
        -198 {56 184 226}
        -199 {184 184 226}
        -200 {99 99 141}
        -201 {155 113 155}
        -202 {113 155 155}
        -203 {127 127 127}
        -204 {113 113 198}
        -208 {71 28 71}
        -209 {198 28 71}
        -210 {71 155 71}
        -211 {198 155 71}
        -212 {71 28 198}
        -213 {198 28 198}
        -214 {71 155 198}
        -215 {198 155 198}
        -216 {113 70 113}
        -217 {170 84 127}
        -218 {127 127 127}
        -219 {142 99 99}
        -220 {127 84 170}
        -221 {142 56 142}
        -224 {28 71 71}
        -225 {155 71 71}
        -226 {28 198 71}
        -227 {155 198 71}
        -228 {28 71 198}
        -229 {155 71 198}
        -230 {28 198 198}
        -231 {155 198 198}
        -232 {70 113 113}
        -233 {127 127 127}
        -234 {84 170 127}
        -235 {99 142 99}
        -236 {84 127 170}
        -237 {99 99 142}
        -238 {56 142 142}
        -240 {85 85 85}
        -241 {212 85 85}
        -242 {85 212 85}
        -243 {212 212 85}
        -244 {85 85 212}
        -245 {212 85 212}
        -246 {85 212 212}
        -247 {212 212 212}
        -248 {127 127 127}
        -249 {184 141 141}
        -250 {141 184 141}
        -251 {156 156 113}
        -252 {141 141 184}
        -253 {156 113 156}
        -254 {113 156 156}
        -255 {170 170 170}
    }

    proc GetRgbStringFromColor { color } {
        # Get hexadecimal color string from color.
        #
        # color - Color number or special string.
        #
        # Convert a color number or special color into hexadecimal color string.
        #
        # Returns hexadecimal color string in format `#RRGGBB`.

        return [GetRgbStringFromRgb {*}[GetRgbFromColor $color]]
    }

    proc GetRgbStringFromRgb { r g b } {
        # Get hexadecimal color from RGB color values.
        #
        # r - Red color.
        # g - Green color.
        # b - Blue color.
        #
        # Color values are specified in the range \[0 .. 255\].
        #
        # Returns hexadecimal color string in format `#RRGGBB`.

        return [format "#%02x%02x%02x" $r $g $b]
    }

    proc GetRgbFromColorNum { colorNum } {
        # Get RGB color values from color number.
        #
        # colorNum - Color number.
        #
        # Convert a color number into RGB values.
        #
        # Returns list of \[R G B\] values.
        # If $colorNum is not a valid color number, \[0 0 0\] is returned.

        if { [info exist ::poFti::sColorMap($colorNum)  ] } {
            return $::poFti::sColorMap($colorNum)
        }
        return {0 0 0}
    }

    proc GetRgbFromColor { color } {
        # Get RGB color values from color.
        #
        # color - Color number or string.
        #
        # Convert a color number or special color into RGB values.
        #
        # Returns list of \[R G B\] values.

        if { $color eq "iconcolor" } {
            set colorNum 7  ; # White
        } elseif { $color eq "shadowcolor" } {
            set colorNum -67 ; # Grey
        } elseif { $color eq "outlinecolor" } {
            set colorNum 0  ; # Black
        } else {
            set colorNum $color
        }
        return [::poFti::GetRgbFromColorNum $colorNum]
    }

    proc GetRgbFromFromRgbString { rgbString } {
        # Get RGB color values from hexadecimal color value.
        #
        # rgbString - Color as hexadecimal string.
        #
        # Convert a hexadecimal color value into RGB values.
        #
        # Returns list of \[R G B\] values.

        if { 3 != [scan $rgbString "#%02x%02x%02x" r g b] } {
            error "Invalid color string \"$rgbString\" specified."
        }
        return [list $r $g $b]
    }

    proc GetColorNumFromRgb { r g b } {
        # Get color number from RGB color values.
        #
        # r - Red color.
        # g - Green color.
        # b - Blue color.
        #
        # Color values are specified in the range \[0 .. 255\]
        # and the best matching color number is choosen.
        #
        # Returns best matching color number.

        set average  500
        set colorNum 0

        foreach fti [array names ::poFti::sColorMap] {
            set rgb [::poFti::GetRgbFromColorNum $fti]
            set cur [expr {abs([lindex $rgb 0] - $r) + \
                           abs([lindex $rgb 1] - $g) + \
                           abs([lindex $rgb 2] - $b) }]
            if { $cur < $average } {
                set average  $cur
                set colorNum $fti
            }
        }
        return $colorNum
    }

    proc GetColorNumFromRgbString { rgbString } {
        # Get color number from hexadecimal color string.
        #
        # rgbString - Color as hexadecimal string.
        #
        # Color values are specified in format `#RRGGBB`
        # and the best matching color number is choosen.
        #
        # Returns best matching color number.

        set rgbList [::poFti::GetRgbFromFromRgbString $rgbString]
        return [::poFti::GetColorNumFromRgb {*}$rgbList]
    }

    proc GetPointSize {} {
        # Get the size of a point.
        #
        # Returns the size of an item of type `point` in pixels,
        # when drawn in a canvas.
        #
        # See also: Item::Draw Item::SetType

        return $::poFti::sPointSize
    }
    namespace export GetPointSize

    proc GetTypeNames {} {
        # Get the names of valid item types.
        #
        # Returns a list of valid item type names.
        #
        # See also: Item::GetType Item::SetType

        return [list "closedline" "line" "polygon" "outlinepolygon" "point"]
    }
    namespace export GetTypeNames

    proc GetSpecialColors {} {
        # Get the names and color numbers of special colors.
        #
        # Returns a list of the names and color numbers of
        # FTI specific color names.
        #
        # See also: IsSpecialColor GetSpecialColorNum Item::GetColor

        return [list "iconcolor" 7 "shadowcolor" -67 "outlinecolor" 0]
    }
    namespace export GetSpecialColors

    proc IsSpecialColor { color } {
        # Check, if supplied color is a special color.
        #
        # color - Color number or string.
        #
        # Returns true, if $color is a special color name,
        # otherwise false.
        #
        # See also: GetSpecialColors GetSpecialColorNum Item::GetColor

        foreach { name value } [GetSpecialColors] {
            if { $color eq $name } {
                return true
            }
        }
        return false
    }
    namespace export IsSpecialColor

    proc GetSpecialColorNum { color } {
        # Get color number of special color.
        #
        # color - Special color name.
        #
        # Returns numeric color number of $color.
        #
        # If $color is not a valid special color name,
        # an error is thrown.
        #
        # See also: GetSpecialColors IsSpecialColor Item::GetColor

        foreach { name value } [GetSpecialColors] {
            if { $color eq $name } {
                return $value
            }
        }
        error "Invalid color \"$color\" specified."
    }
    namespace export GetSpecialColorNum

    proc DrawGrid { canvasId args } {
        # Draw a grid into the Tk canvas.
        #
        # canvasId - Identifier of the canvas.
        # args     - Options described below. 
        #
        # -width <int>    - Width of the drawn grid in pixel.
        # -height <int>   - Height of the drawn grid in pixel.
        # -color <string> - Tk color specification. Default: `grey`.
        # -type <string>  - Grid type: `none`, `square` or `isometric`.
        #                   Default: `isometric`.
        #
        # If `-width` or `-height` is not specified, the
        # width or height of the canvas is used.
        #
        # The grid canvas items are assigned tag `FtiGrid`.
        #
        # See also: Icon::Draw

        set opts [dict create \
            -width  0 \
            -height 0 \
            -color  "grey" \
            -type   "square" \
        ]
        foreach { key value } $args {
            if { [dict exists $opts $key] } {
                if { $value eq "" } {
                    error "DrawGrid: No value specified for key \"$key\"."
                }
                dict set opts $key $value
            } else {
                error "DrawGrid: Unknown option \"$key\" specified."
            }
        }

        set width  [dict get $opts "-width"]
        set height [dict get $opts "-height"]
        if { $width <= 0 } {
            set width [$canvasId cget -width]
        }
        if { $height <= 0 } {
            set height [$canvasId cget -height]
        }
        set color [dict get $opts "-color"]
        set type  [dict get $opts "-type"]

        $canvasId delete "FtiGrid"
        if { $type eq "none" } {
            return
        }

        # IconSmith seems to use a 2:1 pixel pattern ratio.
        # See https://en.wikipedia.org/wiki/Isometric_video_game_graphics
        # chapter "Differences from true isometric projection".
        set angle [expr { atan (1.0 / 2.0) }]
        set xstep [expr {$width  / 20 }]
        set ystep [expr {$height / 20 }]
        for { set y $height } { $y >= 0 } { incr y -$ystep } {
            for { set x 0 } { $x <= $width } { incr x $xstep } {
                set xi $x
                if { $type eq "isometric" && $x % 2 } {
                    set yi [expr { int ($y + atan($angle) * $ystep) }] 
                } else {
                    set yi $y
                }
                set x1 [expr { $xi - 3}]
                set y1 [expr { $yi - 3}]
                set x2 [expr { $xi + 3}]
                set y2 [expr { $yi + 3}]
                $canvasId create line $x1 $yi $x2 $yi -fill $color -tags [list "FtiGrid"]
                $canvasId create line $xi $y1 $xi $y2 -fill $color -tags [list "FtiGrid"]
            }
        }
    }
    namespace export DrawGrid

    proc _Rotate { px py angleRad { cx 0.0 } { cy 0.0 } } {
        # Rotate point (px, py) counterclockwise around center (cx, cy).
    
        # Translate point to origin.
        set xTmp [expr {$px - $cx}]
        set yTmp [expr {$py - $cy}]
    
        # Rotate point.
        set sinTmp [expr {sin($angleRad)}]
        set cosTmp [expr {cos($angleRad)}]
        set xNew [expr {$xTmp * $cosTmp - $yTmp * $sinTmp}]
        set yNew [expr {$xTmp * $sinTmp + $yTmp * $cosTmp}]
    
        # Translate back.
        return [list [expr {$xNew + $cx}] [expr {$yNew + $cy}]]
    }

    proc _Scale { px py sx sy { cx 0.0 } { cy 0.0 } } {
        # Scale point (px, py) around center (cx, cy).
    
        # Translate point to origin.
        set xTmp [expr {$px - $cx}]
        set yTmp [expr {$py - $cy}]
    
        # Scale point.
        set xNew [expr {$xTmp * $sx}]
        set yNew [expr {$yTmp * $sy}]
    
        # Translate back.
        return [list [expr {$xNew + $cx}] [expr {$yNew + $cy}]]
    }

    oo::class create Item {
        variable sName
        variable sType
        variable sColorNum
        variable sOutlineColorNum
        variable sCoordList

        constructor { name { type "line" } } {
            # Create an item object.
            #
            # name - Item name.
            # type - Item type.
            #
            # See also: SetName SetType

            if { $type ni [poFti::GetTypeNames] } {
                error "Invalid type \"$type\" specified."
            }
            set sName            $name
            set sType            $type
            set sColorNum        $::poFti::sCurColorNum
            set sOutlineColorNum $::poFti::sCurColorNum
            set sCoordList       [list]
        }

        destructor {
            unset sName
            unset sType
            unset sColorNum
            unset sOutlineColorNum
            unset sCoordList
        }

        method AddVertex { x y } {
            # Add a vertex to the item object.
            #
            # x - X coordinate of the vertex.
            # y - Y coordinate of the vertex.
            #
            # See also: AddVertices GetNumVertices

            lappend sCoordList $x $y
        }
        export AddVertex

        method AddVertices { args } {
            # Add vertices to the item object.
            #
            # args - List of x, y coordinates.
            #
            # If the number of coordinates is not a multiple
            # of two, an error is thrown.
            #
            # See also: AddVertex GetNumVertices

            if { [llength $args] % 2 != 0 } {
                error "Invalid number of coordinates."
            }

            foreach vtx $args {
                lappend sCoordList $vtx
            }
        }
        export AddVertices

        method GetVertex { vertexInd } {
            # Get the coordinates of a vertex.
            #
            # vertexInd - Vertex index.
            #
            # Returns the coordinates of vertex stored at index $vertexInd 
            # as a list with two components.
            # If $vertexInd is out of bounds or the item has no vertices,
            # an error is thrown.
            #
            # See also: AddVertex GetVertices GetNumVertices

            if { [llength $sCoordList] == 0 } {
                error "Item \"[my GetName]\" has no vertices."
            }
            if { $vertexInd < 0 || $vertexInd >= [llength $sCoordList] } {
                error "Vertex index $vertexInd not in range \[0 ..[llength $sCoordList]\]."
            }
            return [lrange $sCoordList $vertexInd [expr { $vertexInd + 1 }]]
        }
        export GetVertex

        method GetVertices {} {
            # Get the coordinates of all vertices.
            #
            # Returns the coordinates of all vertices of the item
            # as a list.
            #
            # See also: AddVertex GetVertex GetNumVertices

            return $sCoordList
        }
        export GetVertices

        method GetNumVertices {} {
            # Get the number of vertices of the item.
            #
            # Returns the number of vertices.
            #
            # See also: AddVertex AddVertices

            return [expr {[llength $sCoordList] / 2 }]
        }
        export GetNumVertices

        method SetColor { color } {
            # Set the color of the item.
            #
            # color - Color number in the range \[-255 .. 15\] or
            #         special strings `iconcolor`, `shadowcolor` or `outlinecolor`.
            #
            # If $color is not a valid special color name or valid color number,
            # an error is thrown.
            #
            # See also: GetColor SetColorRgb SetOutlineColor SetOutlineColorRgb

            if { ! [::poFti::IsSpecialColor $color] && \
                 ! [info exist ::poFti::sColorMap($color)] } {
                error "Invalid color \"$color\" specified."
            }
            set sColorNum $color
            set ::poFti::sCurColorNum $color
        }
        export SetColor

        method SetColorRgb { r g b } {
            # Set the color of the item.
            #
            # r - Red color.
            # g - Green color.
            # b - Blue color.
            #
            # Color values are specified in the range \[0 .. 255\]
            # and the best matching color number is choosen.
            #
            # See also: GetColor SetColor SetOutlineColor SetOutlineColorRgb GetOutlineColor

            set colorNum [::poFti::GetColorNumFromRgb $r $g $b]
            my SetColor $colorNum
        }
        export SetColorRgb

        method SetColorRgbString { rgbString } {
            # Set the color of the item.
            #
            # rgbString - Color as hexadecimal string.
            #
            # Color values are specified in format `#RRGGBB`
            # and the best matching color number is choosen.
            #
            # See also: GetColor SetColor SetOutlineColor SetOutlineColorRgb GetOutlineColor

            set colorNum [::poFti::GetColorNumFromRgbString $rgbString]
            my SetColor $colorNum
        }
        export SetColorRgbString
 
        method GetColor {} {
            # Get the color of the item.
            #
            # Returns the color number or special color of the item.
            #
            # See also: SetColor SetColorRgb SetOutlineColor SetOutlineColorRgb GetOutlineColor

            return $sColorNum
        }
        export GetColor

        method SetOutlineColor { color } {
            # Set the outline color of the item.
            #
            # color - Color number in the range \[-255 .. 15\] or
            #         special strings `iconcolor`, `shadowcolor` or `outlinecolor`.
            #
            # If $color is not a valid special color name or valid color number,
            # an error is thrown.
            #
            # See also: GetColor SetColor SetColorRgb SetOutlineColorRgb GetOutlineColor

            if { ! [::poFti::IsSpecialColor $color] && \
                 ! [info exist ::poFti::sColorMap($color)] } {
                error "Invalid color \"$color\" specified."
            }

            set sOutlineColorNum $color
        }
        export SetOutlineColor

        method SetOutlineColorRgb { r g b } {
            # Set the outline color of the item.
            #
            # r - Red color.
            # g - Green color.
            # b - Blue color.
            #
            # Color values are specified in the range \[0 .. 255\]
            # and the best matching color number is choosen.
            #
            # See also: GetColor SetColor SetColorRgb SetOutlineColor GetOutlineColor

            set colorNum [::poFti::GetColorNumFromRgb $r $g $b]
            my SetOutlineColor $colorNum
        }
        export SetOutlineColorRgb

        method SetOutlineColorRgbString { rgbString } {
            # Set the outline color of the item.
            #
            # rgbString - Color as hexadecimal string.
            #
            # Color values are specified in format `#RRGGBB`
            # and the best matching color number is choosen.
            #
            # See also: GetColor SetColor SetOutlineColor SetOutlineColorRgb GetOutlineColor

            set colorNum [::poFti::GetColorNumFromRgbString $rgbString]
            my SetOutlineColor $colorNum
        }
        export SetOutlineColorRgbString

        method GetOutlineColor {} {
            # Get the outline color of the item.
            #
            # Returns the outline color of the item.
            #
            # See also: SetColor SetColorRgb SetOutlineColor SetOutlineColorRgb

            return $sOutlineColorNum
        }
        export GetOutlineColor

        method SetName { name } {
            # Set the name of the item.
            #
            # name - Item name.
            #
            # See also: GetName constructor

            set sName $name
        }
        export SetName

        method GetName {} {
            # Get the name of the item.
            #
            # Returns the item name.
            #
            # See also: SetName

            return $sName
        }
        export GetName

        method SetType { type } {
            # Set the type of the item.
            #
            # type - Item type name.
            #
            # If $type is not a valid type name,
            # an error is thrown.
            #
            # See also: ::poFti::GetTypeNames GetType constructor

            if { $type ni [poFti::GetTypeNames] } {
                error "Invalid type \"$type\" specified."
            }
            set sType $type
        }
        export SetType

        method GetType {} {
            # Get the type of the item.
            #
            # Returns the item type name.
            #
            # See also: ::poFti::GetTypeNames SetType

            return $sType
        }
        export GetType

        method Write { fp } {
            # Write the item to file.
            #
            # fp - File pointer.
            #
            # This method is typically only used by the `Write`
            # method of class `Icon`.
            #
            # See also: Icon::Write

            puts $fp "#\t$sName"
            if { $sColorNum != $::poFti::sLastColorNumWritten } {
                puts $fp "\t\tcolor($sColorNum);"
                set ::poFti::sLastColorNumWritten $sColorNum
            }
            if { $sType eq "line" } {
                puts $fp "\t\tbgnline();"
            } elseif { $sType eq "closedline" } {
                puts $fp "\t\tbgnclosedline();"
            } elseif { $sType eq "polygon" } {
                puts $fp "\t\tbgnpolygon();"
            } elseif { $sType eq "outlinepolygon" } {
                puts $fp "\t\tbgnoutlinepolygon();"
            } elseif { $sType eq "point" } {
                puts $fp "\t\tbgpoint();"
            }
            foreach { x y } $sCoordList {
                puts $fp [format "\t\t\tvertex(%.2f, %.2f);" $x $y]
            }
            if { $sType eq "line" } {
                puts $fp "\t\tendline();"
            } elseif { $sType eq "closedline" } {
                puts $fp "\t\tendclosedline();"
            } elseif { $sType eq "polygon" } {
                puts $fp "\t\tendpolygon();"
            } elseif { $sType eq "outlinepolygon" } {
                puts $fp "\t\tendoutlinepolygon($sOutlineColorNum);"
            } elseif { $sType eq "point" } {
                puts $fp "\t\tendpoint();"
            }
            puts $fp ""
        }
        export Write

        method Draw { canvasId width height tag } {
            # Draw the item into a Tk canvas.
            #
            # canvasId - Identifier of the canvas.
            # width    - Width of the drawn icon in pixel.
            # height   - Height of the drawn icon in pixel.
            # tag      - Canvas tag name assigned to the item.
            #
            # This method is typically only used by the `Draw`
            # method of class `Icon`.
            #
            # Returns the canvas item id.
            #
            # See also: Icon::Draw

            if { [llength $sCoordList] == 0 } {
                error "Item has no vertices."
            }
            set fillColor [poFti GetRgbStringFromColor $sColorNum]
            set coords [list]
            foreach { x y } $sCoordList {
                set cx [expr { $x * 0.01 * $width }]
                set cy [expr { $height - ($y * 0.01 * $height) }]
                lappend coords $cx $cy
            }
            if { $sType eq "closedline" } {
                set cx [lindex $coords 0]
                set cy [lindex $coords 1]
                lappend coords $cx $cy
            }
            if { $sType eq "line" } {
                set itemId [$canvasId create line $coords \
                           -fill $fillColor -width $::poFti::sPointSize \
                           -tags [list "FtiIcon" "$tag" "[my GetName]" "line" $sColorNum]]
            } elseif { $sType eq "closedline" } {
                set itemId [$canvasId create line $coords \
                           -fill $fillColor -width $::poFti::sPointSize \
                           -tags [list "FtiIcon" "$tag" "[my GetName]" "closedline" $sColorNum]]
            } elseif { $sType eq "polygon" } {
                set itemId [$canvasId create polygon $coords \
                           -fill $fillColor -outline $fillColor \
                           -tags [list "FtiIcon" "$tag" "[my GetName]" "polygon" $sColorNum]]
            } elseif { $sType eq "outlinepolygon" } {
                set outlineColor [::poFti::GetRgbStringFromRgb {*}[::poFti::GetRgbFromColor $sOutlineColorNum]]
                set itemId [$canvasId create polygon $coords \
                           -fill $fillColor -outline $outlineColor -width $::poFti::sPointSize \
                           -tags [list "FtiIcon" "$tag" "[my GetName]"  "outlinepolygon" $sColorNum $sOutlineColorNum]]
            } elseif { $sType eq "point" } {
                lassign $coords x y
                set psHalf [expr {$::poFti::sPointSize / 2 }]
                set x1 [expr { $x - $psHalf }]
                set y1 [expr { $y - $psHalf }]
                set x2 [expr { $x + $psHalf }]
                set y2 [expr { $y + $psHalf }]
                set itemId [$canvasId create rect $x1 $y1 $x2 $y2 \
                           -fill $fillColor -outline $fillColor \
                           -tags [list "FtiIcon" "$tag" "[my GetName]" "point" $sColorNum]]
            }
            return $itemId
        }
        export Draw

        method Flip { direction } {
            # Flip the item vertically or horizontally.
            #
            # direction - Flip direction as string.
            #             Possible values: `hori`or `vert`. 
            #
            # This method is typically only used by the `Flip`
            # method of class `Icon`.
            #
            # See also: Icon::Flip

            set coords [list]
            foreach { x y } $sCoordList {
                set fx $x
                if { $direction eq "hori" } {
                    set fx [expr { 100 - $x }]
                }
                set fy $y
                if { $direction eq "vert" } {
                    set fy [expr { 100 - $y }]
                }
                lappend coords $fx $fy
            }
            set sCoordList $coords
        }
        export Flip

        method Rotate { angleDeg { cx 0.0 } { cy 0.0 } } {
            # Rotate the item around specified center.
            #
            # angleDeg - Rotation angle in degrees. 
            #            Rotation occurs counterclockwise.
            # cx       - X coordinate of rotation center.
            # cy       - Y coordinate of rotation center.
            #
            # This method is typically only used by the `Rotate`
            # method of class `Icon`.
            #
            # See also: Icon::Rotate

            set angleRad [expr {$angleDeg * 3.14159265358979323846 / 180.0}]
            set coords [list]
            foreach { x y } $sCoordList {
                set rotPoint [::poFti::_Rotate $x $y $angleRad $cx $cy]
                lappend coords [lindex $rotPoint 0] [lindex $rotPoint 1]
            }
            set sCoordList $coords
        }
        export Rotate

        method Scale { sx sy { cx 0.0 } { cy 0.0 } } {
            # Scale the item using specified center.
            #
            # sx - X scale factor.
            # sy - Y scale factor.
            # cx - X coordinate of scale center.
            # cy - Y coordinate of scale center.
            #
            # This method is typically only used by the `Scale`
            # method of class `Icon`.
            #
            # See also: Icon::Scale

            set coords [list]
            foreach { x y } $sCoordList {
                set sclPoint [::poFti::_Scale $x $y $sx $sy $cx $cy]
                lappend coords [lindex $sclPoint 0] [lindex $sclPoint 1]
            }
            set sCoordList $coords
        }
        export Scale
    }

    oo::class create Icon {
        variable sName
        variable sItemList

        constructor {} {
            set sName "Unnamed"
            set sItemList [list]
        }

        destructor {
        }

        method SetName { name } {
            # Set the name of the icon.
            #
            # name - Icon name.
            #
            # See also: GetName constructor Read

            set sName $name
        }
        export SetName

        method GetName {} {
            # Get the name of the icon.
            #
            # Returns the icon name.
            #
            # See also: SetName Read

            return $sName
        }
        export GetName

        method AddItem { itemObj } {
            # Add an item to the icon.
            #
            # itemObj - Object identifier of the item.
            #
            # See also: GetItem GetNumItems

            lappend sItemList $itemObj
        }
        export AddItem

        method GetItem { itemInd } {
            # Get an item of the icon.
            #
            # itemInd - Item index.
            #
            # Returns the item object stored at index $itemInd.
            # If $itemInd is out of bounds or the icon has no items,
            # an error is thrown.
            #
            # See also: AddItem GetNumItems

            if { [llength $sItemList] == 0 } {
                error "Icon \"[my GetName]\" has no items."
            }
            if { $itemInd < 0 || $itemInd >= [llength $sItemList] } {
                error "Item index $itemInd not in range \[0 ..[llength $sItemList]\]."
            }
            return [lindex $sItemList $itemInd]
        }
        export GetItem

        method GetNumItems { { type "" } } {
            # Get the number of items of the icon.
            #
            # type - Item type.
            #
            # If $type is specified and a valid item type,
            # only items of the specified type are counted.
            # Otherwise the number of all items are counted.
            #
            # Returns the number of items of the icon.
            #
            # See also: AddItem ::poFti::GetTypeNames

            if { $type eq "" } {
                return [llength $sItemList]
            } else {
                set count 0
                foreach item $sItemList {
                    if { [$item GetType] eq $type } {
                        incr count
                    }
                }
                return $count
            }
        }
        export GetNumItems

        method ReadFromString { iconString { iconName "" } } {
            # Read icon data from string.
            #
            # iconString - String containing the icon data.
            # iconName   - Icon name.
            #
            # Returns the object identifier of the new Icon.
            # If the string has invalid content, an error is thrown.
            #
            # See also: Read Write Draw AsPhoto WriteToImageFile

            foreach line [split $iconString "\n"] {
                if { [string trim $line] eq "" } {
                    continue
                }
                if { [string index $line 0] eq "#" } {
                    set itemName [string trim [string range $line 1 end]]
                    set newItem [poFti Item new $itemName]
                } else {
                    set cmdLine [string trim $line]
                    if { [string first "(" $cmdLine] < 0 } {
                        error "Unsupported command \"$cmdLine\"."
                    }
                    set cmdList [split $cmdLine "("]
                    set cmdName [lindex $cmdList 0]
                    set cmdParam [lindex $cmdList 1]
                    set cmdParam [string trimright $cmdParam ");"]
                    set params [list]
                    if { $cmdParam ne "" } {
                        foreach param [split $cmdParam ","] {
                            lappend params [string trim $param]
                        }
                    }
                    switch -exact -- $cmdName {
                        "bgnclosedline" {
                            $newItem SetType "closedline"
                        }
                        "bgnline" {
                            $newItem SetType "line"
                        }
                        "bgnoutlinepolygon" {
                            $newItem SetType "outlinepolygon"
                        }
                        "bgnpoint" {
                            $newItem SetType "point"
                        }
                        "bgnpolygon" {
                            $newItem SetType "polygon"
                        }
                        "color" {
                            $newItem SetColor $cmdParam
                        }
                        "endclosedline" {
                            my AddItem $newItem
                        }
                        "endline" {
                            my AddItem $newItem
                        }
                        "endoutlinepolygon" {
                            $newItem SetOutlineColor $cmdParam
                            my AddItem $newItem
                        }
                        "endpoint" {
                            my AddItem $newItem
                        }
                        "endpolygon" {
                            my AddItem $newItem
                        }
                        "vertex" {
                            $newItem AddVertex [lindex $params 0] [lindex $params 1]
                        }
                        default {
                            error "Unsupported command \"$cmdName\"."
                        }
                    }
                }
            }
            my SetName $iconName

            # Consistency checks.
            if { [my GetNumItems] == 0 } {
                error "Icon \"[my GetName]\" has no items."
            }
            foreach itemObj $sItemList {
                set itemType [$itemObj GetType]
                switch -exact -- $itemType {
                    "point" {
                        set numVtx 1
                    }
                    "line" {
                        set numVtx 2
                    }
                    "closedline" -
                    "polygon" -
                    "outlinepolygon" {
                        set numVtx 3
                    }
                    default {
                        error "Item \"[$itemObj GetName]\" has invalid type \"itemType\"."
                   }
                }
                if { [$itemObj GetNumVertices] < $numVtx } {
                    error "Item \"[$itemObj GetName]\" has invalid number of vertices ([$itemObj GetNumVertices])."
                }
            }
        }
        export ReadFromString

        method Read { fileName } {
            # Read an icon file.
            #
            # fileName - Name of the FTI file.
            #
            # Returns the object identifier of the new Icon.
            # If the file could not be openend or has invalid
            # content, an error is thrown.
            #
            # See also: ReadFromString Write Draw AsPhoto WriteToImageFile

            set retVal [catch {open $fileName "r"} fp]
            if { $retVal != 0 } {
                error "Could not open file \"$fileName\" for reading."
            }
            set fp [open $fileName "r"]
            set iconData [read $fp]
            close $fp
            
            return [my ReadFromString $iconData [file rootname [file tail $fileName]]]
        }
        export Read

        method Write { fileName } {
            # Write a icon file.
            #
            # fileName - Name of the FTI file.
            #
            # If the file could not be openend,
            # an error is thrown.
            #
            # See also: Read Draw AsPhoto WriteToImageFile

            set retVal [catch {open $fileName "w"} fp]
            if { $retVal != 0 } {
                error "Could not open file \"$fileName\" for writing."
            }
            fconfigure $fp -translation lf
            set ::poFti::sLastColorNumWritten 1000
            foreach itemObj $sItemList {
                $itemObj Write $fp
            }
            close $fp
        }
        export Write

        method Draw { canvasId args } {
            # Draw the icon into a Tk canvas.
            #
            # canvasId - Identifier of the canvas.
            # args     - Options described below. 
            #
            # -width <int>  - Width of the drawn icon in pixel.
            # -height <int> - Height of the drawn icon in pixel.
            # -tag <string> - Assign canvas tag name to all items. 
            #                 Default: "FtiIcon".
            #
            # Each item of the icon is assigned 4 canvas tags:
            # 1. Fixed value: `FtiIcon`.
            # 2. Tag supplied with option `-tag`. 
            # 3. Item name.
            # 4. Item type.
            #
            # If `-width` or `-height` is not specified, the
            # width or height of the canvas is used.
            #
            # See also: Read Write AsPhoto WriteToImageFile ::poFti::DrawGrid ::poFti::GetTypeNames

            set opts [dict create \
                -width  0 \
                -height 0 \
                -tag    "FtiIcon"
            ]
            foreach { key value } $args {
                if { [dict exists $opts $key] } {
                    if { $value eq "" } {
                        error "Draw: No value specified for key \"$key\"."
                    }
                    dict set opts $key $value
                } else {
                    error "Draw: Unknown option \"$key\" specified."
                }
            }

            set width  [dict get $opts "-width"]
            set height [dict get $opts "-height"]
            if { $width <= 0 } {
                set width [$canvasId cget -width]
            }
            if { $height <= 0 } {
                set height [$canvasId cget -height]
            }
            foreach itemObj $sItemList {
                $itemObj Draw $canvasId $width $height [dict get $opts "-tag"]
            }
            update
        }
        export Draw

        method Flip { direction } {
            # Flip the icon vertically or horizontally.
            #
            # direction - Flip direction as string.
            #             Possible values: `hori`or `vert`. 
            #
            # If $direction is an invalid string, an error is thrown.
            #
            # See also: Read Write Draw Rotate Scale

            if { $direction ne "hori" && $direction ne "vert" } {
                error "Invalid flip direction \"$direction\" specified."
            }
            foreach itemObj $sItemList {
                $itemObj Flip $direction
            }
        }
        export Flip

        method Rotate { angleDeg { cx 0.0 } { cy 0.0 } } {
            # Rotate the icon around specified center.
            #
            # angleDeg - Rotation angle in degrees. 
            #            Rotation occurs counterclockwise.
            # cx       - X coordinate of rotation center.
            # cy       - Y coordinate of rotation center.
            #
            # See also: Read Write Draw Flip Scale

            foreach itemObj $sItemList {
                $itemObj Rotate $angleDeg $cx $cy
            }
        }
        export Rotate

        method Scale { sx sy { cx 0.0 } { cy 0.0 } } {
            # Scale the icon using specified center.
            #
            # sx - X scale factor.
            # sy - Y scale factor.
            # cx - X coordinate of scale center.
            # cy - Y coordinate of scale center.
            #
            # See also: Read Write Draw Flip Rotate

            foreach itemObj $sItemList {
                $itemObj Scale $sx $sy $cx $cy
            }
        }
        export Scale

        method AsPhoto { canvasId } {
            # Get the icon displayed in the Tk canvas as a photo image.
            #
            # canvasId - Identifier of the canvas.
            #
            # Returns the photo image.
            # The photo image must be deleted by the caller.
            #
            # If the `Img` extension is not available, an error is thrown.
            #
            # See also: Read Write Draw WriteToImageFile

            set retVal [catch {package require Img} version]
            if { $retVal != 0 } {
                error "Method AsPhoto needs the Img extension."
            }
            set region [$canvasId cget -scrollregion]
            if { [llength $region] == 0 } {
                set xsize [$canvasId cget -width]
                set ysize [$canvasId cget -height]
            } else {
                set xsize [lindex $region 2]
                set ysize [lindex $region 3]
            }
            set img [image create photo -width $xsize -height $ysize]

            $canvasId xview moveto 0
            $canvasId yview moveto 0
            update idletasks
            set xr 0.0
            set yr 0.0
            set px 0
            set py 0
            while { $xr < 1.0 } {
                while { $yr < 1.0 } {
                    set tmpImg [image create photo -format window -data $canvasId]
                    $img copy $tmpImg -to $px $py
                    image delete $tmpImg
                    set yr [lindex [$canvasId yview] 1]
                    $canvasId yview moveto $yr
                    set py [expr round ($ysize * [lindex [$canvasId yview] 0])]
                    update idletasks
                }
                $canvasId yview moveto 0
                set yr 0.0
                set py 0

                set xr [lindex [$canvasId xview] 1]
                $canvasId xview moveto $xr
                set px [expr round ($xsize * [lindex [$canvasId xview] 0])]
                update idletasks
            }
            return $img
        }
        export AsPhoto

        method WriteToImageFile { canvasId fileName { format "PNG" } } {
            # Write the icon displayed in the Tk canvas to an image file.
            #
            # canvasId - Identifier of the canvas.
            # fileName - Name of the image file.
            # format   - Output format of the image file.
            #
            # Valid format strings are: `BMP GIF JPEG PCX PNG PPM SGI SUN TGA TIFF XPM`
            #
            # If the `Img` extension is not available, an error is thrown.
            #
            # See also: Read Write Draw AsPhoto

            set retVal [catch {package require Img} version]
            if { $retVal != 0 } {
                error "Method WriteToImageFile needs the Img extension."
            }
            set phImg [my AsPhoto $canvasId]
            $phImg write $fileName -format $format
            image delete $phImg
        }
        export WriteToImageFile
    }
}
