aboutsummaryrefslogtreecommitdiff
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/pkgIndex.tcl13
-rw-r--r--library/zincGraphics.tcl1322
-rw-r--r--library/zincLogo.tcl107
-rw-r--r--library/zincText.tcl191
4 files changed, 0 insertions, 1633 deletions
diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl
deleted file mode 100644
index fed6d76..0000000
--- a/library/pkgIndex.tcl
+++ /dev/null
@@ -1,13 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded zincText 1.0 [list source [file join $dir zincText.tcl]]
-package ifneeded zincLogo 1.0 [list source [file join $dir zincLogo.tcl]]
-package ifneeded zincGraphics 1.0 [list source [file join $dir zincGraphics.tcl]]
diff --git a/library/zincGraphics.tcl b/library/zincGraphics.tcl
deleted file mode 100644
index 10f6a27..0000000
--- a/library/zincGraphics.tcl
+++ /dev/null
@@ -1,1322 +0,0 @@
-#
-#-----------------------------------------------------------------------------------
-#
-# Graphics.tcl
-# some graphic design functions
-#
-#-----------------------------------------------------------------------------------
-# Functions to create complexe graphic component :
-# ------------------------------------------------
-# BuildZincItem (realize a zinc item from description hash table)
-#
-# Function to compute complexe geometrical forms :
-# (text header of functions explain options for each form,
-# function return curve coords using control points of cubic curve)
-# -----------------------------------------------------------------
-# RoundedRectangleCoords (return curve coords of rounded rectangle)
-# HippodromeCoords (return curve coords of circus form)
-# PolygonCoords (return curve coords of regular polygon)
-# RoundedCurveCoords (return curve coords of rounded curve)
-# PolylineCoords (return curve coords of polyline)
-# TabBoxCoords (return curve coords of tabBox's pages)
-# PathLineCoords (return triangles coords of pathline)
-#
-# Geometrical basic Functions :
-# -----------------------------
-# PerpendicularPoint
-# LineAngle
-# VertexAngle
-# ArcPts
-# RadPoint
-#
-# Pictorial Functions :
-# ----------------------
-# SetGradients
-# GetPattern
-# GetTexture
-# GetImage
-# InitPixmaps
-# HexaRGBcolor
-# CreateGraduate
-#
-#-----------------------------------------------------------------------------------
-# Authors: Jean-Luc Vinot <vinot@cena.fr>
-# Patrick Lecoanet <lecoanet@cena.fr> (Straight translation
-# to Tcl, based on Graphics.pm revision 1.9)
-# $Id:
-#-----------------------------------------------------------------------------------
-
-namespace eval ::zincGraphics {
-
- package provide zincGraphics 1.0
-
- namespace export BuildZincItem RoundedRectangleCoords HippodromeCoords \
- PolygonCoords RoundedCurveCoords PolylineCoords TabBoxCoords PathLineCoords \
- PerpendicularPoint SetGradients GetPattern GetTexture GetImage InitPixmaps \
- HexaRGBcolor CreateGraduate
-
- namespace eval v {
- # constante facteur point directeur
- variable constPtdFactor 0.5523
- variable Gradients {}
- variable textures {}
- variable images {}
- variable bitmaps {}
- variable pi 3.14159
- }
-
- if { ![info exists zinc_library] } {
- set zinc_library [file dirname [info script]]
- }
-
- set imagePath [file join $zinc_library .. demos images]
-
- proc deg2rad {angle} {
- return [expr {$angle * $v::pi / 180.0}]
- }
-
- proc TLGet {list tag {default ""}} {
- foreach {key val} $list {
- if { [string compare $key $tag] == 0 } {
- return $val
- }
- }
- return $default
- }
-
- #proc TLGet {assoc tag {default ""}} {
- # array set temp $assoc
- # if { [info exists temp($tag)] } {
- # return $temp($tag)
- # }
- # return $default
- #}
-
- proc PointX {point} {
- return [lindex $point 0]
- }
-
- proc PointY {point} {
- return [lindex $point 1]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::BuildZincItem
- # Création d'un objet Zinc de représentation
- # paramètres :
- # widget : <widget>
- # parentGroup : <group>
- # style : {hash table options}
- # specificTags : [list of specific tags] to add to params -tags
- # name : <str> nom de l'item
- #-----------------------------------------------------------------------------------
- # type d'item valide :
- # les items natifs zinc : group, rectangle, arc, curve, text, icon
- # les items ci-après permettent de spécifier des curves 'particulières' :
- # -roundedrectangle : rectangle à coin arrondi
- # -hippodrome : hippodrome
- # -polygone : polygone régulier à n cotés (convexe ou en étoile)
- # -roundedcurve : curve multicontours à coins arrondis (rayon unique)
- # -polyline : curve multicontours à coins arrondis (le rayon pouvant être défini
- # spécifiquement pour chaque sommet)
- # -pathline : création d'une ligne 'épaisse' avec l'item Zinc triangles
- # décalage par rapport à un chemin donné (largeur et sens de décalage)
- # dégradé de couleurs de la ligne (linéaire, transversal ou double)
- #-----------------------------------------------------------------------------------
- proc BuildZincItem {zinc parentGroup styleTL specificTags name} {
- array set style $styleTL
- if { [info exists style(-params)] } {
- array set params $style(-params)
- }
-
- if { ! $parentGroup } {
- set parentGroup 1
- }
-
- if { [llength $specificTags] } {
- if { [info exists params(-tags)] } {
- set params(-tags) [concat $specificTags $params(-tags)]
- } else {
- set params(-tags) $specificTags
- }
- }
-
- set itemType $style(-itemtype)
- set coords {}
- if { [info exists style(-coords)] } {
- set coords $style(-coords)
- }
- # gestion des polygones particuliers et à coin arrondi
- switch -- $itemType {
- roundedrectangle {
- set itemType curve
- set params(-closed) 1
- set coords [RoundedRectangleCoords $coords $styleTL]
- }
- hippodrome {
- set itemType curve
- set params(-closed) 1
- set coords [HippodromeCoords $coords $styleTL]
- }
- polygone {
- set itemType curve
- set params(-closed) 1
- set coords [PolygonCoords $coords $styleTL]
- }
- roundedcurve -
- polyline {
- set itemType curve
- if { $itemType eq "roundedcurve" } {
- set params(-closed) 1
- set coords [RoundedCurveCoords $coords $styleTL]
- } else {
- set coords [PolylineCoords $coords $styleTL]
- }
- #
- # multi-contours
- if { [info exists style(-contours)] } {
- set contours $style(-contours)
- set numContours [llength $contours]
- for {set i 0} {$i < $numContours} {incr i} {
- # radius et corners peuvent être défini spécifiquement
- # pour chaque contour
- foreach {type way inCoords radius corners cornersRadius} \
- [lindex $contours $i] break
-
- if { $radius eq "" } {
- set radius $style(-radius)
- }
- if { $itemType eq "roundedcurve" } {
- set newCoords [RoundedCurveCoords $inCoords [list -radius $radius \
- -corners $corners]]
- } else {
- set newCoords [PolylineCoords $inCoords \
- [list -radius $radius -corners $corners \
- -cornersradius $cornersRadius]]
- }
- lset style(-contours) $i [list $type $way $newCoords]
- }
- }
- }
- pathline {
- set itemType triangles
- if { [info exists style(-metacoords)] } {
- set coords [MetaCoords $style(-metacoords)]
- }
-
- if { [info exists style(-graduate)] } {
- set numColors [llength $coords]
- set params(-colors) [PathGraduate $numColors $style(-graduate)]
- }
- set coords [PathLineCoords $coords $styleTL]
- }
- }
-
- switch -- $itemType {
- group {
- set item [eval {$zinc add $itemType $parentGroup} [array get params]]
- if { [llength $coords] } {
- $zinc coords $item $coords
- }
-
- }
- text -
- icon {
- set imageFile ""
- if { $itemType eq "icon" } {
- set imageFile $params(-image)
- if { $imageFile ne "" } {
- set params(-image) [InitPixmap $imageFile]
- }
- }
-
- set item [eval {$zinc add $itemType $parentGroup -position $coords} [array get params]]
- if { $imageFile ne "" } {
- set params(-image) $imageFile
- }
- }
- default {
- set item [eval {$zinc add $itemType $parentGroup $coords} [array get params]]
- if { $itemType eq "curve" && [info exists style(-contours)] } {
- foreach contour $style(-contours) {
- eval $zinc contour $item $contour
- }
- }
-
- # gestion du mode norender
- if { [info exists style(-texture)] } {
- set texture [GetTexture $style(-texture)]
- if { $texture ne "" } {
- $zinc itemconfigure $item -tile $texture
- }
- }
-
- if { [info exists style(-fillpattern)] } {
- set bitmap [GetBitmap $style(-fillpattern)]
- if { $bitmap ne "" } {
- $zinc itemconfigure $item -fillpattern $bitmap
- }
- }
- }
- }
-
- # transformation scale de l'item si nécessaire
- if { [info exists style(-scale)] } {
- $zinc scale $item $style(-scale)
- }
-
- # transformation rotate de l'item si nécessaire
- if { [info exists style(-rotate)] } {
- $zinc rotate $item [deg2rad $style(-rotate)]
- }
- # transformation scale de l'item si nécessaire
- if { [info exists style(-translate)] } {
- $zinc translate $item $style(-translate)
- }
-
- return $item
- }
-
- #-----------------------------------------------------------------------------------
- # FONCTIONS GEOMETRIQUES
- #-----------------------------------------------------------------------------------
-
- #-----------------------------------------------------------------------------------
- # Graphics::MetaCoords
- # retourne une liste de coordonnées en utilisant la fonction d'un autre type d'item
- # paramètres : (options)
- # -type : type de primitive utilisée
- # -coords : coordonnées nécessitée par la fonction [type]Coords
- # + options spécialisées passés à la fonction [type]Coords
- #-----------------------------------------------------------------------------------
- proc MetaCoords {options} {
- set pts {}
- set type [TLGet $options -type]
- set coords [TLGet $options -coords]
-
- switch -- $type {
- polygone {
- set pts [PolygonCoords $coords $options]
- }
- hippodrome {
- set pts [HippodromeCoords $coords $options]
- }
- polyline {
- set pts [PolylineCoords $coords $options]
- }
- }
-
- return $pts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RoundedRectangleCoords
- # calcul des coords du rectangle à coins arrondis
- # paramètres :
- # coords : point centre du polygone
- # options :
- # -radius : rayon de raccord d'angle
- # -corners : liste des raccords de sommets [0 (aucun raccord)|1] par défaut [1,1,1,1]
- #-----------------------------------------------------------------------------------
- proc RoundedRectangleCoords {coords optionsTL} {
- foreach {p0 p1} $coords break
- foreach {x0 y0} $p0 break
- foreach {xn yn} $p1 break
-
- set radius [TLGet $optionsTL -radius]
- set corners [TLGet $optionsTL -corners]
- if { [llength $corners] == 0 } {
- set corners [list 1 1 1 1]
- }
-
- # attention aux formes 'négatives'
- if { $xn < $x0 } {
- set xs $x0
- set x0 $xn
- set xn $xs
- }
- if { $yn < $y0 } {
- set ys $y0
- set y0 $yn
- set yn $ys
- }
-
- set height [_min [expr {$xn - $x0}] [expr {$yn - $y0}]]
-
- if { $radius eq "" } {
- set radius [expr {int($height/10.0)}]
- if { $radius < 3 } {
- set radius 3
- }
- }
-
- if { $radius < 2 } {
- return [list [list $x0 $y0] [list $x0 $yn] \
- [list $xn $yn] [list $xn $y0]]
- }
-
-
- # correction de radius si necessaire
- set maxRad $height
- if { $corners eq "" } {
- set maxRad [expr {$maxRad / 2.0}]
- }
- if { $radius > $maxRad } {
- set radius $maxRad
- }
-
- # points remarquables
- set ptdDelta [expr {$radius * $v::constPtdFactor}]
- set x2 [expr {$x0 + $radius}]
- set x3 [expr {$xn - $radius}]
- set x1 [expr {$x2 - $ptdDelta}]
- set x4 [expr {$x3 + $ptdDelta}]
- set y2 [expr {$y0 + $radius}]
- set y3 [expr {$yn - $radius}]
- set y1 [expr {$y2 - $ptdDelta}]
- set y4 [expr {$y3 + $ptdDelta}]
-
- # liste des 4 points sommet du rectangle : angles sans raccord circulaire
- set anglePts [list [list $x0 $y0] [list $x0 $yn] \
- [list $xn $yn] [list $xn $y0]]
-
- # liste des 4 segments quadratique : raccord d'angle = radius
- set roundeds [list \
- [list [list $x2 $y0] [list $x1 $y0 c] \
- [list $x0 $y1 c] [list $x0 $y2]] \
- [list [list $x0 $y3] [list $x0 $y4 c] \
- [list $x1 $yn c] [list $x2 $yn]] \
- [list [list $x3 $yn] [list $x4 $yn c] \
- [list $xn $y4 c] [list $xn $y3]] \
- [list [list $xn $y2] [list $xn $y1 c] \
- [list $x4 $y0 c] [list $x3 $y0]]]
-
- set pts [list]
- set previous 0
- foreach seg $roundeds aPt $anglePts corner $corners {
- set px 0
- set py 0
- if { $corner } {
- # on teste si non duplication de point
- foreach {nx ny} [lindex $seg 0] break
- if { $previous && ($px == $nx && $py == $ny) } {
- eval lappend pts [lrange $seg 1 end]
- } else {
- eval lappend pts $seg
- }
- foreach {px py} [lindex $seg 3] break
- set previous 1
- } else {
- lappend pts $aPt
- }
- }
- return $pts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::HippodromeCoords
- # calcul des coords d'un hippodrome
- # paramètres :
- # coords : coordonnées du rectangle exinscrit
- # options :
- # -orientation : orientation forcée de l'ippodrome [horizontal|vertical]
- # -corners : liste des raccords de sommets [0|1] par défaut [1,1,1,1]
- # -trunc : troncatures [left|right|top|bottom|both]
- #-----------------------------------------------------------------------------------
- proc HippodromeCoords {coords optionsTL} {
- foreach {p0 p1} $coords break
- foreach {x0 y0} $p0 break
- foreach {xn yn} $p1 break
-
- set orientation [TLGet $optionsTL -orientation none]
-
- # orientation forcée de l'hippodrome (sinon hippodrome sur le plus petit coté)
- switch -- $orientation {
- horizontal { set height [expr {abs($yn - $y0)}] }
- vertical { set height [expr {abs($xn - $x0)}] }
- default { set height [_min [expr {abs($xn - $x0)}] [expr {abs($yn - $y0)}]] }
- }
-
- set radius [expr {$height/2.0}]
-
- set corners [TLGet $optionsTL -corners]
- set trunc [TLGet $optionsTL -trunc]
- if { [llength $corners] == 0 } {
- switch -- $trunc {
- both { return [list [list $x0 $y0] [list $x0 $yn] \
- [list $xn $yn] [list $xn $y0]] }
- left { set corners [list 0 0 1 1] }
- right { set corners [list 1 1 0 0] }
- top { set corners [list 0 1 1 0] }
- bottom { set corners [list 1 0 0 1] }
- default { set corners [list 1 1 1 1] }
- }
- }
-
- # l'hippodrome est un cas particulier de roundedRectangle
- # on retourne en passant la 'configuration' à la fonction
- # générique roundedRectangleCoords
- return [RoundedRectangleCoords $coords [list -radius [expr {$height/2.0}] -corners $corners]]
- }
-
-
- #-----------------------------------------------------------------------------------
- # Graphics::PolygonCoords
- # calcul des coords d'un polygone régulier
- # paramètres :
- # coords : point centre du polygone
- # options :
- # -numsides : nombre de cotés
- # -radius : rayon de définition du polygone (distance centre-sommets)
- # -innerradius : rayon interne (polygone type étoile)
- # -corners : liste des raccords de sommets [0|1] par défaut [1,1,1,1]
- # -cornerradius : rayon de raccord des cotés
- # -startangle : angle de départ du polygone
- #-----------------------------------------------------------------------------------
- proc PolygonCoords {coords optionsTL} {
- set numSides [TLGet $optionsTL -numsides 0]
- set radius [TLGet $optionsTL -radius 0]
- if { $numSides < 3 || !$radius } {
- puts "Vous devez au moins spécifier un nombre de cotés >= 3 et un rayon..."
- return {};
- }
-
- if { [llength $coords] } {
- foreach {cx cy} $coords break
- } else {
- set cx 0
- set cy 0
- }
-
- set startAngle [TLGet $optionsTL -startangle 0]
- set angleStep [expr {360.0/$numSides}]
- set innerRadius [TLGet $optionsTL -innerradius 0]
- set pts [list]
-
- # points du polygone
- for {set i 0} {$i < $numSides} {incr i} {
- set p [RadPoint $cx $cy $radius [expr {$startAngle + ($angleStep*$i)}]]
- lappend pts $p
-
- # polygones 'étoiles'
- if { $innerRadius } {
- set p [RadPoint $cx $cy $innerRadius [expr {$startAngle + ($angleStep*($i+ 0.5))}]]
- lappend pts $p
- }
- }
-
- set cornerRadius [TLGet $optionsTL -cornerradius {}]
- if { $cornerRadius ne "" } {
- set pts [RoundedCurveCoords $pts [list -radius $cornerRadius -corners \
- [TLGet $optionsTL -corners {}]]]
- }
- return $pts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RoundedAngle
- # THIS FUNCTION IS NO MORE USED, NEITHER EXPORTED
- # curve d'angle avec raccord circulaire
- # paramètres :
- # zinc : widget
- # parentGroup : group zinc parent
- # coords : les 3 points de l'angle
- # radius : rayon de raccord
- #-----------------------------------------------------------------------------------
- proc RoundedAngle {zinc parentGroup coords radius} {
- foreach {pt0 pt1 pt2} $coords break
-
- foreach {cornerPts centerPts} [RoundedAngleCoords $coords $radius] break
- foreach {cx0 cy0} $centerPts break
-
- # valeur d'angle et angle formé par la bisectrice
- # set angle [VertexAngle $pt0 $pt1 $pt2]
-
- if { $parentGroup eq "" } {
- set parentGroup 1
- }
-
- set cornerPts [linsert $cornerPts 0 $pt0]
- lappend cornerPts $pt2
- $zinc add curve $parentGroup $cornerPts -closed 0 -linewidth 1 -priority 20
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RoundedAngleCoords
- # calcul des coords d'un raccord d'angle circulaire
- #-----------------------------------------------------------------------------------
- # le raccord circulaire de 2 droites sécantes est traditionnellement réalisé par un
- # arc (conique) du cercle inscrit de rayon radius tangent à ces 2 droites
- #
- # Quadratique :
- # une approche de cette courbe peut être réalisée simplement par le calcul de 4 points
- # spécifiques qui définiront - quelle que soit la valeur de l'angle formé par les 2
- # droites - le segment de raccord :
- # - les 2 points de tangence au cercle inscrit seront les points de début et de fin
- # du segment de raccord
- # - les 2 points de controle seront situés chacun sur le vecteur reliant le point de
- # tangence au sommet de l'angle (point secant des 2 droites)
- # leur position sur ce vecteur peut être simplifiée comme suit :
- # - à un facteur de 0.5523 de la distance au sommet pour un angle >= 90° et <= 270°
- # - à une 'réduction' de ce point vers le point de tangence pour les angles limites
- # de 90° vers 0° et de 270° vers 360°
- # ce facteur sera légérement modulé pour recouvrir plus précisement l'arc correspondant
- #-----------------------------------------------------------------------------------
- proc RoundedAngleCoords {coords radius} {
- foreach {pt0 pt1 pt2} $coords break
- foreach {pt1x pt1y} $pt1 break
-
- # valeur d'angle et angle formé par la bisectrice
- foreach {angle bisecAngle} [VertexAngle $pt0 $pt1 $pt2] break
-
- # distance au centre du cercle inscrit : rayon/sinus demi-angle
- set sin [expr {sin([deg2rad $angle] / 2.0)}]
- set delta [expr {$sin ? abs($radius / $sin) : $radius}]
-
- # point centre du cercle inscrit de rayon $radius
- set refAngle [expr {($angle < 180) ? $bisecAngle+90 : $bisecAngle-90}]
- set c0 [RadPoint $pt1x $pt1y $delta $refAngle]
-
- # points de tangeance : pts perpendiculaires du centre aux 2 droites
- set p1 [PerpendicularPoint $c0 [list $pt0 $pt1]]
- set p2 [PerpendicularPoint $c0 [list $pt1 $pt2]]
- foreach {p1x p1y} $p1 break
- foreach {p2x p2y} $p2 break
-
- # point de controle de la quadratique
- # facteur de positionnement sur le vecteur pt.tangence, sommet
- set ptdFactor $v::constPtdFactor
- if { $angle < 90 || $angle > 270 } {
- set diffAngle [expr {($angle < 90) ? $angle : 360 - $angle}]
- if { $diffAngle > 15 } {
- set ptdFactor [expr {$ptdFactor - (((90.0 - $diffAngle)/90.0) * ($ptdFactor/4.0))}]
- }
- set ptdFactor [expr {($diffAngle/90.0) * \
- ($ptdFactor + ((1.0 - $ptdFactor) * (90.0 - $diffAngle)/90.0))}]
- } else {
- set diffAngle [expr {abs(180.0 - $angle)}]
- if { $diffAngle > 15 } {
- set ptdFactor [expr {$ptdFactor + (((90.0 - $diffAngle)/90.0) * ($ptdFactor/3.0))}]
- }
- }
-
- # delta xy aux pts de tangence
- set d1x [expr {($pt1x - $p1x) * $ptdFactor}]
- set d1y [expr {($pt1y - $p1y) * $ptdFactor}]
- set d2x [expr {($pt1x - $p2x) * $ptdFactor}]
- set d2y [expr {($pt1y - $p2y) * $ptdFactor}]
-
- # les 4 points de l'arc 'quadratique' et le centre du cercle inscrit
- set cornerPts [list $p1 \
- [list [expr {$p1x + $d1x}] [expr {$p1y + $d1y}] c] \
- [list [expr {$p2x + $d2x}] [expr {$p2y + $d2y}] c] \
- $p2]
-
- return [list $cornerPts $c0]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RoundedCurveCoords
- # retourne les coordonnées d'une curve à coins arrondis
- # paramètres :
- # coords : points de la curve
- # options :
- # -radius : rayon de raccord d'angle
- # -corners : liste des raccords de sommets [0|1] par défaut [1,1,1,1]
- #-----------------------------------------------------------------------------------
- proc RoundedCurveCoords {coords options} {
- set numFaces [llength $coords]
- set curvePts {}
- set radius [TLGet $options -radius 0]
- set corners [TLGet $options -corners {}]
-
- for {set index 0} {$index < $numFaces} {incr index} {
- if { ([llength $corners] > $index) && ([lindex $corners $index] == 0) } {
- lappend curvePts [lindex $coords $index]
- } else {
- set prev [expr {$index ? $index - 1 : $numFaces - 1}]
- set next [expr {($index > $numFaces - 2) ? 0 : $index + 1}]
- set angleCoords [list [lindex $coords $prev] \
- [lindex $coords $index] \
- [lindex $coords $next]]
- foreach {quadPts centerPts} [RoundedAngleCoords $angleCoords $radius] break
- set curvePts [concat $curvePts $quadPts]
- }
- }
- return $curvePts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::PolylineCoords
- # retourne les coordonnées d'une polyline
- # paramètres :
- # coords : sommets de la polyline
- # options :
- # -radius : rayon global de raccord d'angle
- # -corners : liste des raccords de sommets [0|1] par défaut [1,1,1,1],
- # -cornersradius : liste des rayons de raccords de sommets
- #-----------------------------------------------------------------------------------
- proc PolylineCoords {coords options} {
- set numFaces [llength $coords]
- set curvePts {}
-
- set radius [TLGet $options -radius 0]
- set cornersRadius [TLGet $options -cornersradius]
-
- if { [llength $cornersRadius] } {
- set corners $cornersRadius
- } else {
- set corners [TLGet $options -corners]
- }
-
- set numCorners [llength $corners]
- for {set index 0} {$index < $numFaces} {incr index} {
- if { $numCorners && (($index >= $numCorners) || ![lindex $corners $index]) } {
- foreach {x y} [lindex $coords $index] { lappend curvePts [list $x $y] }
- } else {
- set prev [expr {$index ? $index - 1 : $numFaces - 1}]
- set next [expr {($index > $numFaces - 2) ? 0 : $index + 1}]
- set angleCoords [list [lindex $coords $prev] [lindex $coords $index] \
- [lindex $coords $next]]
-
- if { [llength $cornersRadius] } {
- set rad [lindex $cornersRadius $index]
- } else {
- set rad $radius
- }
- foreach {cornerPts centerPts} [RoundedAngleCoords $angleCoords $rad] break
- set curvePts [concat $curvePts $cornerPts]
- }
- }
-
- return $curvePts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::PathLineCoords
- # retourne les coordonnées d'une pathLine
- # paramètres :
- # coords : points de path
- # options :
- # -closed : ligne fermée
- # -shifting : sens de décalage [both|left|right] par défaut both
- # -linewidth : epaisseur de la ligne
- #-----------------------------------------------------------------------------------
- proc PathLineCoords {coords options} {
- set numFaces [llength $coords]
- set pts {}
-
- set closed [TLGet $options -closed]
- set lineWidth [TLGet $options -linewidth 0]
- set shifting [TLGet $options -shifting both]
-
- if { ! $numFaces || $lineWidth < 2 } {
- return {}
- }
-
- set previous {}
- if { $closed } {
- set previous [lindex $coords [expr $numFaces - 1]]
- }
- set next [lindex $coords 1]
- if { $shifting eq "both" } {
- set lineWidth [expr {$lineWidth / 2.0}]
- }
-
- for {set i 0} {$i < $numFaces} {incr i} {
- set pt [lindex $coords $i]
- foreach {ptX ptY} $pt break
- foreach {nextX nextY} $next break
-
- if { [llength $previous] == 0 } {
- # extrémité de curve sans raccord -> angle plat
- set previous [list [expr {$ptX + ($ptX - $nextX)}] \
- [expr {$ptY + ($ptY - $nextY)}]]
- }
-
- foreach {angle bisecAngle} [VertexAngle $previous $pt $next] break
-
- # distance au centre du cercle inscrit : rayon/sinus demi-angle
- set sin [expr {sin([deg2rad [expr $angle/2.0]])}]
- set delta [expr {$sin ? abs($lineWidth / $sin) : $lineWidth}]
-
- if { $shifting eq "left" || $shifting eq "right" } {
- set adding [expr {($shifting eq "left") ? 90 : -90}]
- foreach {x y} [RadPoint $ptX $ptY $delta [expr {$bisecAngle + $adding}]] {
- lappend pts $x $y
- }
- lappend pts $ptX $ptY
-
- } else {
- foreach {x y} [RadPoint $ptX $ptY $delta [expr {$bisecAngle + 90}]] {
- lappend pts $x $y
- }
- foreach {x y} [RadPoint $ptX $ptY $delta [expr {$bisecAngle - 90}]] {
- lappend pts $x $y
- }
- }
-
- if { $i == [expr $numFaces - 2] } {
- if { $closed } {
- set next [lindex $coords 0]
- } else {
- set nextI [expr $i + 1]
- set next [list [expr {2 * [PointX [lindex $coords $nextI]] - [PointX $pt]}] \
- [expr {2 * [PointY [lindex $coords $nextI]] - [PointY $pt]}]]
- }
- } else {
- set next [lindex $coords [expr {$i + 2}]]
- }
- set previous [lindex $coords $i]
- }
-
- if { $closed } {
- lappend pts [lindex $pts 0] [lindex $pts 1] [lindex $pts 2] [lindex $pts 3]
- }
-
- return $pts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::PerpendicularPoint
- # retourne les coordonnées du point perpendiculaire abaissé d'un point sur une ligne
- #-----------------------------------------------------------------------------------
- proc PerpendicularPoint {point line} {
- foreach {x y} $point {p1 p2} $line break
- foreach {x1 y1} $p1 {x2 y2} $p2 break
-
- # cas particulier de lignes ortho.
- set minDist .01
- if { abs($y2 - $y1) < $minDist } {
- # la ligne de référence est horizontale
- return [list $x $y1]
- } elseif { abs($x2 - $x1) < $minDist } {
- # la ligne de référence est verticale
- return [list $x1 $y]
- }
-
- set a1 [expr {double($y2 - $y1) / double($x2 - $x1)}]
- set b1 [expr {$y1 - $a1 * $x1}]
-
- set a2 [expr {-1.0 / $a1}]
- set b2 [expr {$y - $a2 * $x}]
-
- set xRet [expr {double($b2 - $b1) / double($a1 - $a2)}]
- set yRet [expr {$a1 * $xRet + $b1}]
-
- return [list $xRet $yRet]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::LineAngle
- # retourne l'angle d'un point par rapport à un centre de référence
- #-----------------------------------------------------------------------------------
- proc LineAngle {p center} {
- foreach {x y} $p {xref yref} $center break
- set angle [expr {(atan2($y - $yref, $x - $xref) + $v::pi/2.0) * 180.0 / $v::pi}]
- if { $angle < 0 } {
- set angle [expr {$angle + 360}]
- }
- return $angle
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::VertexAngle
- # retourne la valeur de l'angle formée par 3 points
- # ainsi que l'angle de la bisectrice
- #-----------------------------------------------------------------------------------
- proc VertexAngle {pt0 pt1 pt2} {
- set angle1 [LineAngle $pt1 $pt0]
- set angle2 [LineAngle $pt1 $pt2]
-
- if { $angle2 < $angle1 } {
- set angle2 [expr $angle2 + 360]
- }
- set alpha [expr {$angle2 - $angle1}]
- set bisectrice [expr {$angle1 + ($alpha/2.0)}]
-
- return [list $alpha $bisectrice]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::ArcPts
- # calcul des points constitutif d'un arc
- # params : x,y centre, rayon, angle départ, delta angulaire, pas en degré
- #-----------------------------------------------------------------------------------
- proc ArcPts {x y rad angle extent step debug} {
- set pts {}
-
- if { $extent > 0 } {
- for {set alpha $angle} {$alpha <= ($angle + $extent)} {incr $alpha $step} {
- foreach {xn yn} [RadPoint $x $y $rad $alpha] {}
- lappend pts $xn $yn
- }
- } else {
- for {set alpha $angle} {$alpha >= ($angle + $extent)} {incr $alpha $step} {
- lappend pts [RadPoint $x $y $rad $alpha]
- }
- }
- return $pts
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RadPoint
- # retourne le point circulaire défini par centre-rayon-angle
- #-----------------------------------------------------------------------------------
- proc RadPoint {x y rad angle} {
- set alpha [deg2rad $angle]
-
- set xpt [expr {$x + ($rad * cos($alpha))}]
- set ypt [expr {$y + ($rad * sin($alpha))}]
-
- return [list $xpt $ypt]
- }
-
-
- #-----------------------------------------------------------------------------------
- # TabBoxCoords
- # Calcul des shapes de boites à onglets
- #
- # coords : coordonnées rectangle de la bounding box
- #
- # options
- # -numpages <n> : nombre de pages (onglets) de la boite
- # -anchor [n|e|s|w] : ancrage des onglets
- # -alignment [left|center|right] : alignement des onglets sur le coté d'ancrage
- # -tabwidth [<n>|[<n1>,<n2>,<n3>...]|auto] : largeur des onglets
- # -tabheight [<n>|auto] : hauteur des onglets
- # -tabshift <n> : décalage onglet
- # -radius <n> : rayon des arrondis d'angle
- # -overlap <n> : distance de recouvrement des onglets
- #-----------------------------------------------------------------------------------
- proc TabBoxCoords args {
- set coords [lindex $args 0]
- set options [lrange $args 1 end]
- foreach {p0 p1} $coords break
- foreach {x0 y0} $p0 {xn yn} $p1 break
- set numPages [TLGet $options -numpages 0]
-
- if { $x0 eq "" || $y0 eq "" || $xn eq "" || $yn eq "" || !$numPages } {
- puts "Vous devez au minimum spécifier le rectangle englobant et le nombre de pages"
- return {}
- }
-
- set anchor [TLGet $options -anchor n]
- set alignment [TLGet $options -alignment left]
- set len [TLGet $options -tabwidth auto]
- set thick [TLGet $options -tabheight auto]
- set biso [TLGet $options -tabshift auto]
- set radius [TLGet $options -radius 0]
- set overlap [TLGet $options -overlap 0]
- set orientation [expr {($anchor eq "n" || $anchor eq "s") ? "horizontal" : "vertical"}]
- set maxwidth [expr {($orientation eq "horizontal") ? ($xn - $x0) : ($yn - $y0)}]
- set tabswidth 0
- set align 1
-
- if { $len eq "auto" } {
- set tabswidth $maxwidth
- set len [expr {($tabswidth + ($overlap * ($numPages - 1)))/$numPages}]
- } else {
- if { [llength $len] > 1 } {
- foreach w $len {
- set tabswidth [expr {$tabswidth + ($w - $overlap)}]
- }
- set tabswidth [expr {$tabswidth + $overlap}]
- } else {
- set tabswidth [expr {($len * $numPages) - ($overlap * ($numPages - 1))}]
- }
- if { $tabswidth > $maxwidth } {
- set tabswidth $maxwidth
- set len [expr {($tabswidth + ($overlap * ($numPages - 1)))/$numPages}]
- }
- if { $alignment eq "center" && (($maxwidth - $tabswidth) > $radius) } {
- set align 0
- }
- }
- if { $thick eq "auto" } {
- set thick [expr {($orientation eq "horizontal") ? \
- int(($yn - $y0)/10.0) : int(($xn - $y0)/10.0)}]
- if {$thick < 10 } {
- set thick 10
- } elseif {$thick > 40} {
- set thick 40
- }
- }
- if { $biso eq "auto" } {
- set biso [expr {int($thick/2.0)}]
- }
- if { ($alignment eq "right" && $anchor ne "w") || \
- ($anchor eq "w" && $alignment ne "right") } {
- if { [llength $len] > 1 } {
- for {set p 0} {$p < $numPages} {incr p} {
- lset len $p [expr {-[lindex $len $p]}]
- }
- } else {
- set len [expr {-$len}]
- }
- set biso [expr {-$biso}]
- set overlap [expr {-$overlap}]
- }
-
- if { $alignment eq "center" } {
- set biso1 [expr {$biso / 2.0}]
- set biso2 $biso1
- } else {
- set biso1 0
- set biso2 $biso
- }
-
- if { $orientation eq "vertical" } {
- if { $anchor eq "w" } {
- set thick [expr {-$thick}]
- set startx $x0
- set endx $xn
- } else {
- set startx $xn
- set endx $x0
- }
- if { ($anchor eq "w" && $alignment ne "right") || \
- ($anchor eq "e" && $alignment eq "right") } {
- set starty $yn
- set endy $y0
- } else {
- set starty $y0
- set endy $yn
- }
-
- set xref [expr {$startx - $thick}]
- set yref $starty
- if { $alignment eq "center" } {
- set ratio [expr {($anchor eq "w") ? -2 : 2}]
- set yref [expr {$yref + (($maxwidth - $tabswidth)/$ratio)}]
- }
-
- set cadre [list [list $xref $endy] [list $endx $endy] \
- [list $endx $starty] [list $xref $starty]]
- #
- # flag de retournement de la liste des pts de
- # curve si nécessaire -> sens anti-horaire
- set inverse [expr {$alignment ne "right"}]
- } else {
- if { $anchor eq "s" } {
- set thick [expr {-$thick}]
- }
- if { $alignment eq "right" } {
- set startx $xn
- set endx $x0
- } else {
- set startx $x0
- set endx $xn
- }
- if { $anchor eq "s" } {
- set starty $yn
- set endy $y0
- } else {
- set starty $y0
- set endy $yn
- }
-
- set yref [expr {$starty + $thick}]
- if { $alignment eq "center" } {
- set xref [expr {$x0 + (($maxwidth - $tabswidth)/2.0)}]
- } else {
- set xref $startx
- }
-
- set cadre [list [list $endx $yref] [list $endx $endy] \
- [list $startx $endy] [list $startx $yref]]
- #
- # flag de retournement de la liste des pts de
- # curve si nécessaire -> sens anti-horaire
- set inverse [expr {($anchor eq "n" && $alignment ne "right") || \
- ($anchor eq "s" && $alignment eq "right")}]
- }
-
- for {set i 0} {$i < $numPages} {incr i} {
- set pts {}
- #
- # décrochage onglet
- #push (@pts, ([$xref, $yref])) if $i > 0;
- #
- # cadre
- set pts [lrange $cadre 0 end]
- #
- # points onglets
- if { $i > 0 || ! $align } {
- lappend pts [list $xref $yref]
- }
- set tw [expr {([llength $len] > 1) ? [lindex $len $i] : $len}]
- if { $orientation eq "vertical" } {
- set tabdxy [list $thick $biso1 $thick [expr {$tw - $biso2}] 0 $tw]
- } else {
- set tabdxy [list $biso1 [expr {-$thick}] [expr {$tw - $biso2}] [expr {-$thick}] $tw 0]
- }
- foreach {dx dy} $tabdxy {
- lappend pts [list [expr {$xref + $dx}] [expr {$yref + $dy}]]
- }
-
- if { $radius } {
- if { $i > 0 || ! $align } {
- set corners [list 0 1 1 1 0 1 1 0]
- } else {
- set corners [list 0 1 1 0 1 1 0 0 0]
- }
- set curvePts [RoundedCurveCoords $pts [list -radius $radius -corners $corners]]
- if { $inverse } {
- set curvePts [lreverse $curvePts]
- }
- lappend shapes $curvePts
- } else {
- if { $inverse } {
- set pts [lreverse $pts]
- }
- lappend shapes $pts
- }
-
- if { $orientation eq "horizontal" } {
- lappend titlesCoords [list [expr {$xref + ($tw - ($biso2 - $biso1))/2.0}] \
- [expr {$yref - ($thick/2.0)}]]
- set xref [expr {$xref + ($tw - $overlap)}]
- } else {
- lappend titlesCoords [list [expr {$xref + ($thick/2.0)}] \
- [expr {$yref + ($len - (($biso2 - $biso1)/2.0))/2.0}]]
- set yref [expr {$yref + ($len - $overlap)}]
- }
- }
-
- return [list $shapes $titlesCoords $inverse]
- }
-
- #-----------------------------------------------------------------------------------
- # RESOURCES GRAPHIQUES GRADIENTS, PATTERNS, TEXTURES, IMAGES...
- #-----------------------------------------------------------------------------------
- #-----------------------------------------------------------------------------------
- # Graphics::SetGradients
- # création de gradient nommés Zinc
- #-----------------------------------------------------------------------------------
- proc SetGradients {zinc grads} {
- # initialise les gradients de taches
- if { ! [llength $v::Gradients] } {
- foreach {name gradient} $grads {
- # création des gradients nommés
- $zinc gname $gradient $name
- lappend v::Gradients $name
- }
- }
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::GetPattern
- # retourne la ressource bitmap en l'initialisant si première utilisation
- #-----------------------------------------------------------------------------------
- proc GetPattern {name} {
- global bitmaps imagePath
-
- if { ![info exists bitmaps($name)] } {
- set bitmap "@[file join $imagePath $name]"
- set bitmaps($name) $bitmap
- return $bitmap
- }
- return $bitmaps($name)
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::GetTexture
- # retourne l'image de texture en l'initialisant si première utilisation
- #-----------------------------------------------------------------------------------
- proc GetTexture {name} {
- global imagePath
-
- if { ![info exists v::textures($name)] } {
- set texture [image create photo -file [file join $imagePath $name]]
- if { $texture ne "" } {
- set v::textures($name) $texture
- }
- return $texture
- }
- return $v::textures($name)
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::GetImage
- # retourne la ressource image en l'initialisant si première utilisation
- #-----------------------------------------------------------------------------------
- proc GetImage {name} {
- global imagePath
-
- if { ![info exists v::images($name)] } {
- set image [image create photo -file [file join $imagePath $name]]
- if { $image ne "" } {
- set v::images($name) $image
- }
- return $image
- }
- return $v::images($name)
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::InitPixmaps
- # initialise une liste de fichier image
- #-----------------------------------------------------------------------------------
- proc InitPixmaps {pixFiles} {
- set imgs {}
- foreach f $pixFiles {
- lappend imgs [GetImage $f]
- }
- return $imgs
- }
-
-
- proc _min {n1 n2} {
- return [expr {($n1 > $n2) ? $n2 : $n1}]
- }
-
- proc _max {n1 n2} {
- return [expr {($n1 > $n2) ? $n1 : $n2}]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::_trunc
- # fonction interne de troncature des nombres: n = position décimale
- #-----------------------------------------------------------------------------------
- proc _trunc {val n} {
- regexp {([0-9]+)\.?([0-9]*)} $val match ent dec
- set str [expr {($val < 0) ? -$ent : $ent}]
- if { ($dec ne "") && ($n != 0) } {
- set dec [string range $dec 0 [expr {$n-1}]]
- if { $dec != 0 } {
- set str "$str.$dec"
- }
- }
- return $str;
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::RGBdec2hex
- # conversion d'une couleur RGB (255,255,255) au format Zinc '#ffffff'
- #-----------------------------------------------------------------------------------
- proc RGBdec2hex {rgb} {
- return [eval "format {#%04x%04x%04x} $rgb"]
- }
-
- #-----------------------------------------------------------------------------------
- # zincGraphics::PathGraduate
- # création d'un jeu de couleurs dégradées pour item pathLine
- #-----------------------------------------------------------------------------------
- proc PathGraduate {numColors style} {
- set type [TLGet $style -type]
- set colors [TLGet $style -colors]
-
- if { $type eq "linear" } {
- return [CreateGraduate $numColors $colors 2]
-
- } elseif { $type eq "double" } {
- set colors1 [CreateGraduate [expr {$numColors/2+1}] [lindex $colors 0]]
- set colors2 [CreateGraduate [expr {$numColors/2+1}] [lindex $colors 1]]
- set clrs {}
- for {set i 0} {$i <= $numColors} {incr i} {
- lappend clrs [lindex $colors1 $i] [lindex $colors2 $i]
- }
- return $clrs
-
- } elseif { $type eq "transversal" } {
- foreach {c1 c2} $colors break
- set clrs [list $c1 $c2]
- for {set i 0} {$i < $numColors} {incr i} {
- lappend clrs $c1 $c2
- }
- return $clrs;
- }
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::CreateGraduate
- # création d'un jeu de couleurs intermédiaires (dégradé) entre n couleurs
- #-----------------------------------------------------------------------------------
- proc CreateGraduate {totalSteps refColors {repeat 1}} {
- set colors {}
- set numGraduates [expr {[llength $refColors] - 1}]
-
- if { $numGraduates < 1 } {
- puts "Le dégradé necessite au minimum 2 couleurs de référence..."
- return {}
- }
-
- set steps [expr {($numGraduates > 1) ? ($totalSteps/($numGraduates - 1.0)) : $totalSteps}]
-
- for {set c 0} {$c < $numGraduates} {incr c} {
- set c1 [lindex $refColors $c]
- set c2 [lindex $refColors [expr {$c+1}]]
-
- #
- # Pas de duplication de la couleur de raccord entre
- # deux segments
- set thisSteps $steps
- if { $c < [expr $numGraduates - 1] } {
- set thisSteps [expr $thisSteps - 1]
- }
- for {set i 0} {$i < $thisSteps} {incr i} {
- set color [ComputeColor $c1 $c2 [expr {$i/($steps-1.0)}]]
- for {set k 0} {$k < $repeat} {incr k} {
- lappend colors $color
- }
- }
- }
-
- return $colors
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::computeColor
- # calcul d'une couleur intermédiaire défini par un ratio ($ratio) entre 2 couleurs
- #-----------------------------------------------------------------------------------
- proc ComputeColor {color0 color1 ratio} {
- if { $ratio > 1.0 } {
- set ratio 1
- } elseif { $ratio < 0 } {
- set ratio 0
- }
-
- foreach {r0 g0 b0 a0} [ZnColorToRGB $color0] break
- foreach {r1 g1 b1 a1} [ZnColorToRGB $color1] break
-
- set r [expr {$r0 + int(($r1 - $r0) * $ratio)}]
- set g [expr {$g0 + int(($g1 - $g0) * $ratio)}]
- set b [expr {$b0 + int(($b1 - $b0) * $ratio)}]
- set a [expr {$a0 + int(($a1 - $a0) * $ratio)}]
- return [HexaRGBcolor $r $g $b $a]
- }
-
- proc ZnColorToRGB {znColor} {
- foreach {color alpha} [split $znColor ";"] break
- set pattern [expr {[string length $color] > 8 ? {#%4x%4x%4x} : {#%2x%2x%2x}}]
- scan $color $pattern r g b
-
- if {$alpha eq ""} {
- set alpha 100
- }
-
- return [list $r $g $b $alpha]
- }
-
- #-----------------------------------------------------------------------------------
- # Graphics::hexaRGBcolor
- # conversion d'une couleur RGB (255,255,255) au format Zinc '#ffffff'
- #-----------------------------------------------------------------------------------
- proc HexaRGBcolor {r g b args} {
- if { [llength $args] } {
- return [format {#%02x%02x%02x;%d} $r $g $b [lindex $args 0]]
- } else {
- return [format {#%02x%02x%02x} $r $g $b]
- }
- }
-}
-
-proc lreverse {l} {
- set res {}
- set i [llength $l]
- while {$i} {
- lappend res [lindex $l [incr i -1]]
- }
- return $res
-}
diff --git a/library/zincLogo.tcl b/library/zincLogo.tcl
deleted file mode 100644
index aeafb6f..0000000
--- a/library/zincLogo.tcl
+++ /dev/null
@@ -1,107 +0,0 @@
-#---------------------------------------------------------------
-# File : LogoZinc.pm
-#
-# Copyright (C) 2001-2002
-# Centre d'Études de la Navigation Aérienne
-# Authors: Vinot Jean-Luc <vinot@cena.fr>
-# $Id$
-#---------------------------------------------------------------
-
-package provide zincLogo 1.0
-
-namespace eval ::zincLogo:: {
-
- set letters(coords) {
- {0 0} {106 0} {106 58} {122 41} {156 41} {131 69}
- {153 99} {203 41} {155 41} {155 0} {218 0} {240 0 c}
- {252 17 c} {252 34} {252 40 c} {249 50 c} {244 56}
- {202 105} {246 105} {246 87} {246 60 c} {271 37 c} {297 37}
- {323 37 c} {342 57 c} {344 68} {347 64 c} {350 60 c}
- {353 56} {363 46 c} {375 37 c} {395 37} {395 79} {393 79}
- {385 79 c} {379 86 c} {379 93} {379 100 c} {385 107 c}
- {393 107} {409 107} {409 148} {397 148} {378 148 c} {364 144 c}
- {354 133} {346 124} {346 148} {305 148} {305 87} {305 83 c}
- {301 79 c} {297 79} {293 79 c} {289 83 c} {289 87} {289 150}
- {251 150} {251 130} {251 126 c} {247 122 c} {243 122} {239 122 c}
- {235 126 c} {235 130} {235 150} {176 150} {154 150 c} {146 131 c}
- {146 114} {148 105} {120 105} {104 81} {104 105} {74 105} {74 41} {52 41}
- {52 105} {20 105} {20 41} {0 41}}
- set letters(lineWidth) 3
- set letters(lineColor) {#000000;80}
- set letters(fillColor) {=axial 270|#ffffff;100 0 28|#66848c;100 96|#7192aa;100 100}
- set letters(shadow,dXy) {6 6}
- set letters(shadow,fillColor) {#000000;18}
-
- set point(pos) {240 96}
- set point(alpha) 80
- set point(lineWidth) 1
- set point(lineColor) {#a10000;100}
- set point(fillColor) {=radial -20 -20|#ffffff;100 0|#f70000;100 48|#900000;100 80|#ab0000;100 100}
- set point(shadow,dXy) {5 5}
- set point(shadow,fillColor) {=path 0 0|#770000;64 0|#770000;64 65|#770000;0 100}
-
-
-
- proc create {zinc parent priority x y scaleX scaleY} {
- variable letters
- variable point
- #
- # Create a group to hold the various parts
- set logoGroup [$zinc add group $parent -priority $priority]
-
- #
- # Move the group in the right place
- $zinc coords $logoGroup "$x $y"
-
- #
- # Add a sub-group to isolate the scaling
- set scaleGroup [$zinc add group $logoGroup]
- $zinc scale $scaleGroup $scaleX $scaleY
-
- foreach {dx dy} $letters(shadow,dXy) break
- #
- # Create a curve for the main form shadow
- set lShadow [$zinc add curve $scaleGroup $letters(coords) \
- -tags lettersShadow -closed 1 -filled 1 -linewidth 0 \
- -fillcolor $letters(shadow,fillColor)]
- $zinc translate $lShadow $dx $dy
-
- set lineWidth [adjustLineWidth $letters(lineWidth) $scaleX $scaleY]
-
- #
- # Create a curve for the main form
- $zinc add curve $scaleGroup $letters(coords) -tags letters -closed 0 \
- -filled 1 -fillcolor $letters(fillColor) -linewidth $lineWidth \
- -linecolor $letters(lineColor)
-
- #
- # Create a group to hold the point and its shadow
- set pointGroup [$zinc add group $scaleGroup -alpha $point(alpha)]
- $zinc coords $pointGroup $point(pos)
-
- foreach {dx dy} $point(shadow,dXy) break
- #
- # Create a curve for the dot shadow
- set pShadow [$zinc add arc $pointGroup {-20 -20 20 20} -tags pointShadow \
- -closed 1 -filled 1 -fillcolor $point(shadow,fillColor) \
- -linewidth 0]
- $zinc translate $pShadow $dx $dy
-
- #
- # Create a curve for the dot
- $zinc add arc $pointGroup {-20 -20 20 20} -tags point -closed 1 \
- -filled 1 -fillcolor $point(fillColor) -linewidth $point(lineWidth) \
- -linecolor $point(lineColor)
-
- return $logoGroup
- }
-
- proc adjustLineWidth {lineWidth scaleX scaleY} {
- if {$lineWidth != 0} {
- if {$lineWidth >= 2} {
- set ratio [expr ($scaleX > $scaleY) ? $scaleY : $scaleX]
- return [expr $lineWidth * $ratio]
- }
- }
- }
-}
diff --git a/library/zincText.tcl b/library/zincText.tcl
deleted file mode 100644
index 2e235c5..0000000
--- a/library/zincText.tcl
+++ /dev/null
@@ -1,191 +0,0 @@
-#
-# ZincText - Zinc extension for text input on text items and fields
-#
-# $Id$
-#
-# AUTHOR
-#
-# Patrick Lecoanet <lecoanet@cena.fr>
-# (and documentation by Christophe Mertz <mertz@cena.fr>)
-#
-# Copyright (c) 2002 - 2003 CENA, Patrick Lecoanet
-#
-# This code is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Library General Public
-# License as published by the Free Software Foundation; either
-# version 2 of the License, or (at your option) any later version.
-#
-# This code is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-#
-# You should have received a copy of the GNU Library General Public
-# License along with this code; if not, write to the Free
-# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-#
-#
-# 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:
-#
-# <click 1> To set the cursor position
-# <click 2> To paste the current selection
-# <drag 1> To make a selection
-# <shift drag 1> To extend the current selection
-# <shift 1> To extend the current selection
-# <left arrow>,
-# <right arrow> To move the cursor to the left or to the right
-# <up arrow>,
-# <down arrow> To move the cursor up or down a line
-# <ctrl+a>,
-# <home> To move the cursor at the begining of the line
-# <ctrl+e>
-# <end> To move the cursor at the end of the line
-# <meta+<>,
-# <meta+>> To move the cursor at the beginning / end of the text
-# <BackSpace>
-# <ctrl+h> To delete the char just before the cursor
-# <Delete> To delete the char just after the cursor
-# <Return> 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 <B1-Motion> "extendSel $zinc %x %y"
- $zinc bind text <Shift-B1-Motion> "extendSel $zinc %x %y"
- $zinc bind text <Shift-1> "$zinc select adjust current @%x,%y"
- $zinc bind text <Left> "moveCur $zinc -1"
- $zinc bind text <Right> "moveCur $zinc 1"
- $zinc bind text <Up> "setCur $zinc up"
- $zinc bind text <Down> "setCur $zinc down"
- $zinc bind text <Control-a> "setCur $zinc bol"
- $zinc bind text <Home> "setCur $zinc bol"
- $zinc bind text <Control-e> "setCur $zinc eol"
- $zinc bind text <End> "setCur $zinc eol"
- $zinc bind text <Meta-less> "setCur $zinc 0"
- $zinc bind text <Meta-greater> "setCur $zinc end"
- $zinc bind text <KeyPress> "insertKey $zinc %A"
- $zinc bind text <Shift-KeyPress> "insertKey $zinc %A"
- $zinc bind text <Return> "insertChar $zinc \\n"
- $zinc bind text <BackSpace> "textDel $zinc -1"
- $zinc bind text <Control-h> "textDel $zinc -1"
- $zinc bind text <Delete> "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
generated by cgit v1.1 at 2024-11-03 06:12:02 +0000