Plotchart and HTML

Arjen Markus (17 february 2018) While working on my first wapp-lication, I fantasized about the possibility of providing a graphical presentation of the function that the user types in besides simply a table of values. I have not figured out yet how to actually do that, basically my lack of knowledge about JavaScript (though: see the note below!), but I have figured out how to employ Plotchart. What is more: I need to change nothing about Plotchart itself, I merely had to replace the canvas widget I ordinarily use by a TclOO object that has the same if less functional interface.

The result is the program below:

  • It defines a few commands that mimick Tk commands
  • It defines a class called htmlCanvas that takes care of the canvas subcommands (note: it is rather geared to the use of canvases within Plotchart, so nothing really fancy and certainly not a "drop-in" replacement)
  • It draws a simple graph - a parabolic functionHTML

The program writes the JavaScript commands for the plot to standard output, so redirect the output to an HTML file and show it in a browser.

Some remarks:

  • I have not tried to cover the complete set of canvas features used by Plotchart. Many canvas features are actually simply ignored.
  • I tried to do away with Tk, by defining a dummy package, but I need to do a bit more for this and I am a trifle impatient ;). That is an improvement to come.
  • There is a lot of room for improvement, but then I have spent less than a day on this project.

Note on wapp

Richard Hipp has already solved the problem we were facing, so that will be a second version of this application.

# htmlcanvas.tcl --
#     Class to emulate a Tk canvas in HTML
#
set auto_path [concat . $auto_path]
package require Plotchart

proc winfo {args} {
    foreach {key value} $args {
        switch -- $key {
            "width" {
                return 500
            }
            "height" {
                return 500
            }
            default {
                error "$args"
            }
        }
    }
}

proc CorrectForAnchor {xt yt text anchor} {
    switch -- $anchor {
        "n" {
            set yt [expr {$yt + 10}]
        }
        "e" {
            set length [string length $text]
            set xt [expr {$xt - 5 * $length}]
        }
    }

    return [list $xt $yt]
}

::oo::class create htmlCanvas {
    variable color
    variable htmlcode
    variable width
    variable height

    constructor {name args} {
        variable color
        variable htmlcode
        variable width
        variable height

        set width  500
        set height 500
        foreach {key value} $args {
            switch -- $key {
                "-width" {
                     set width $value
                }
                "-height" {
                     set height $value
                }
            }
        }

        append htmlcode "
<canvas id=\"$name\" width=\"$width\" height=\"$height\">The canvas tag is not supported!</canvas>
<script>
var cnv = document.getElementById('$name');
var ctx = cnv.getContext('2d');"

        set color   ""
        my color black
    }

    method color {name} {
        variable color
        variable htmlcode
        if { $color ne $name } {
            set color $name
            append htmlcode "\nctx.fillStyle = '$name';"
            append htmlcode "\nctx.strokeStyle = '$name';"
        }
    }

    method bbox {id} {
        return {0 0 10 10}
    }

    method raise {args} {
        # Dummy
    }

    method lower {args} {
        # Dummy
    }

    method delete {args} {
        # Dummy
    }

    method cget {args} {
        # Dummy
        return 0
    }

    method bind {args} {
        # Dummy
    }

    method emit {} {
        variable htmlcode

        append htmlcode "\n</script>"

        return $htmlcode
    }

    method create {type args} {
        variable htmlcode

        switch -- $type {
            "text" {
                set text ""
                set anchor "c"
                set rest [lassign $args xt yt]
                foreach {key value} $rest {
                    switch -- $key {
                        "-text" {
                            set text $value
                        }
                        "-anchor" {
                            set anchor $value
                        }
                        "-fill" {
                            set fill $value
                        }
                    }
                }
                # Ignore the test string - "M" drawn at (0,0)
                if { $xt == 0 && $yt == 0 && $text eq "M" } {
                    return
                }

                # Accept any other string
                lassign [CorrectForAnchor $xt $yt $text $anchor] xt yt
                my color $fill
                append htmlcode "\nctx.fillText('$text', $xt, $yt);"
            }
            "rectangle" {
                set rest [lassign $args x1 y1 x2 y2]
                set tag ""
                foreach {key value} $rest {
                    switch -- $key {
                        "-fill" {
                            my color $value
                        }
                        "-tag" {
                            set tag $value
                        }
                    }
                }
                # Ignore the masking rectangles
                if { [string match "*mask*" $tag] ||
                     [string match "*titleback*" $tag] } {
                    return
                }
                # Accept the others
                append htmlcode "\nctx.fillRect($x1,$y1,$x2,$y2)"
            }
            "line" {
                set rest [lassign $args x1 y1 x2 y2]
                foreach {key value} $rest {
                    if { $key eq "-fill" } {
                        my color $value
                    }
                }
                append htmlcode  "\nctx.beginPath(); ctx.moveTo($x1,$y1); ctx.lineTo($x2,$y2); ctx.stroke();"
            }
        }
    }
}

set c [htmlCanvas create c c]
set c [string trim $c :]

set p [::Plotchart::createXYPlot $c {0 100 20} {0 0.301 0.05}]

$p dataconfig data -color cyan
$p title "A simple parabola" ;# This gives a slight problem ...
$p xtext "X"
$p vtext "Y"

for {set x 0} {$x < 100} {incr x 5} {
    $p plot data $x [expr {($x/100.0) * (1.0 - $x/100.0)}]
}

puts [$c emit]