# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*- # -- Tcl Module # @@ Meta Begin # Package zincText 1.0 # Meta as::author {Patrick Lecoanet} # Meta as::build::date 2009-03-31 # Meta as::origin http://www.tkzinc.org/tkzinc/index.php # Meta category Widget Canvas GUI # Meta description The Tkzinc widgets support structured graphics, # Meta description making them very similar to Tk Canvases. Like the # Meta description latter they implement items to display graphical # Meta description entities. They can be manipulated and bindings can # Meta description be added to them set up interactions. However unlike # Meta description the Canvas, TkZinc is able add further structure, by # Meta description placing the items into a hierarchy (via group # Meta description items), supports affine 2D transforms (i.e. # Meta description translation, scaling, and rotation), and allows # Meta description clipping to be set on sub-trees of the item # Meta description hierarchy. Beyond that the item set is extended as # Meta description well. It includes, for example, field specific items # Meta description for Air Traffic systems and supports new rendering # Meta description techniques such as transparency and gradients. At # Meta description last a C api is exported which enables users to # Meta description extend the item set via additional dynamic # Meta description libraries, should this be needed. # Meta license LGPL # Meta platform tcl # Meta require {Tk 8.4} # Meta require {Tcl 8.4} # Meta subject canvas hierarchy group gradient transparency # Meta subject clipping {air traffic} affine translation rotation # Meta subject scaling # Meta summary An enhanced canvas widget # @@ Meta End # ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS package require Tk 8.4 package require Tcl 8.4 # ACTIVESTATE TEAPOT-PKG END REQUIREMENTS # ACTIVESTATE TEAPOT-PKG BEGIN DECLARE package provide zincText 1.0 # ACTIVESTATE TEAPOT-PKG END DECLARE # ACTIVESTATE TEAPOT-PKG END TM # # ZincText - Zinc extension for text input on text items and fields # # $Id: zincText.tcl,v 1.7 2005/04/27 08:01:40 lecoanet Exp $ # # AUTHOR # # Patrick Lecoanet # (and documentation by Christophe Mertz ) # # Copyright (c) 2002 - 2003 CENA, Patrick Lecoanet # # See the file "Copyright" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # # SYNOPSIS # # package require zincText; # # zn_TextBindings $zinc # # $zinc addtag text withtag $a_text # $zinc addtag text withtag $a_track # $zinc addtag text withtag $a_waypoint # $zinc addtag text withtag $a_tabular # # # DESCRIPTION # # This module implements text input with the mouse and keyboard 'a la emacs'. # Text items must have the 'text' tag and must of course be sensitive. # Track, waypoint and tabular items have fields and these fields can # be edited the same way. Only sensitive fields can be edited. the following # interactions are supported: # # To set the cursor position # To paste the current selection # To make a selection # To extend the current selection # To extend the current selection # , # To move the cursor to the left or to the right # , # To move the cursor up or down a line # , # To move the cursor at the begining of the line # # To move the cursor at the end of the line # , # > To move the cursor at the beginning / end of the text # # To delete the char just before the cursor # To delete the char just after the cursor # To insert a return char. This does not validate the input! # # proc zn_TextBindings {zinc} { $zinc bind text <1> "startSel $zinc %x %y" $zinc bind text <2> "pasteSel $zinc %x %y" $zinc bind text "extendSel $zinc %x %y" $zinc bind text "extendSel $zinc %x %y" $zinc bind text "$zinc select adjust current @%x,%y" $zinc bind text "moveCur $zinc -1" $zinc bind text "moveCur $zinc 1" $zinc bind text "setCur $zinc up" $zinc bind text "setCur $zinc down" $zinc bind text "setCur $zinc bol" $zinc bind text "setCur $zinc bol" $zinc bind text "setCur $zinc eol" $zinc bind text "setCur $zinc eol" $zinc bind text "setCur $zinc 0" $zinc bind text "setCur $zinc end" $zinc bind text "insertKey $zinc %A" $zinc bind text "insertKey $zinc %A" $zinc bind text "insertChar $zinc \\n" $zinc bind text "textDel $zinc -1" $zinc bind text "textDel $zinc -1" $zinc bind text "textDel $zinc 0" } proc pasteSel {w x y} { set item [$w focus] if {[llength $item] != 0} { catch {$w insert [lindex $item 0] [lindex $item 1] @$x,$y [selection get]} } } proc insertChar {w c} { set item [$w focus] set selItem [$w select item] if {[llength $item] == 0} { return; } if {([llength $selItem]!= 0) && ([lindex $selItem 0] == [lindex $item 0]) && ([lindex $selItem 1] == [lindex $item 1])} { $w dchars [lindex $item 0] [lindex $item 1] sel.first sel.last } $w insert [lindex $item 0] [lindex $item 1] insert $c } proc insertKey {w c} { if {! [binary scan $c {c} code]} { return } set code [expr $code & 0xFF] if {($code < 32) || ($code == 128)} { puts "rejet $code" return } insertChar $w $c } proc setCur {w where} { set item [$w focus] if {[llength $item] != 0} { $w cursor [lindex $item 0] [lindex $item 1] $where } } proc moveCur {w dir} { set item [$w focus] if {[llength $item] != 0} { set index [$w index [lindex $item 0] [lindex $item 1] insert] $w cursor [lindex $item 0] [lindex $item 1] [expr $index + $dir] } } proc startSel {w x y} { set part [$w currentpart t] $w cursor current $part @$x,$y $w focus current $part focus $w $w select from current $part @$x,$y } proc extendSel {w x y} { set part [$w currentpart t] $w select to current $part @$x,$y } proc textDel {w dir} { set item [$w focus] set selItem [$w select item] if {[llength $item] == 0} { return; } if {([llength $selItem] != 0) && ([lindex $selItem 0] == [lindex $item 0]) && ([lindex $selItem 1] == [lindex $item 1])} { $w dchars [lindex $item 0] [lindex $item 1] sel.first sel.last } else { set ind [expr [$w index [lindex $item 0] [lindex $item 1] insert] + $dir] if { $ind >= 0 } { $w dchars [lindex $item 0] [lindex $item 1] $ind $ind } } } package provide zincText 1.0