::CawtTop, Main, Index

proc ::Cawt::CentiMetersToPoints {cm} {

    # Convert centimeter value into points.
    #
    # cm - Floating point centimeter value to be converted to points.
    #
    # Returns the corresponding value in points.
    #
    # See also: SetDotsPerInch InchesToPoints PointsToCentiMeters

    variable dotsPerInch

    return [expr {$cm / 2.54 * double($dotsPerInch)}]
}

proc ::Cawt::CheckBoolean {expected value msg {printCheck true}} {

    # Check, if two boolean values are identical.
    #
    # expected   - Expected boolean value.
    # value      - Test boolean value.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both boolean values are identical.
    # If $printCheck is set to true, a line prepended with `"Check:`" and the
    # message supplied in $msg is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:`".
    #
    # See also: CheckComObjects CheckNumber CheckList CheckMatrix CheckString

    if { [expr bool($expected)] != [expr bool($value)] } {
        puts "Error: $msg (Expected: $expected Have: $value)"
        return false
    }
    if { $printCheck } {
        puts "Check: $msg (Expected: $expected Have: $value)"
    }
    return true
}

proc ::Cawt::CheckComObjects {expected msg {printCheck true}} {

    # Check, if the number of COM objects fits expected value.
    #
    # expected   - Expected number of COM objects.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if the number of COM objects fits expected value.
    # If $printCheck is set to true, a line prepended with `"Check:"` and the
    # message supplied in $msg is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckList CheckMatrix CheckBoolean CheckNumber CheckString GetNumComObjects

    set value [Cawt::GetNumComObjects]
    if { $expected != $value } {
        puts "Error: $msg (Expected: $expected Have: $value)"
        return false
    }
    if { $printCheck } {
        puts "Check: $msg (Expected: $expected Have: $value)"
    }
    return true
}

proc ::Cawt::CheckFile {fileName1 fileName2 msg {printCheck true}} {

    # Check, if two files are identical.
    #
    # fileName1  - First file name.
    # fileName2  - Second file name.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both files are identical.
    # If "printCheck" is set to true, a line prepended with `"Check:"` and the
    # message supplied in "msg" is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckComObjects CheckList CheckMatrix CheckBoolean CheckNumber

    if { ! [file isfile $fileName1] } {
        puts "Error: $msg (File not existent: \"$fileName1\")"
        return false
    }
    if { ! [file isfile $fileName2] } {
        puts "Error: $msg (File not existent: \"$fileName2\")"
        return false
    }

    if { [file size $fileName1] != [file size $fileName2] } {
        puts "Error: $msg (Expected size: [file size $fileName1] Have: [file size $fileName2])"
        return false
    }

    set fp1 [open $fileName1 "r"]
    set fp2 [open $fileName2 "r"]

    fconfigure $fp1 -translation binary
    fconfigure $fp2 -translation binary

    set retVal  0
    set bufSize 2048

    set str1 [read $fp1 $bufSize]
    while { 1 } {
        set str2 [read $fp2 $bufSize]
        if { $str1 ne $str2 } {
            # Files differ
            set retVal 0
            break
        }
        set str1 [read $fp1 $bufSize]
        if { $str1 eq "" } {
            # Files are identical
            set retVal 1
            break
        }
    }
    close $fp1
    close $fp2

    if { $retVal == 0 } {
        puts "Error: $msg (Files differ: \"[file tail $fileName1]\" \"[file tail $fileName2]\")"
        return false
    } else {
        if { $printCheck } {
            puts "Check: $msg (Files are identical: \"[file tail $fileName1]\" \"[file tail $fileName2]\")"
        }
    }
    return true
}

proc ::Cawt::CheckList {expected value msg {printCheck true}} {

    # Check, if two lists are identical.
    #
    # expected   - Expected list.
    # value      - Test list.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both lists are identical.
    # If $printCheck is set to true, a line prepended with `"Check:"` and the
    # message supplied in $msg is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckComObjects CheckMatrix CheckBoolean CheckNumber CheckString

    if { [llength $expected] != [llength $value] } {
        puts "Error: $msg (List length differ. Expected: [llength $expected] Have: [llength $value])"
        return false
    }
    set index 0
    foreach exp $expected val $value {
        if { $exp != $val } {
            puts "Error: $msg (Values differ at index $index. Expected: $exp Have: $val)"
            return false
        }
        incr index
    }
    if { $printCheck } {
        if { [llength $value] <= 4 } {
            puts "Check: $msg (Expected: $expected Have: $value)"
        } else {
            puts "Check: $msg (Lists are identical. List length: [llength $value])"
        }
    }
    return true
}

proc ::Cawt::CheckMatrix {expected value msg {printCheck true}} {

    # Check, if two matrices are identical.
    #
    # expected   - Expected matrix.
    # value      - Test matrix.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both matrices are identical.
    # If $printCheck is set to true, a line prepended with `"Check:"` and the
    # message supplied in $msg is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckComObjects CheckList CheckBoolean CheckNumber CheckString

    if { [llength $expected] != [llength $value] } {
        puts "Error: $msg (Matrix rows differ. Expected: [llength $expected] Have: [llength $value])"
        return false
    }
    set row 0
    foreach expRow $expected valRow $value {
        set col 0
        foreach exp $expRow val $valRow {
            if { $exp != $val } {
                puts "Error: $msg (Values differ at row/col $row/$col. Expected: $exp Have: $val)"
                return false
            }
            incr col
        }
        incr row
    }
    if { $printCheck } {
        puts "Check: $msg (Matrices are identical. Matrix rows: [llength $value])"
    }
    return true
}

proc ::Cawt::CheckNumber {expected value msg {printCheck true}} {

    # Check, if two numerical values are identical.
    #
    # expected   - Expected numeric value.
    # value      - Test numeric value.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both numeric values are identical.
    # If $printCheck is set to true, a line prepended with `"Check:"` and the
    # message supplied in $msg is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckComObjects CheckBoolean CheckList CheckMatrix CheckString

    if { $expected != $value } {
        puts "Error: $msg (Expected: $expected Have: $value)"
        return false
    }
    if { $printCheck } {
        puts "Check: $msg (Expected: $expected Have: $value)"
    }
    return true
}

proc ::Cawt::CheckString {expected value msg {printCheck true}} {

    # Check, if two string values are identical.
    #
    # expected   - Expected string value.
    # value      - Test string value.
    # msg        - Message for test case.
    # printCheck - Print message for successful test case.
    #
    # Returns true, if both string values are identical.
    # If "printCheck" is set to true, a line prepended with `"Check:"` and the
    # message supplied in "msg" is printed to standard output.
    # If the check fails, return false and print message prepended with `"Error:"`.
    #
    # See also: CheckComObjects CheckList CheckMatrix CheckBoolean CheckNumber

    if { $expected ne $value } {
        puts "Error: $msg (Expected: \"$expected\" Have: \"$value\")"
        return false
    }
    if { $printCheck } {
        puts "Check: $msg (Expected: \"$expected\" Have: \"$value\")"
    }
    return true
}

proc ::Cawt::ClearClipboard {} {

    twapi::open_clipboard
    twapi::empty_clipboard
    twapi::close_clipboard
}

proc ::Cawt::ClipboardToImg {} {

    # Copy the clipboard content into a photo image.
    #
    # The photo image identifier is returned, if the clipboard
    # content could be read correctly. Otherwise an error is thrown.
    #
    # **Note:**
    # The image data in the clipboard must be in `BMP` format.
    # Therefore it needs the `Img` extension.
    # The image must be freed by the caller with `image delete`,
    # if not needed anymore.
    #
    # Returns the photo image identifier.
    #
    # See also: ImgToClipboard

    variable sBmpHeaderSize

    set retVal [catch { package require Img } version]
    if { $retVal != 0 } {
        error "ClipboardToImg: Package Img not available."
    }

    twapi::open_clipboard

    # Assume clipboard content is in format 8 (CF_DIB)
    set retVal [catch { twapi::read_clipboard 8 } clipData]
    if { $retVal != 0 } {
        error "ClipboardToImg: Invalid or no content in clipboard"
    }

    # First parse the bitmap data to collect header information
    binary scan $clipData "iiissiiiiii"  size width height planes bitcount compression sizeimage  xpelspermeter ypelspermeter clrused clrimportant

    # We only handle BITMAPINFOHEADER right now (size must be 40)
    if { $size != 40 } {
        error "ClipboardToImg: Unsupported bitmap format. Header size=$size"
    }

    # We need to figure out the offset to the actual bitmap data
    # from the start of the file header. For this we need to know the
    # size of the color table which directly follows the BITMAPINFOHEADER
    if { $bitcount == 0 } {
        error "ClipboardToImg: Unsupported format: implicit JPEG or PNG"
    } elseif { $bitcount == 1 } {
        set color_table_size 2
    } elseif { $bitcount == 4 } {
        # TBD - Not sure if this is the size or the max size
        set color_table_size 16
    } elseif { $bitcount == 8 } {
        # TBD - Not sure if this is the size or the max size
        set color_table_size 256
    } elseif { $bitcount == 16 || $bitcount == 32 } {
        if { $compression == 0 } {
            # BI_RGB
            set color_table_size $clrused
        } elseif { $compression == 3 } {
            # BI_BITFIELDS
            set color_table_size 3
        } else {
            error "ClipboardToImg: Unsupported compression type '$compression' for bitcount value $bitcount"
        }
    } elseif { $bitcount == 24 } {
        set color_table_size $clrused
    } else {
        error "ClipboardToImg: Unsupported value '$bitcount' in bitmap bitcount field"
    }

    set phImg [image create photo]
    set bitmap_file_offset [expr {$sBmpHeaderSize + $size + ($color_table_size * 4)}]
    set filehdr [binary format "a2 i x2 x2 i"  "BM" [expr {$sBmpHeaderSize + [string length $clipData]}]  $bitmap_file_offset]

    append filehdr $clipData
    $phImg put $filehdr -format bmp

    twapi::close_clipboard
    return $phImg
}

proc ::Cawt::ConcatFiles {outFile args} {

    # Concatenates files into one file.
    #
    # outFile - Output file name.
    # args    - List of input files.
    #
    # Concatenate the contents of the files specified in $args into one
    # file $outFile.
    #
    # Returns no value.
    # If the output file could not be opened for writing
    # or any of the input files could not be openend for reading, an error
    # is thrown.
    #
    # See also: IsUnicodeFile SplitFile

    set catchVal [catch {open $outFile w} outFp]
    if { $catchVal != 0 } {
        close $inFp
        error "Could not open file \"$outFile\" for writing."
    }
    fconfigure $outFp -translation binary

    foreach fileName $args {
        set catchVal [catch {open $fileName r} fp]
        if { $catchVal != 0 } {
            close $outFp
            error "Could not open file \"$fileName\" for reading."
        }
        fconfigure $fp -translation binary
        fcopy $fp $outFp
        close $fp
    }
    close $outFp
}

proc ::Cawt::CountWords {str args} {

    # Count words contained in a string.
    #
    # str  - String to be searched.
    # args - Options described below.
    #
    # -sortmode <string>  - Sorting mode of output list.
    #                       Default: length.
    #                       Possible values: dictionary, length, increasing, decreasing.
    # -minlength <int>    - Only count words having more than minlength characters.
    #                       Default: No limit.
    # -maxlength <int>    - Only count words having less than maxlength characters.
    #                       Default: No limit.
    # -shownumbers <bool> - If set to false, only count words which are no numbers.
    #
    # Returns a key-value list containing the found words and their
    # corresponding count.
    #
    # Count words contained in a string.
    #
    # Notes:
    #  * The definition of a word is like in Tcl command `string wordend`.
    #  * This procedure can be called as a coroutine. It yields
    #    every 1000 bytes processed. The yield return value is the
    #    number of bytes already processed.
    #    See test script `Core-04_String.tcl` for an usage example.
    #
    # See also: ::Word::CountWords

    set opts [dict create  -sortmode    "length"  -minlength   -1  -maxlength   -1  -shownumbers true  ]
    foreach { key value } $args {
        if { $value eq "" } {
            error "CountWords: No value specified for key \"$key\""
        }
        if { [dict exists $opts $key] } {
            dict set opts $key $value
        } else {
            error "CountWords: Unknown option \"$key\" specified"
        }
    }

    set wordStart 0
    set wordEnd   0

    set strLen [string length $str]
    set percent 0
    if { [info coroutine] ne "" } {
        yield 0
    }
    set thousands 1000
    set minLength [dict get $opts "-minlength"]
    set maxLength [dict get $opts "-maxlength"]
    while { $wordEnd < $strLen } {
        set wordEnd   [string wordend $str $wordStart]
        set foundWord [string trim [string range $str $wordStart [expr { $wordEnd - 1}]]]
        set wordStart $wordEnd
        set wordLen [string length $foundWord]
        if { ( $minLength < 0 || $wordLen >= $minLength ) &&  ( $maxLength < 0 || $wordLen <= $maxLength ) } {
            if { ! [dict get $opts "-shownumbers"] && [string is digit $foundWord] } {
                continue
            }
            incr wordHash($foundWord)
        }
        if { $wordEnd > $thousands } {
            incr thousands 1000
            if { [info coroutine] ne "" } {
                yield $wordEnd
            }
        }
    }
    if { [info coroutine] ne "" } {
        yield $strLen
    }

    set sortedList [lsort -dictionary [array names wordHash]]
    if { [dict get $opts "-sortmode"] eq "length" } {
        set sortedList [lsort -command Cawt::_StringLenCompare $sortedList]
    }

    set keyValueList [list]
    foreach word $sortedList {
        lappend keyValueList $word $wordHash($word)
    }
    if { [dict get $opts "-sortmode"] eq "increasing" } {
        return [lsort -stride 2 -index 1 -integer -increasing $keyValueList]
    } elseif { [dict get $opts "-sortmode"] eq "decreasing" } {
        return [lsort -stride 2 -index 1 -integer -decreasing $keyValueList]
    } else {
        return $keyValueList
    }
}

proc ::Cawt::Destroy {{comObj {}}} {

    # Destroy one or all COM objects.
    #
    # comObj - The COM object to be destroyed.
    #
    # If $comObj is an empty string, all existing COM objects are destroyed.
    # Otherwise only the specified COM object is destroyed.
    #
    # **Note:**
    #   * Twapi does not clean up generated COM object identifiers, so you
    #     have to put a call to Destroy at the end of your CAWT script.
    #     For further details about COM objects and their lifetime see the Twapi
    #     documentation.
    #
    # Returns no value.
    #
    # See also: PushComObjects PopComObjects

    if { $comObj ne "" } {
        $comObj -destroy
    } else {
        # Delete objects in reverse order of creation, i.e. newest first.
        foreach obj [lsort -decreasing -command Cawt::_SortObjs [Cawt::GetComObjects]] {
            $obj -destroy
        }
    }
}

proc ::Cawt::EmbedApp {embedFrame args} {

    # Embed an application into a Tk frame.
    #
    # embedFrame - Tk frame.
    # args       - Options described below.
    #
    # -filename <string> - Embed the application based on specified opened file.
    # -window <string>   - Embed the application based on a window identifier.
    #                      The window identifier must be a list as returned by
    #                      twapi::find_windows: { $windowHandle HWND }
    # -appid             - Identifier of the application instance.
    #                      Must be specified, if the application has been started
    #                      via the COM interface.
    # -timeout <float>   - Timeout in seconds to wait for the application to start.
    #                      Applicable only when using `-filename`.
    #                      Default: 1 second.
    #
    # Returns no value.
    #
    # See also: SetEmbedTimeout ::Ppt::OpenPres ::Word::OpenDocument ::Excel::OpenWorkbook

    variable sTimeout

    set opts [dict create  -appid    ""   -filename ""   -window   ""   -timeout  -1.0  ]


    set catchVal [catch {info level -1}]
    if { $catchVal } {
        set callerName "Main"
    } else {
        set callerProc [lindex [info level -1] 0]
        set callerName [lindex [split $callerProc "::"] end]
    }

    foreach { key value } $args {
        if { [dict exists $opts $key] } {
            if { $value eq "" } {
                error "$callerName: No value specified for key \"$key\"."
            }
            dict set opts $key $value
        } else {
            error "$callerName: Unknown option \"$key\" specified."
        }
    }

    set appId    [dict get $opts "-appid"]
    set fileName [dict get $opts "-filename"]
    set windowId [dict get $opts "-window"]
    set timeout  [dict get $opts "-timeout"]

    if { $timeout < 0.0 && [info exists sTimeout] } {
        # Global timeout has been set via SetEmbedTimeout.
        set timeout $sTimeout
    }
    if { $timeout < 0.0 } {
        # Neither SetEmbedTimeout nor -timeout has been specified.
        # Use default value.
        set timeout 1.0
    }
    set numTrys [expr { int ($timeout * 10.0) }]
    if { $numTrys < 1 } {
        set numTrys 1
    }

    if { $fileName eq "" && $windowId eq "" } {
        error "$callerName: Neither \"-filename\" nor \"-window\" option specified."
    }

    if { ! [winfo exists $embedFrame] } {
        error "$callerName: Frame \"$embedFrame\" does not exists."
    }
    if { [winfo class $embedFrame] ne "Frame" } {
        error "$callerName: \"$embedFrame\" is not a frame."
    }
    if { ! [$embedFrame cget -container] } {
        error "$callerName: Frame \"$embedFrame\" is not a container frame."
    }

    if { $fileName ne "" } {
        set shortName [file tail $fileName]
        for { set curTry 0 } { $curTry < $numTrys } { incr curTry } {
            set hndlList [twapi::find_windows -text "*${shortName}*" -match glob]
            if { [llength $hndlList] > 0 } {
                break
            }
            after 100
        }
        if { [llength $hndlList] == 0 } {
            error "$callerName: Cannot embed application with file \"$shortName\"."
        }
        set windowId [lindex $hndlList 0]
    }
    set frameHndl [twapi::tkpath_to_hwnd $embedFrame]
    twapi::SetParent $windowId $frameHndl
    bind $embedFrame <Configure>  [list Cawt::_ResizeEmbeddedWindow $appId $embedFrame $windowId %w %h]
}

proc ::Cawt::GetColor {args} {

    # Convert a color representation into an Office color number.
    #
    # args - A valid color representation.
    #
    # Colors can be specified in one of the following representations:
    # Name          - A valid Tcl color name string, ex. `black`.
    # Hexadecimal   - A valid Tcl hexadecimal string, ex. `#00FFAA`.
    # RGB           - 3 integer values in the range 0 .. 255.
    # Office number - An integer number with encoded RGB values.
    #
    # Returns the color as an Office color number.
    #
    # See also: GetColor GetColorNames IsHexColor IsNameColor IsRgbColor IsOfficeColor

    variable sColorNameList

    if { [llength $args] == 1 } {
        set color [lindex $args 0]
        if { [Cawt IsNameColor $color] } {
            set rgbList $sColorNameList($color)
            return [Cawt RgbToOfficeColor  [lindex $rgbList 0]  [lindex $rgbList 1]  [lindex $rgbList 2]]
        } elseif { [Cawt IsHexColor $color] } {
            scan $color "#%2x%2x%2x" r g b
            return [Cawt RgbToOfficeColor $r $g $b]
        } elseif { [Cawt IsOfficeColor $color] } {
            return $color
        }
    } elseif { [llength $args] == 3 } {
        return [Cawt RgbToOfficeColor {*}$args]
    }
    error "GetColor: Invalid color representation \"$args\" specified."
}

proc ::Cawt::GetColorNames {} {

    # Get all supported Tcl color names.
    #
    # Returns a sorted list of all supported Tcl color names.
    #
    # See also: IsNameColor

    variable sColorNameList

    return [lsort -dictionary [array names sColorNameList]]
}

proc ::Cawt::GetComObjects {} {

    # Get the COM objects currently in use as a list.
    #
    # Returns the COM objects currently in use as a list.
    #
    # See also: IsComObject GetNumComObjects PrintNumComObjects Destroy

    return [twapi::comobj_instances]
}

proc ::Cawt::GetDotsPerInch {} {

    # Get the dots-per-inch value used for conversions.
    #
    # Returns the dots-per-inch value used for conversions.
    #
    # See also: SetDotsPerInch

    variable dotsPerInch

    return $dotsPerInch
}

proc ::Cawt::GetNumComObjects {} {

    # Get the number of COM objects currently in use.
    #
    # Returns the number of COM objects currently in use.
    #
    # See also: IsComObject GetComObjects PrintNumComObjects Destroy

    return [llength [Cawt::GetComObjects]]
}

proc ::Cawt::GetOrCreateApp {appName useExistingFirst} {

    # Use or create an instance of an application.
    #
    # appName          - The name of the application to be created or used.
    # useExistingFirst - Prefer an already running application.
    #
    # Application names supported and tested with CAWT are:
    #   * `Excel.Application`
    #   * `GoogleEarth.ApplicationGE`
    #   * `InternetExplorer.Application`
    #   * `Matlab.Application`
    #   * `MODI.Document`
    #   * `Outlook.Application`
    #   * `PowerPoint.Application`
    #   * `Word.Application`
    #
    # **Note:**
    #   * There are higher level functions `Open` and `OpenNew` for the
    #     CAWT sub-packages.
    #
    # If $useExistingFirst is set to true, it is checked, if an application
    # instance is already running. If true, this instance is used.
    # If no running application is available, a new instance is started.
    #
    # Returns the application identifier.
    #
    # See also: KillApp

    set foundApp false
    if { ! [HavePkg "twapi"] } {
        error "Cannot use $appName. No Twapi extension available."
    }
    if { $useExistingFirst } {
        set retVal [catch {twapi::comobj $appName -active} appId]
        if { $retVal == 0 } {
            set foundApp true
        }
    }
    if { $foundApp == false } {
        set retVal [catch {twapi::comobj $appName} appId]
    }
    if { $foundApp == true || $retVal == 0 } {
        return $appId
    }
    error "Cannot get or create $appName object."
}

proc ::Cawt::GetPkgVersion {pkgName} {

    # Get the version of a CAWT sub-package.
    #
    # pkgName - The name of the sub-package
    #
    # Returns the version of the CAWT sub-package as a string.
    # If the package is not available, an empty string is returned.
    #
    # See also: HavePkg

    variable pkgInfo

    set retVal ""
    if { [HavePkg $pkgName] } {
        set retVal $pkgInfo($pkgName,version)
    }
    return $retVal
}

proc ::Cawt::GetProgramByExtension {extension} {

    # Get path to program for a given file extension.
    #
    # extension - The extension string (including a dot, ex. `.pdf`).
    #
    # Returns the path to the program which is associated in the Windows registry
    # with the file extension.

    set retVal [catch { package require registry } version]
    if { $retVal != 0 } {
        return ""
    }
    # Read the type name.
    set type [registry get HKEY_CLASSES_ROOT\\$extension {}]
    # Work out where to look for the program.
    set path "HKEY_CLASSES_ROOT\\$type\\Shell\\Open\\command"
    # Read the program name.
    set prog [registry get $path {}]

    set lastSpaceIndex [expr {[string last " " $prog] - 1}]
    set progName [string trim [string range $prog 0 $lastSpaceIndex] "\""]
    if { [file executable $progName] } {
        return $progName
    }
    return ""
}

proc ::Cawt::GetTmpDir {} {

    global tcl_platform env

    set tmpDir ""
    # Try different environment variables.
    if { [info exists env(TMP)] && [file isdirectory $env(TMP)] } {
        set tmpDir $env(TMP)
    } elseif { [info exists env(TEMP)] && [file isdirectory $env(TEMP)] } {
        set tmpDir $env(TEMP)
    } elseif { [info exists env(TMPDIR)] && [file isdirectory $env(TMPDIR)] } {
        set tmpDir $env(TMPDIR)
    } else {
        # Last resort. These directories should be available at least.
        switch $tcl_platform(platform) {
            unix {
                if { [file isdirectory "/tmp"] } {
                    set tmpDir "/tmp"
                }
            }
        }
    }
    return [file nativename $tmpDir]
}

proc ::Cawt::HavePkg {pkgName} {

    # Check, if a CAWT sub-package is available.
    #
    # pkgName - The name of the sub-package.
    #
    # Returns true, if sub-package pkgName was loaded successfully.
    # Otherwise returns false.
    #
    # See also: GetPkgVersion

    variable pkgInfo

    if { [info exists pkgInfo($pkgName,avail)] } {
        return $pkgInfo($pkgName,avail)
    }
    return 0
}

proc ::Cawt::ImgToClipboard {phImg} {

    # Copy a photo image into the clipboard.
    #
    # phImg - The photo image identifier.
    #
    # If the image could not be copied to the clipboard correctly,
    # an error is thrown.
    #
    # **Note:**
    # The image data is copied to the clipboard in `BMP` format.
    # Therefore it needs the `Img` extension.
    # If using an `Img` version prior to 2.0, then the
    # `base64` extension is needed, too.
    # Img 2.0 returns image data as binary string.
    # Img 1.4 returns image data as base64 encoded string.
    #
    # Returns no value.
    #
    # See also: ClipboardToImg

    variable sBmpHeaderSize

    set retVal [catch {package require Img} imgVersion]
    if { $retVal != 0 } {
        error "ImgToClipboard: Package Img not available."
    }
    if { ! [package vsatisfies $imgVersion "2.0-"] } {
        set retVal [catch {package require base64} base64Version]
        if { $retVal != 0 } {
            error "ImgToClipboard: Package Base64 not available."
        }
    }

    # First 14 bytes are bitmapfileheader.
    if { [package vsatisfies $imgVersion "2.0-"] } {
        set data [string range [$phImg data -format bmp] $sBmpHeaderSize end]
    } else {
        set data [string range [base64::decode [$phImg data -format bmp]] $sBmpHeaderSize end]
    }
    twapi::open_clipboard
    twapi::empty_clipboard
    twapi::write_clipboard 8 $data
    twapi::close_clipboard
    Cawt WaitClipboardReady
}

proc ::Cawt::InchesToPoints {inches} {

    # Convert inch value into points.
    #
    # inches - Floating point inch value to be converted to points.
    #
    # Returns the corresponding value in points.
    #
    # See also: SetDotsPerInch CentiMetersToPoints PointsToInches

    variable dotsPerInch

    return [expr {$inches * double($dotsPerInch)}]
}

proc ::Cawt::IsAppIdValid {appId} {

    # Check, if an application identifier is valid.
    #
    # appId - The application identifier.
    #
    # Returns true, if $appId is valid.
    # Otherwise returns false.
    #
    # See also: IsComObject GetComObjects GetNumComObjects

    set catchVal [catch { $appId -default }]
    if { $catchVal != 0 } {
        return false
    }
    return true
}

proc ::Cawt::IsComObject {comObj} {

    # Check, if parameter is a COM object.
    #
    # comObj - The COM object.
    #
    # Returns true, if $comObj is a COM object.
    # Otherwise returns false.
    #
    # See also: IsAppIdValid GetComObjects GetNumComObjects

    return [expr { [twapi::comobj? $comObj] && ! [$comObj -isnull] } ]
}

proc ::Cawt::IsHexColor {color} {

    # Check, if specified color is a valid Tcl hexadecimal color string.
    #
    # color - The Tcl color string as hexadecimal representation, ex. `#0ACCF0`.
    #
    # Returns true, if supplied string is a valid color string, otherwise false.
    #
    # See also: GetColor GetColorNames IsNameColor IsRgbColor IsOfficeColor

    if { [string index $color 0] eq "#" } {
        scan $color "#%2x%2x%2x" r g b
        return [Cawt::_IsValidRgb $r $g $b]
    }
    return false
}

proc ::Cawt::IsNameColor {color} {

    # Check, if specified color is a valid Tcl color name.
    #
    # color - The Tcl color name as a string, ex. `black`.
    #
    # Returns true, if supplied string is a valid color name, otherwise false.
    #
    # See also: GetColor GetColorNames IsHexColor IsRgbColor IsOfficeColor

    variable sColorNameList

    return [info exists sColorNameList($color)]
}

proc ::Cawt::IsoDateToOfficeDate {isoDate} {

    # Return ISO date string as Office date.
    #
    # isoDate - Date string in format `%Y-%m-%d %H:%M:%S`.
    #
    # Returns corresponding date as floating point number
    # representing days since 1900/01/01.
    #
    # See also: OfficeDateToIsoDate IsoDateToSeconds IsoDateToXmlDate

    return [Cawt::SecondsToOfficeDate [Cawt::IsoDateToSeconds $isoDate]]
}

proc ::Cawt::IsoDateToOutlookDate {isoDate} {

    # Obsolete: Replaced with [IsoDateToOfficeDate] in version 2.4.4
    #
    # isoDate - Date string in format `%Y-%m-%d %H:%M:%S`.
    #
    # Returns corresponding date as floating point number
    # representing days since `1900/01/01`.
    #
    # See also: OutlookDateToIsoDate IsoDateToSeconds IsoDateToXmlDate

    return [Cawt::SecondsToOfficeDate [Cawt::IsoDateToSeconds $isoDate]]
}

proc ::Cawt::IsoDateToSeconds {isoDate} {

    # Return ISO date string as seconds.
    #
    # isoDate - Date string in format `%Y-%m-%d %H:%M:%S`.
    #
    # Returns corresponding seconds as integer.
    #
    # See also: SecondsToIsoDate XmlDateToSeconds OfficeDateToSeconds

    return [clock scan $isoDate -format {%Y-%m-%d %H:%M:%S}]
}

proc ::Cawt::IsoDateToXmlDate {isoDate} {

    # Return ISO date string as XML date string.
    #
    # isoDate - Date string in format `%Y-%m-%d %H:%M:%S`.
    #
    # Returns corresponding date as XML date string.
    #
    # See also: XmlDateToIsoDate IsoDateToSeconds IsoDateToOfficeDate

    return [Cawt::SecondsToXmlDate [Cawt::IsoDateToSeconds $isoDate]]
}

proc ::Cawt::IsOfficeColor {color} {

    # Check, if specified color is a valid Office color number.
    #
    # color - The Office color number.
    #
    # Returns true, if supplied string is a valid color string, otherwise false.
    #
    # See also: GetColor GetColorNames IsHexColor IsNameColor IsRgbColor

    if { [string is integer $color] } {
        set r [expr { (int ($color))       & 0xFF }]
        set g [expr { (int ($color) >>  8) & 0xFF }]
        set b [expr { (int ($color) >> 16) & 0xFF }]
        return [Cawt::_IsValidRgb $r $g $b]
    }
    return false
}

proc ::Cawt::IsRgbColor {r g b} {

    # Check, if specified color is a valid RGB representation.
    #
    # r - The red component of the color.
    # g - The green component of the color.
    # b - The blue component of the color.
    #
    # The r, g and b values are specified as integers in the
    # range 0 .. 255.
    #
    # Returns true, if supplied values are in the supported range, otherwise false.
    #
    # See also: GetColor GetColorNames IsHexColor IsNameColor IsOfficeColor

    return [Cawt::_IsValidRgb $r $g $b]
}

proc ::Cawt::IsUnicodeFile {fileName} {

    # Check, if a file is encoded in Unicode.
    #
    # fileName - File to check encoding.
    #
    # Unicode encoding is detected by checking the BOM.
    # If the first two bytes are `FF FE`, the file seems to be
    # a Unicode file.
    #
    # Returns true, if file is encoded in Unicode, otherwise false.
    #
    # See also: SplitFile ConcatFiles

    set catchVal [catch {open $fileName r} fp]
    if { $catchVal != 0 } {
        error "Could not open file \"$fileName\" for reading."
    }
    fconfigure $fp -translation binary
    set bom [read $fp 2]
    close $fp
    binary scan $bom "cc" bom1 bom2
    set bom1 [expr {$bom1 & 0xFF}]
    set bom2 [expr {$bom2 & 0xFF}]
    if { [format "%02X%02X" $bom1 $bom2] eq "FFFE" } {
        return true
    }
    return false
}

proc ::Cawt::IsValidId {comObj} {

    # Obsolete: Replaced with [IsComObject] in version 2.0.0

    return [IsComObject $comObj]
}

proc ::Cawt::IsValidUrlAddress {address} {

    # Check, if supplied address is a valid URL.
    #
    # address - The URL address.
    #
    # Returns true, if $address is a valid URL.
    # Otherwise returns false.
    #
    # See also: ::Word::GetHyperlinksAsDict

    variable httpInitialized

    # Internal note: The algorithm used in this procedure is
    # also used in a slightly modified way using caching in
    # CawtWord::GetHyperlinksAsDict.

    if { ! $httpInitialized } {
        package require http
        # Needed to check http and https links.
        http::register https 443 [list ::twapi::tls_socket]
        set httpInitialized true
    }

    lassign [split $address "#"] address subAddress
    if { $subAddress eq "" } {
        set catchVal [catch {  http::geturl $address -validate true -strict false } token]
    } else {
        set catchVal [catch { http::geturl $address } token]
        if { $catchVal == 0 } {
            set htmlData [http::data $token]
            # Search for <a name="subAddress"> occurences.
            set exp {<[\s]*a[\s]+name=([^\s>]+)[\s]*>}
            set matchList [regexp -all -inline -nocase -- $exp $htmlData]
            set catchVal 1
            foreach { overall match } $matchList {
                set matchStr [string trim $match "\"\'"]
                if { $matchStr eq $subAddress } {
                    set catchVal 0
                    break
                }
            }
        }
    }
    set valid false
    if { $catchVal == 0 } {
        if { [http::ncode $token] < 400 } {
            set valid true
        }
    }
    http::cleanup $token
    return $valid
}

proc ::Cawt::KillApp {progName} {

    # Kill all running instances of an application.
    #
    # progName - The application's program name, as shown in the task manager.
    #
    # Returns no value.
    #
    # See also: GetOrCreateApp

    set pids [concat [twapi::get_process_ids -name $progName]  [twapi::get_process_ids -path $progName]]
    foreach pid $pids {
        # Catch the error in case process does not exist any more
        catch {twapi::end_process $pid -force}
    }
}

proc ::Cawt::OfficeColorToRgb {color} {

    # Convert an Office color number into a RGB color list.
    #
    # color - The Office color number.
    #
    # Returns the color as a list of r, b and b values.
    # The r, g and b values are returned as integers in the
    # range 0 .. 255.
    #
    # See also: RgbToOfficeColor GetColor

    set r [expr { (int ($color))       & 0xFF }]
    set g [expr { (int ($color) >>  8) & 0xFF }]
    set b [expr { (int ($color) >> 16) & 0xFF }]
    return [list $r $g $b]
}

proc ::Cawt::OfficeDateToIsoDate {officeDate} {

    # Return Office date as ISO date string.
    #
    # officeDate - Floating point number representing days since `1900/01/01`.
    #
    # Returns corresponding date as ISO date string.
    #
    # See also: IsoDateToOfficeDate OfficeDateToSeconds

    return [Cawt::SecondsToIsoDate [Cawt::OfficeDateToSeconds $officeDate]]
}

proc ::Cawt::OfficeDateToSeconds {officeDate} {

    # Return Office date as seconds.
    #
    # officeDate - Floating point number representing days since `1900/01/01`.
    #
    # Returns corresponding seconds as integer.
    #
    # See also: SecondsToOfficeDate IsoDateToSeconds XmlDateToSeconds

    variable sOfficeDate

    set diffDays [expr { $officeDate - $sOfficeDate(Day) }]
    return [expr { $sOfficeDate(Sec) + int ($diffDays * 60.0 * 60.0 * 24.0) }]
}

proc ::Cawt::OutlookDateToIsoDate {outlookDate} {

    # Obsolete: Replaced with [OfficeDateToIsoDate] in version 2.4.4
    #
    # outlookDate - Floating point number representing days since `1900/01/01`.
    #
    # Returns corresponding date as ISO date string.
    #
    # See also: IsoDateToOutlookDate OutlookDateToSeconds

    return [Cawt::SecondsToIsoDate [Cawt::OfficeDateToSeconds $outlookDate]]
}

proc ::Cawt::OutlookDateToSeconds {outlookDate} {

    # Obsolete: Replaced with [OfficeDateToSeconds] in version 2.4.4
    #
    # outlookDate - Floating point number representing days since `1900/01/01`.
    #
    # Returns corresponding seconds as integer.
    #
    # See also: SecondsToOutlookDate IsoDateToSeconds XmlDateToSeconds

    return [Cawt::OfficeDateToSeconds $outlookDate]
}

proc ::Cawt::PointsToCentiMeters {points} {

    # Convert value in points into centimeters.
    #
    # points - Floating point value to be converted to centimeters.
    #
    # Returns the corresponding value in centimeters.
    #
    # See also: SetDotsPerInch InchesToPoints CentiMetersToPoints

    variable dotsPerInch

    return [expr {$points * 2.54 / double($dotsPerInch)}]
}

proc ::Cawt::PointsToInches {points} {

    # Convert value in points into inches.
    #
    # points - Floating point value to be converted to inches.
    #
    # Returns the corresponding value in inches.
    #
    # See also: SetDotsPerInch CentiMetersToPoints InchesToPoints

    variable dotsPerInch

    return [expr {$points / double($dotsPerInch)}]
}

proc ::Cawt::PopComObjects {{printStack false}} {

    # Pop last entry from COM objects stack.
    #
    # printStack - Print stack content after popping onto stdout.
    #
    # Pop last entry from COM objects stack and
    # remove all COM objects currently in use which
    # are not contained in the popped entry.
    #
    # Returns no value.
    #
    # See also: PushComObjects

    variable comObjStack

    set lastEntry [lindex $comObjStack end]
    set comObjStack [lrange $comObjStack 0 end-1]
    foreach comObj [lsort -increasing -command Cawt::_SortObjs [Cawt::GetComObjects]] {
        if { [lsearch -exact $lastEntry $comObj] < 0 } {
            Cawt Destroy $comObj
        }
    }
    if { $printStack } {
        Cawt::_PrintComObjStack "PopComObjects"
    }
}

proc ::Cawt::PrintNumComObjects {} {

    # Print the number of currently available COM objects to stdout.
    #
    # Returns no value.
    #
    # See also: IsComObject GetComObjects GetNumComObjects Destroy

    puts "Number of COM objects: [Cawt::GetNumComObjects]"
}

proc ::Cawt::PushComObjects {{printStack false}} {

    # Push current list of COM objects onto a stack.
    #
    # printStack - Print stack content after pushing onto stdout.
    #
    # Returns no value.
    #
    # See also: PopComObjects

    variable comObjStack

    lappend comObjStack [lsort -increasing -command Cawt::_SortObjs [Cawt::GetComObjects]]

    if { $printStack } {
        Cawt::_PrintComObjStack "PushComObjects"
    }
}

proc ::Cawt::RgbToOfficeColor {r g b} {

    # Convert a RGB color into an Office color number.
    #
    # r - The red component of the color.
    # g - The green component of the color.
    # b - The blue component of the color.
    #
    # The r, g and b values are specified as integers in the
    # range 0 .. 255.
    #
    # Returns the color as an Office color integer number.
    #
    # See also: OfficeColorToRgb GetColor

    return [expr {int ($b) << 16 | int ($g) << 8 | int($r)}]
}

proc ::Cawt::SecondsToIsoDate {sec} {

    # Return date in seconds as ISO date string.
    #
    # sec - Date in seconds as returned by `clock seconds`.
    #
    # Returns corresponding date as ISO date string.
    #
    # See also: IsoDateToSeconds SecondsToXmlDate SecondsToOfficeDate

    return [clock format $sec -format {%Y-%m-%d %H:%M:%S}]
}

proc ::Cawt::SecondsToOfficeDate {sec} {

    # Return date in seconds as Office date.
    #
    # sec - Date in seconds as returned by `clock seconds`.
    #
    # Returns corresponding date as floating point number
    # representing days since `1900/01/01`.
    #
    # See also: OfficeDateToSeconds SecondsToIsoDate SecondsToXmlDate

    variable sOfficeDate

    set diffSecs [expr { $sec - $sOfficeDate(Sec) }]
    return [expr { $sOfficeDate(Day) + $diffSecs / 60.0 / 60.0 / 24.0 }]
}

proc ::Cawt::SecondsToOutlookDate {sec} {

    # Obsolete: Replaced with [SecondsToOfficeDate] in version 2.4.4
    #
    # sec - Date in seconds as returned by `clock seconds`.
    #
    # Returns corresponding date as floating point number
    # representing days since `1900/01/01`.
    #
    # See also: OutlookDateToSeconds SecondsToIsoDate SecondsToXmlDate

    return [Cawt::SecondsToOfficeDate $sec]
}

proc ::Cawt::SecondsToXmlDate {sec} {

    # Return date in seconds as XML date string.
    #
    # sec - Date in seconds as returned by `clock seconds`.
    #
    # Returns corresponding date as XML date string.
    #
    # See also: XmlDateToSeconds SecondsToIsoDate SecondsToOfficeDate

    return [clock format $sec -format {%Y-%m-%dT%H:%M:%S.000Z}]
}

proc ::Cawt::SetClipboardWaitTime {waitTime} {

    # Set the time to wait until clipboard content is ready.
    #
    # waitTime - Wait time in milliseconds.
    #
    # Returns no value.
    #
    # See also: WaitClipboardReady

    variable sWaitTime

    set sWaitTime [expr int($waitTime)]
}

proc ::Cawt::SetDotsPerInch {dpi} {

    # Set the dots-per-inch value used for conversions.
    #
    # dpi - Integer dpi value.
    #
    # If the dpi value is not explicitely set with this procedure,
    # it's default value is 72.
    #
    # Returns no value.
    #
    # See also: GetDotsPerInch

    variable dotsPerInch

    set dotsPerInch $dpi
}

proc ::Cawt::SetEmbedTimeout {timeout} {

    # Set the timeout to wait for the embedded application to start.
    #
    # timeout - Timeout in seconds.
    #
    # Returns no value.
    #
    # See also: EmbedApp

    variable sTimeout

    set sTimeout $timeout
    if { $sTimeout <= 0.0 } {
        set sTimeout 1.0
    }
}

proc ::Cawt::SetEventCallback {appId callback} {

    # Set an event callback procedure.
    #
    # appId    - The application identifier.
    # callback - The event callback procedure.
    #
    # If $callback is the empty string, an existing event
    # callback is disabled.
    #
    # The $callback procedure must have an `args` argument
    # as shown in the following example:
    #     proc PrintEvent { args } {
    #         puts $args
    #     }
    #
    #     set appId [Excel Open]
    #     Cawt SetEventCallback $appId PrintEvent
    #
    # Returns no value.

    variable sBindId

    if { [info exists sBindId] } {
        $appId -unbind $sBindId
    }
    if { $callback ne "" } {
        set sBindId [$appId -bind $callback]
    }
}

proc ::Cawt::SplitFile {inFile {maxFileSize 2048} {outFilePrefix {}}} {

    # Split a file into several output files.
    #
    # inFile        - Input file name.
    # maxFileSize   - Maximum size of output files in bytes.
    # outFilePrefix - Prefix for output file names.
    #
    # Split the content of the file specified in $inFile into several
    # output files. The output files have a maximum size of $maxFileSize and
    # are named as follows: $outFilePrefix.00001, $outFilePrefix.00002, ...
    #
    # Returns the generated file names as a list.
    # If the input file could not be opened for reading
    # or any of the output files could not be openend for
    # writing, an error is thrown.
    #
    # See also: IsUnicodeFile ConcatFiles

    set catchVal [catch {open $inFile r} inFp]
    if { $catchVal != 0 } {
        error "Could not open file \"$inFile\" for reading."
    }
    fconfigure $inFp -translation binary

    if { $outFilePrefix ne "" } {
        set outFileName $outFilePrefix
    } else {
        set outFileName $inFile
    }
    set count 1
    set fileList [list]
    while { 1 } {
        set str [read $inFp $maxFileSize]
        if { $str ne "" } {
            set fileName [format "%s-%05d" $outFileName $count]
            set catchVal [catch {open $fileName w} outFp]
            if { $catchVal != 0 } {
                close $inFp
                error "Could not open file \"$fileName\" for writing."
            }
            fconfigure $outFp -translation binary
            puts -nonewline $outFp $str
            close $outFp
            lappend fileList $fileName
            incr count
        }
        if { [eof $inFp] } {
            break
        }
    }
    close $inFp
    return $fileList
}

proc ::Cawt::TclBool {val} {

    # Cast a value to a boolean.
    #
    # val - The value to be casted.
    #
    # Returns true, if $val is not equal to zero or true.
    # Otherwise returns false.
    #
    # See also: TclInt TclString

    return [twapi::tclcast boolean $val]
}

proc ::Cawt::TclInt {val} {

    # Cast a value to an integer with boolean range.
    #
    # val - The value to be casted.
    #
    # Returns 1, if $val is not equal to zero or true.
    # Otherwise returns 0.
    #
    # See also: TclBool TclString

    set tmp 0
    if { $val } {
        set tmp 1
    }
    return $tmp
}

proc ::Cawt::TclString {val} {

    # Cast a value to a string.
    #
    # val - The value to be casted.
    #
    # Returns casted string in a format usable for the COM interface.
    #
    # See also: TclInt TclBool

    variable pkgInfo

    if { $pkgInfo(haveStringCast) } {
        return [twapi::tclcast bstr $val]
    } else {
        return [twapi::tclcast string $val]
    }
}

proc ::Cawt::ValueToPoints {value} {

    # Convert a value into points.
    #
    # value - Floating point value to be converted to points.
    #
    # * If the value is followed by `i`, it is interpreted as inches.
    # * If the value is followed by `c`, it is interpreted as centimeters.
    # * If the value is a simple floating point number or followed by `p`,
    #   it is interpreted as points, i.e. the pure value is returned.
    #
    # Example:
    #      ValueToPoints 2c
    #      ValueToPoints 1.5i
    #
    # Returns the corresponding value in points.
    #
    # See also: CentiMetersToPoints InchesToPoints

    if { [string index $value end] eq "c" } {
        return [Cawt::CentiMetersToPoints [string range $value 0 end-1]]
    } elseif { [string index $value end] eq "i" } {
        return [Cawt::InchesToPoints [string range $value 0 end-1]]
    } elseif { [string index $value end] eq "p" } {
        return [string range $value 0 end-1]
    } elseif { [string is double $value] } {
        return $value
    } else {
        error "Invalid value \"$value\" specified."
    }
}

proc ::Cawt::WaitClipboardReady {} {

    # Wait until clipboard content is ready.
    #
    # **Note:**
    # Currently this is simply implemented by waiting a specified amount
    # of milliseconds, which can be specified by [SetClipboardWaitTime].
    # Default value is 200 milliseconds.
    #
    # Returns no value.
    #
    # See also: SetClipboardWaitTime

    variable sWaitTime

    after $sWaitTime
}

proc ::Cawt::XmlDateToIsoDate {xmlDate} {

    # Return XML date string as ISO date string.
    #
    # xmlDate - Date string in format `%Y-%m-%dT%H:%M:%S.000Z`.
    #
    # Returns corresponding date as ISO date string.
    #
    # See also: IsoDateToXmlDate XmlDateToSeconds

    return [Cawt::SecondsToIsoDate [XmlDateToSeconds $xmlDate]]
}

proc ::Cawt::XmlDateToSeconds {xmlDate} {

    # Return XML date string as seconds.
    #
    # xmlDate - Date string in format `%Y-%m-%dT%H:%M:%S.000Z`.
    #
    # Returns corresponding seconds as integer.
    #
    # See also: SecondsToXmlDate IsoDateToSeconds OfficeDateToSeconds

    return [clock scan $xmlDate -format {%Y-%m-%dT%H:%M:%S.000Z}]
}

method constructor {args} {

    # Create an instance of an interpolation curve.
    #
    # args - List of `x y` pairs specifying the control points of the
    #        interpolation curve.
    #
    # An interpolation curve is comprised of one or more control points.
    # The control points are 2-dimensional values:
    # * The x values are increasing, but typically not equidistant.
    # * The y values hold the corresponding (measurement) values.
    # Possible examples are time vs. speed or waveband vs. reflection parameter.
    #
    # ```
    # ^  (Reflection value)
    # |
    # |         + y2
    # |
    # |                   + y3
    # |
    # |  + y1
    # |
    # |
    # ----------------------->
    #    x1     x2        x3   (Waveband)
    # ```
    #
    # Control points can be added to an interpolation curve by specifying
    # them directly in the $args argument of the constructor or by adding
    # them with method [AddControlPoint].
    # The control points can be given in any order. They are automatically
    # sorted by their `x` values.
    #
    # The interpolation curve can be sampled with different interpolation methods.
    # Currently supported are linear and cubic spline interpolation, see
    # [SetInterpolationType].
    #
    # Returns no value.
    #
    # See also: destructor AddControlPoint SetInterpolationType

    my Init
    foreach { x y } $args {
        my AddControlPoint $x $y
    }
}

method destructor {} {

    # Delete the instance of the interpolation curve.
    #
    # Returns no value.
    #
    # See also: constructor DeleteControlPoint Clear

    my Clear
}

method AddControlPoint {x y} {

    # Add a new control point to the interpolation curve.
    #
    # x - x value of the control point.
    # y - y value of the control point.
    #
    # The control points can be given in any order. They are automatically
    # sorted by their `x` values.
    #
    # If a control point with $x value already exists, it is overwritten
    # with the new $y value.
    #
    # Returns no value.
    #
    # See also: constructor DeleteControlPoint ControlPointExists

    set mIsDirty true
    set mPointMap($x) $y
    my InitFromPointMap
}

method Clear {} {

    # Clear all control points of the interpolation curve.
    #
    # Returns no value.
    #
    # See also: constructor destructor DeleteControlPoint

    my Init
    catch { unset mPointMap }
    catch { unset mCoeffs }
    catch { unset mX }
    catch { unset mY }
}

method ControlPointExists {x} {

    # Check, if a control point exists in the interpolation curve.
    #
    # x - x value of the control point.
    #
    # Returns true, if a control point with $x value exists.
    # Otherwise returns false.
    #
    # See also: constructor AddControlPoint DeleteControlPoint

    return [info exists mPointMap] && [info exists mPointMap($x)]
}

method DeleteControlPoint {x} {

    # Delete a control point of the interpolation curve.
    #
    # x - x value of the control point.
    #
    # If a control point with $x does not exist, no action is taken.
    #
    # Returns no value.
    #
    # See also: constructor AddControlPoint ControlPointExists

    set mIsDirty true
    if { [my ControlPointExists $x] } {
        unset mPointMap($x)
    }
    my InitFromPointMap
}

method GetControlPoints {} {

    # Get the list of control points of the interpolation curve.
    #
    # Returns a list of `x y` values of all control points.
    #
    # See also: constructor AddControlPoint GetInterpolatedValue

    set xy [list]
    set numCps [my GetNumControlPoints]
    for { set cpInd 0 } { $cpInd < $numCps } { incr cpInd } {
        lappend xy $mX($cpInd) $mY($cpInd)
    }
    return $xy
}

method GetInterpolatedValue {x args} {

    # Get an interpolated value of the curve at a specific sample point.
    #
    # x    - Sample point.
    # args - Options described below.
    #
    # -extrapolate - Enable extrapolation mode.
    #
    # * If the curve contains no control points, an error is thrown.
    # * If the curve contains 1 control point, the `y` value of that control
    #   point is returned.
    # * If the curve contains 2 control points, the linearly interpolated value
    #   of the 2 control points is returned.
    # * If the curve contains 3 or more control points, the interpolated value
    #   is returned depending on the interpolation type, see [SetInterpolationType].
    #
    # If $x is not inside the range of control points and extrapolation mode is
    # disabled, the `y` values of the first resp. last control point are returned.
    # If extrapolation mode is enabled, the `y` values are extrapolated according
    # to the interpolation mode.
    #
    # Returns the interpolated value at sample point $x.
    #
    # See also: constructor AddControlPoint GetNumControlPoints GetInterpolatedValues
    #           SetInterpolationType

    set extrapolate false
    foreach key $args {
        switch -exact -nocase -- $key {
            "-extrapolate" { set extrapolate true }
        }
    }

    set numCps [my GetNumControlPoints]
    if { $numCps == 0 } {
        throw [list Interpolate GetInterpolatedValue] "No control points specified."
    }
    if { $mIsDirty } {
        my ComputeCoefficients
    }

    if { $numCps == 1 } {
        return $mY(0)
    }

    set index   0
    set numCps1 [expr { $numCps - 1 }]

    if { $x < $mX(0) } {
        # Position is beyond first control point.
        if { $extrapolate == false } {
            return $mY(0)
        }
        set index 1
    } else {
        while { ( $index <= $numCps1 ) && ( $x >= $mX($index) ) } {
            incr index
        }
        if { $index == $numCps } {
            # Position is beyond last control point.
            if { $extrapolate == false } {
                return $mY($numCps1)
            }
            incr index -1
        }
    }
    incr index -1
    if { $mInterpolationType eq "CubicSpline" && $numCps > 2 } {
        set dx [expr { $x - $mX($index) }]
        # Calculate y from cubic polynomial.
        set coeffs $mCoeffs($index)
        set a0 [lindex $coeffs 0]
        set a1 [lindex $coeffs 1]
        set a2 [lindex $coeffs 2]
        set a3 [lindex $coeffs 3]
        set y [expr { $a0 + $a1 * $dx + $a2 * $dx * $dx + $a3 * $dx * $dx * $dx }]
    } else {
        # Calculate y by linear interpolation.
        set index1 [expr { $index + 1 }]
        set dx [expr { $mX($index1) - $mX($index) }]
        set dy [expr { $mY($index1) - $mY($index) }]
        set m  [expr { $dy / $dx }]
        set t  [expr { $mY($index) - $m * $mX($index) }]
        set y  [expr { $m * $x + $t }]
    }
    return $y
}

method GetInterpolatedValues {args} {

    # Get interpolated values of the interpolation curve.
    #
    # args - Options described below.
    #
    # -samples - Number of sample points between each control point.
    #            Default: 10
    #
    # Sample the curve between the control points with a specified number of sample points.
    # Use this method for drawing the curve in ex. a canvas.
    # See test script Cawt-10_Interpolate.tcl on how to easily convert the `y` values
    # to the canvas coordinate system, which goes top-down.
    #
    # Returns a list of `x y` values corresponding to the sample points.
    #
    # See also: constructor AddControlPoint GetNumControlPoints GetInterpolatedValue
    #           SetInterpolationType

    set samples 10
    foreach { key value } $args {
        if { $value eq "" } {
            error "${methodName}: No value specified for key \"$key\"."
        }
        switch -exact -nocase -- $key {
            "-samples" { set samples [expr { int( $value ) }] }
        }
    }

    set numCps [my GetNumControlPoints]
    if { $numCps == 0 } {
        throw [list Interpolate GetInterpolatedValues] "No control points specified."
    }
    if { $mIsDirty } {
        my ComputeCoefficients
    }

    for { set cpInd 1 } { $cpInd < $numCps } { incr cpInd } {
        set cpInd1 [expr { $cpInd - 1 }]
        set diff [expr { $mX($cpInd) - $mX($cpInd1) }]
        for { set i 0 } { $i < $samples } { incr i } {
            set x [expr { $mX($cpInd1) + $i * ( $diff / $samples ) }]
            set y [my GetInterpolatedValue $x]
            lappend xy $x $y
        }
    }
    set last [lindex [array names mX] end]
    set x $mX($last)
    set y [my GetInterpolatedValue $x]
    lappend xy $x $y
    return $xy
}

method GetInterpolationType {} {

    # Get the interpolation type of the interpolation curve.
    #
    # Returns the currently specified interpolation type as string.
    #
    # See also: constructor SetInterpolationType GetInterpolationTypes GetInterpolatedValue

    return $mInterpolationType
}

method GetInterpolationTypes {} {

    # Get the supported interpolation types.
    #
    # Returns the supported interpolation types as list of strings.
    #
    # See also: constructor SetInterpolationType SetInterpolationType GetInterpolatedValue

    return $mInterpolationTypes
}

method GetNumControlPoints {} {

    # Get the number of control points of the interpolation curve.
    #
    # Returns the number of control points of the interpolation curve.
    #
    # See also: constructor AddControlPoint DeleteControlPoint

    if { ! [info exists mPointMap] } {
        return 0
    }
    return [array size mPointMap]
}

method SetInterpolationType {type} {

    # Set the interpolation type of the interpolation curve.
    #
    # type - Interpolation type as string.
    #
    # Supported values for $type are `Linear` and `CubicSpline`.
    # The default interpolation type is `CubicSpline`.
    #
    # Returns no value.
    #
    # See also: constructor GetInterpolationType GetInterpolationTypes GetInterpolatedValue

    if { [lsearch -exact $mInterpolationTypes $type] >= 0 } {
        set mInterpolationType $type
    } else {
        throw [list Interpolate SetInterpolationType] "Invalid interpolation type \"${type}\"."
    }
}