Index by: file name | procedure name | procedure call | annotation
gscope_ordres.tcl (annotations | original source)

proc HTMLBoard {} {
    foreach Ordre [GscopeBoard TitreBidon "PourGIF"] {
	Espionne [join [DecoupeEnSousOrdresPourGif $Ordre] "\n"]
    }
    exit
}

proc TrouveDescription {NomComplet} {
    global RepertoireDuGenome
    set FichierNotes $RepertoireDuGenome/notes/$NomComplet
    if {! [file exists $FichierNotes]} {
	return [list "Infos for $NomComplet not found."]
    }
    
    return [LesLignesDuFichier $FichierNotes]
}

proc TGR {} {
    lappend LesOrdres "create rectangle 3 5 10 10 -fill red"
    Graphiste $LesOrdres 500 500 0 0 20 20 /home/wscope/toto.png 
    exit
}

proc ChargeOrdres {Couleur {FichierOrdres ""} {FichierIndexes ""} {FichierSignif ""}} {
    global LesOrdresTries
    global IndexesDesOrdres
    global ListeDeBoites CouleurDuFond
    
    # Positionne les variables LesOrdresTries et IndexesDesOrdres
    
    if { ! [info exists LesOrdresTries($Couleur)] } {
	if {[file exists $FichierOrdres]} {
	    set LesOrdresTries($Couleur) [LesLignesDuFichier $FichierOrdres]
	} else {
	    SauveLesLignes [set LesOrdresTries($Couleur)] dans $FichierOrdres
	}
    }
    
    if { ! [info exists IndexesDesOrdres] } {
	if {[file exists $FichierIndexes]} {
	    set IndexesDesOrdresFormatFichier [LesLignesDuFichier $FichierIndexes]
	    foreach Ligne $IndexesDesOrdresFormatFichier {
		scan $Ligne "%s %s %s" Indice Valeur BonneValeur
		set IndexesDesOrdres($Indice) "$Valeur BonneValeur"
	    }
	} else {
	    scan [BoundingBox [ListeDeBoites]] "%d %d" xDebut xFin
	    set xDebut [Maxi 1 [expr $xDebut-3000]]
	    incr xFin 1000
	    set ScalX [ expr 1024.0 / ( $xFin - $xDebut ) ]
	    set Pas [expr round ( ( 10*1024.0 / round ( 1.0 / $ScalX ) ) * ( $xFin - $xDebut ) / 1024.0 ) ]
	    set DebutCourant $xDebut
	    set FinCourant [expr $xDebut + $Pas]
	    set I 0
	    set IndexesDesOrdres($xDebut) "0 0"
	    foreach Ligne $LesOrdresTries($Couleur) {
		if { [regexp {^create} $Ligne] } {
		    if {[info exists X1]} { unset X1 }
		    if {[info exists Y1]} { unset Y1 }
		    if {[info exists X2]} { unset X2 }
		    if {[info exists Y2]} { unset Y2 }
		    
		    scan $Ligne "%s %s %f %f %f %f" Create Object X1 Y1 X2 Y2
		    set OnContinue 0
		    if { ! [info exists X2] } { set X2 $X1 }
		    if { ($X1 <= $DebutCourant && $DebutCourant < $X2) || \
			    ($X1 <= $FinCourant && $FinCourant < $X2) || \
			    ($DebutCourant < $X1 && $X2 <= $FinCourant) } {
			set OnContinue 1
		    }
		

		    if { ! $OnALimiteMin && $X2 >= $FinCourant } {
			set LimiteMin $I
			set OnALimiteMin 1
		    }
		    
		    if { ! $OnContinue } {
			if { ! $OnALimiteMin } { set LimiteMin $DebutCourant }
			set DebutCourant $FinCourant
			set IndexesDesOrdres($DebutCourant) "$I $LimiteMin"
			incr FinCourant $Pas
			set OnALimiteMin 0
		    }
		}
		incr I
	    }
	    
	    set ASauver {}
	    set LesIndexTries [lsort -integer [array names IndexesDesOrdres]]
	    foreach IndexCourant $LesIndexTries {
		lappend ASauver "$IndexCourant [set IndexesDesOrdres($IndexCourant)]"
	    }	    
	    SauveLesLignes $ASauver dans $FichierIndexes
	}
    }
}

proc CreeSignifications {{K "OrdrePourGif"}} {
    global SignificationEnStock
    
    set Significations [GetSignification "ToutesLesCouleursPossibles" $K]
    
    set listeAAfficher [list ""]
    foreach Signif $Significations {
    	set TexteSignif [GetSignification $Signif $K]
	lappend ListeAAfficher "$Signif   :   $TexteSignif"
    }
    
    return $ListeAAfficher
    #SauveLesLignes $ListeAAfficher dans $FichierSignif
}

proc CreeOrdresTries {Couleur} {
    global LesOrdresTries
    global LimiteGauche LimiteDroite

    scan [BoundingBox [ListeDeBoites]] "%d %d" xDebut xFin
    set xDebut [Maxi 1 [expr $xDebut-3000]]
    incr xFin 1000
    set LimiteGauche $xDebut
    set LimiteDroite $xFin
    set LO [GscopeBoard titi PourGif]	    
    RedefinirLaCouleur OrdrePourGif $Couleur
    set LesOrdresTries($Couleur) [LesOrdresPourGif $LO]
    return $LesOrdresTries($Couleur)
}

proc CreeIndexes {Couleur LesOrdres} {
    global LesOrdresTries
    global IndexesDesOrdres
    
    if {! [info exists LesOrdresTries] } {
	set LesOrdresTries($Couleur) $LesOrdres
    }
    
    scan [BoundingBox [ListeDeBoites]] "%d %d" xDebut xFin
    set xDebut [Maxi 0 [expr $xDebut-3000]]
    incr xFin 1000
    set ScalX [ expr 1024.0 / ( $xFin - $xDebut ) ]
    set Pas [expr round ( ( 10240.0 / round ( 1.0 / $ScalX ) ) * ( $xFin - $xDebut ) / 1024.0 ) ]
    set DebutCourant $xDebut
    set FinCourant [expr $xDebut + $Pas]

    set I 0
    set IndexesDesOrdres($xDebut) "0 0"
    set OnALimiteMin 0
    foreach Ligne $LesOrdresTries($Couleur) {
	if { [regexp {^create} $Ligne] } {
	    if {[info exists X1]} { unset X1 }
	    if {[info exists Y1]} { unset Y1 }
	    if {[info exists X2]} { unset X2 }
	    if {[info exists Y2]} { unset Y2 }
	    
	    scan $Ligne "%s %s %f %f %f %f" Create Object X1 Y1 X2 Y2
	    set OnContinue 0
	    if { ! [info exists X2] } { set X2 $X1 }
	    if { ($X1 <= $DebutCourant && $DebutCourant < $X2) || \
		 ($X1 <= $FinCourant   && $FinCourant   < $X2) || \
		 ($DebutCourant < $X1  && $X2 <= $FinCourant) } {
		set OnContinue 1
	    }
	    
	    if { ! $OnALimiteMin && $X2 >= $FinCourant } {
		set LimiteMin $I
		set OnALimiteMin 1
	    }
	    
	    if { ! $OnContinue } {
		if { ! $OnALimiteMin } { set LimiteMin $DebutCourant }
		set DebutCourant $FinCourant
		set IndexesDesOrdres($DebutCourant) "$I $LimiteMin"
		incr FinCourant $Pas
		set OnALimiteMin 0
	    }
	}
	incr I
    }
    
    set ASauver {}
    set LesIndexTries [lsort -integer [array names IndexesDesOrdres]]
    foreach IndexCourant $LesIndexTries {
	lappend ASauver "$IndexCourant [set IndexesDesOrdres($IndexCourant)]"
    }
    lappend ASauver "$FinCourant [llength [set LesOrdresTries($Couleur)]] [llength [set LesOrdresTries($Couleur)]]" 
    
    return $ASauver
}

proc TesteIndexation {} {
    scan [BoundingBox [ListeDeBoites]] "%d %d" xDebut xFin
    set xDebut [Maxi 1 [expr $xDebut-3000]]
    incr xFin 1000
    set ScalX [ expr 1024.0 / ( $xFin - $xDebut ) ]
    set Pas [expr round ( ( 10240.0 / round ( 1.0 / $ScalX ) ) * ( $xFin - $xDebut ) / 1024.0 ) ]
    set DebutCourant $xDebut
    set FinCourant [expr $xDebut + $Pas]
    Espionne "$ScalX $xDebut $xFin $Pas"
    ChargeOrdres "NombreDeCopainsDansBlast" ordrescomplets.txt indexes.txt signif.txt
    LesOrdresEntrePositions "NombreDeCopainsDansBlast" [expr 1+5*$Pas] [expr 1+7*$Pas]
    exit
}

proc LesOrdresEntreIndexes {Couleur Deb Fin} {
    global LesOrdresTries
    global IndexesDesOrdres
    
    set LesOrdresAvecPeutEtreCanvas [lrange [set LesOrdresTries($Couleur)] $Deb $Fin]

    if { [lsearch -regexp $LesOrdresAvecPeutEtreCanvas {^create canvas}] == -1} {
	set DebutCanvas [lsearch -regexp $LesOrdresTries($Couleur) {^create canvas}]
	set FinCanvas   [lsearch -regexp $LesOrdresTries($Couleur) {^fin create canvas}]
	set LesOrdresAvecPeutEtreCanvas [concat [lrange $LesOrdresTries($Couleur) $DebutCanvas $FinCanvas] $LesOrdresAvecPeutEtreCanvas]
    }
    
#   SauveLesLignes $LesOrdresAvecPeutEtreCanvas dans /home/wscope/wscope/forum/Espionne${Deb}${Fin}.txt

    return $LesOrdresAvecPeutEtreCanvas
}

proc LesOrdresEntrePositions {Couleur xMin xMax} {
    global IndexesDesOrdres
    if {[info exists IndexesDesOrdres($xMin)] && [info exists IndexesDesOrdres($xMax)]} {
	scan [set IndexesDesOrdres($xMin)] "%s %s" Bidon VraiMin
	scan [set IndexesDesOrdres($xMax)] "%s %s" VraiMax Bidon
	return [LesOrdresEntreIndexes $Couleur $VraiMin $VraiMax]
    }
    
    set LesBornesMin [lsort -integer [array names IndexesDesOrdres]]
    set LesBornesMax [lrange $LesBornesMin 1 end]

    set BonxMin    [lindex $LesBornesMin 0]
    set BonxMax    [lindex $LesBornesMax end]
    set XMaxAncien -999999
    foreach m $LesBornesMin M $LesBornesMax {
	if { $m <= $xMin } {
	    set BonxMin $m 
	}
	if { $XMaxAncien <= $xMax && $xMax < $M } {
	    set BonxMax $M
	    break 
	}
	set XMaxAncien $M
    }
    
    Espionne "$xMin $xMax $BonxMin $BonxMax"
    if { ! [info exists BonxMin]} { return {} }
    
    scan [set IndexesDesOrdres($BonxMin)] "%s %s" Bidon VraiMin
    scan [set IndexesDesOrdres($BonxMax)] "%s %s" VraiMax Bidon
    return [LesOrdresEntreIndexes $Couleur $VraiMin $VraiMax]
}

proc CreeLeFichierGIF {K LesOrdresPourGIF LaBoundingBox CheminGIF ListeDesDimensions } {
    global CommandeCanvart
    global GraphisteDir
    
    if {[info exists SavantGraphiste] && $SavantGraphiste} {
	SauveLesLignes $LesOrdresPourGIF dans "[RepertoireDeTravail]/lesordrespourgif"
	QuestionDeScience Graphiste "exe ..."
    } else {
	if { ! [info exists CommandeCanvart]} {
	    set CommandeCanvart "java ImageDecoder2"
	}
	
	set X1 [lindex $LaBoundingBox 0]
	set Y1 [lindex $LaBoundingBox 1]
	set X2 [lindex $LaBoundingBox 2]
	set Y2 [lindex $LaBoundingBox 3]
	
	set ValWidth [lindex $ListeDesDimensions 0]
	if { [llength $ListeDesDimensions]==1 } {
	    set ValHeight [expr round($ValWidth*($Y2-$Y1)/($X2-$X1))]
	} else {
	    set ValHeight [lindex $ListeDesDimensions 1]
	}
	
	return [Graphiste $LesOrdresPourGIF $ValWidth $ValHeight $X1 $Y1 $X2 $Y2 $CheminGIF]
    }
}

proc LesGenomesParListe {} {
    global NotreOS
    
    set LGComplets [LesGenomesComplets]
    set LGCourts [LesGenomesCompletsAuFormat Court]
    set LesNoms {}
    
    foreach UnGLong $LGComplets UnGCourt $LGCourts {
	if { $UnGLong != $NotreOS } {
	    lappend LesNoms "$UnGCourt $UnGLong"
	}
    }
    return $LesNoms
}

proc LesPanneauxPossibles {{Panneau "LaListeMerci"}} {
    global RepertoireDuGenome
    global LesPanneauxPossibles

    if { ! [info exists LesPanneauxPossibles]} {
#	set LesPanneauxPossibles(PresenceAbsence) "Listbox:LesGenomesParListe"
	set LesPanneauxPossibles(ShowOrganisms)   "Texte:MontreOrganismes"
	set LesPanneauxPossibles(LinearGenome)    "GscopeBoard $RepertoireDuGenome PourGif"
	set LesPanneauxPossibles(CircularGenome)  "RscopeBoard $RepertoireDuGenome PourGif"
	set LesPanneauxPossibles(PhyloRank)       "DessineOrgaEtSesPlaces $RepertoireDuGenome/fiches/orgaetsesplaces.tout_le_monde PourGif"
	set LesPanneauxPossibles(PhyloRanks)      "DessineOrgaEtSesPlaces $RepertoireDuGenome/fiches/orgaetsesplaces.<ChoixParmi <list tout_le_monde toutes_euryarks manque_euryarks no-ark>> PourGif"
	set LesPanneauxPossibles(ProteomeDotplot) "DotPlot genomes <ChoixParmi <LesGenomesCompletsPossibles>> Proches PourGif"
    }
    if {$Panneau=="LaListeMerci"} { return [array names LesPanneauxPossibles] }
    if {[info exists LesPanneauxPossibles($Panneau)]} { return [set LesPanneauxPossibles($Panneau)] }
    return "Sorry no such panneau"
}

proc SoumettreAuServeurWscope LesCommandes {
    global ForumWscope
    global FichierAFaire
    global FichierDejaFait

    global SansServeurWscope

    NommeLesFichiersForum

    if {[info exists SansServeurWscope] && $SansServeurWscope} {
	ChargeConfig
	FaireAFaire $LesCommandes
	return
    }

    LanceLeServeurWscope
    SauveLesLignes $LesCommandes dans $FichierAFaire
}

proc LesServeursWscopeQuiTournent {{Genome ""}} {

    set PS [eval exec ps -ef]

    set Sortie {}
    foreach Ligne [split $PS "\n"] {
	if {[regexp "gscope ToujoursFaire $Genome" $Ligne]} {
	    lappend Sortie $Ligne
	}
    }
    return $Sortie
}

proc AttendreLeFichierDuServeurWscope {Fichier {TimeOut ""}} {

    set Attente 1000
    while { 1 } {
	if {[file exists $Fichier]} { return $Fichier }
	if {$TimeOut != "" } {
	    set TimeOut [expr $TimeOut-$Attente]
	    if {$TimeOut<0} { return "" }
	}
	after $Attente
    }
}

proc LanceLeServeurWscope {} {
    global GscopeDir
    global RepertoireDuGenome
    global CurrentGenome
    global ForumWscope
    global FichierAFaire
    global FichierDejaFait

    set Sonnette "$ForumWscope/wscope_${CurrentGenome}_est_pret"
    lappend LesCommandes "Sauve $Sonnette dans $Sonnette"
    SauveLesLignes $LesCommandes dans $FichierAFaire
    
    after 2000
    if {! [file exists $Sonnette]} {
	after 2000
    }
    if { ! [file exists $Sonnette]} {
	after 5000
	eval exec $GscopeDir/bin/gscope ToujoursFaire $CurrentGenome &
	after 3000
    }
    
    File delete $Sonnette
}

proc NommeLesFichiersForum {} {
    global RepertoireDuGenome
    global CurrentGenome
    global ForumWscope
    global FichierAFaire
    global FichierDejaFait

    if {[info exists FichierAFaire]} { return }

    if {[info exists env(FORUMWSCOPE)]} {
	set ForumWscope [set env(FORUMWSCOPE)]
    } else {
	set ForumWscope /biolo/wscope/wscope/forum
    }
    
    set FichierAFaire   "$ForumWscope/afaire$CurrentGenome"
    set FichierDejaFait "$ForumWscope/dejafait$CurrentGenome"
}

proc ToujoursFaire CurGeno {
    global FichierAFaire
    global FichierDejaFait
    global CurrentGenome

    set Pointeuse 0
    set Attente 2000
    set MaxIdle [expr 1000*60*15]
    while { 1 } {
	incr Pointeuse $Attente
	if {[file exists $FichierAFaire]} {
	    set Pointeuse 0
	    FaireAFaire
	    continue 
	}
	if {$Pointeuse > $MaxIdle} { exit }
	after $Attente 
    }
}

proc FaireAFaire {{CeQuIlFautFaire ""}} {
    global FichierAFaire
    global FichierDejaFait
    

    if {$CeQuIlFautFaire == ""} {
	set AFaire [LesLignesDuFichier $FichierAFaire]
    } else {
	set AFaire $CeQuIlFautFaire
    }
    foreach Ligne $AFaire {
	if {[regexp  "^Log " $Ligne]} {
	    regsub "^Log " $Ligne "" Texte
	    if {[catch {eval set Texte $Texte} Message]} {
		AppendAuFichier $FichierDejaFait "WscopeServerError >"
		AppendAuFichier $FichierDejaFait "$Message"
		AppendAuFichier $FichierDejaFait "< WscopeServerError"
	    } else {
		AppendAuFichier $FichierDejaFait $Texte
	    }
	    AppendAuFichier $FichierDejaFait $Ligne
	    continue
	}
	if {[catch {eval $Ligne} Message]} {
	    AppendAuFichier $FichierDejaFait "WscopeServerError >"
	    AppendAuFichier $FichierDejaFait "$Message"
	    AppendAuFichier $FichierDejaFait "< WscopeServerError"
	}
	AppendAuFichier $FichierDejaFait $Ligne
    }
    if {$CeQuIlFautFaire == ""} {
	File delete $FichierAFaire
    }
}

proc NeRejettePasLaBoite Boite {
    return 0
}

proc RejetteLaBoite Boite {
    global LimiteGauche LimiteDroite
    
    set Nom [Box $Boite nom]
    if { ! [YaPABouTROUouTRNAouARNenDebutDe $Nom]} { return 1 }

    if { ! [info exists LimiteGauche]} { return 0 }

    set Debut [Box $Boite debut]
    set Fin   [Box $Boite fin]
    if {$Fin < $LimiteGauche || $LimiteDroite < $Debut} { return 1 }
    return 0
}

proc Td {} {
    puts [join [DecoupeEnSousOrdresPourGif "create rectangle 1 2 3 4 -a \{A AA\} -b \\\{ -c -9"] "\n"]
    exit
}

proc DecoupeEnSousOrdresPourGif Ordre {

    if { ! [regexp -indices -nocase {\-[a-z]} $Ordre Indices] } { return $Ordre } 
    scan $Indices "%d" iMoins
    set Reste [string range $Ordre $iMoins end]

    set Commande [string trim [string range $Ordre 0 [incr iMoins -1]]]
    scan $Commande "%s %s" Com Type
    lappend LesSousOrdres $Commande
    
    while {[regexp {\-} $Reste]} {
	set Reste [string trim $Reste]
	scan $Reste "%s" Option
	regsub "^$Option " $Reste "" Reste
	set Reste [string trim $Reste]
	if { ! [regexp {^\{} $Reste] } {
	    set iBlanc [string first " " "$Reste "]
	    set iFin [expr $iBlanc-1]
	    set Valeur [string range $Reste 0 $iFin]
	    set Reste [string range $Reste $iBlanc end]
	} else {
	    set Valeur "\{"
	    set i 1
	    set NiveauImbrique 1
	    
	    while { 1 } {
		set C [string index $Reste $i]
		#puts "Caract :[string repeat " " $NiveauImbrique]$C"
		if {$C=="\}"} { 
		    append Valeur $C
		    incr i
		    incr NiveauImbrique -1
		    if { $NiveauImbrique == 0 } { break }
		    continue
		}

		if {$C=="\{"} {
		    append Valeur $C
		    incr i
		    incr NiveauImbrique
		    continue
		}

		if {$C=="\\"} {
		    append Valeur "\\[string index $Reste [incr i]]"
		    incr i 
		    continue
		}
		
		append Valeur $C
		incr i
		
	    }
	    set Reste [string range $Reste $i end]
	    
	}
	#puts "Reste : $Reste"
	lappend LesSousOrdres "$Option $Valeur"
    }
    lappend LesSousOrdres "fin $Com $Type"
    return $LesSousOrdres
}

proc LesOrdresPourGif LesOrdresBruts {
    global FillPourGif OutlinePourGif
    
    Wup "GscopeBoard, first creates the boxes,"
    Wup " and second, color them, storing the colors in the arrays FillPourGif and OutlinePourGif"

    foreach Ligne $LesOrdresBruts {
	if { ! [regexp "Box|TEXTE|Cadre|arc|Web|Seq|Lettre" $Ligne]} { continue }
	if {[regexp "Cadre" $Ligne]} {
	    regsub "rectangle|rect" $Ligne canvas Ligne
	    regsub "outline" $Ligne background Ligne
	}
	if {[regexp "Box" $Ligne]} {
	    set Nom [StringApres "Box" dans $Ligne]
	    regsub -all {\}} $Nom "" Nom
	    if {[info exists FillPourGif($Nom)]} {
		if {[regexp {\-fill} $Ligne]} {
		    append Ligne " -"
		    regsub {\-fill [^\-]+\-} $Ligne "-fill [set FillPourGif($Nom)] -" Ligne
		    regsub " \-$" $Ligne "" Ligne
		} else {
		    append Ligne " -fill [set FillPourGif($Nom)]"
		}
	    }
	    if {[info exists OutlinePourGif($Nom)]} {
		if {[regexp {\-outline} $Ligne]} {
		    append Ligne " -"
		    regsub {\-outline [^\-]+\-} $Ligne "-outline [set OutlinePourGif($Nom)] -" Ligne
		    regsub " \-$" $Ligne "" Ligne
		} else {
		    append Ligne " -fill [set OutlinePourGif($Nom)]"
		}
	    }
	}
	lappend LesOrdresOK $Ligne
    }
    set LesOrdresTries [lsort -command CompareLeTroisiemeChamp $LesOrdresOK]
    foreach Ligne $LesOrdresTries {
	Espionne $Ligne
	foreach SousOrdre [DecoupeEnSousOrdresPourGif $Ligne] {
	    lappend LesOrdres $SousOrdre
	}
    }
    return $LesOrdres
}


proc OrdrePourGif args {
    global LesOrdresPourGif
    global FillPourGif OutlinePourGif

    Wup "The 'create rectangle' ( line, arc', etc.) are stored in LesOrdresPourGif"
    Wup " the 'find withtag' statement return Nom"
    Wup " the itemconfigure statement stores the colors in FillPourGif..."

    set OrdreComplet $args
    set Ordre [lindex $OrdreComplet 0]
    set Texte [join $OrdreComplet " "]

    if {$Ordre == "find"} {
	set SousOrdre [lindex $OrdreComplet 1]
	if {$SousOrdre == "withtag"} {
	    set Nom [lindex $OrdreComplet 2]
	    if {[YaPABouTROUouTRNAouARNenDebutDe $Nom]} { return $Nom }
	} 
    }
 
    if {$Ordre == "coords"} {
	if {[regexp -nocase -indices {create [a-z]+} $Texte Indices]} {
	    scan $Indices "%d %d" d f
	    set Suite [string range $Texte [incr f] end]
	    set d end
	    if {[regexp -nocase -indices -- {( | \-)[a-z]+} $Suite Indices]} {
		scan $Indices "%d %d" d f
		incr d -1
	    }
	    set Coordonnees [string range $Suite 0 $d]
	    return $Coordonnees
	}
	return "0 0 1 1"
    }
 
    if { ! [regexp "^create|^itemconfigure|^xview" $Ordre]} { return  $OrdreComplet}

    if {$Ordre=="itemconfigure"} {
	set CFill "white"
	set COutline "black"
	scan $Texte "%s %s %s %s %s %s" Ordre Nom Fill CFill Outline COutline
	if { ! [YaPABouTROUouTRNAouARNenDebutDe $Nom]} { return  $OrdreComplet}
	if {$Fill != "-fill"} { return $OrdreComplet }
	set FillPourGif($Nom) $CFill
	set OutlinePourGif($Nom) $COutline
	return $OrdreComplet
    }
    lappend LesOrdresPourGif $OrdreComplet
    return $OrdreComplet
}

proc NeRienFaire args {
}

proc CreeLesOrdresPourGIF {K {CeQuOnVeut "Visible"} {NomDuFichierGIF ""}} {
    global LesOrdresPourGIF

    JeMeSignale
    SauveLesLignes [$K configure] dans creelesordres.log

    if {$NomDuFichierGIF == ""} {
	set NomDuFichierGIF [FichierPourSaveAs]
    }
    if {$NomDuFichierGIF==""} { return "" }

    set LesOrdresPourGIF {}

    set LesOptions {}
    foreach OptionValeurs [$K configure] {
	set Option [lindex $OptionValeurs 0]
	set Valeur [lindex $OptionValeurs 4]
	if {$Valeur == {}} { continue } 
	if {[regexp " " $Valeur]} { set Valeur "\{$Valeur\}" }
	lappend LesOptions "$Option $Valeur"
    }

    lappend LesOrdresPourGIF "create canvas"
    foreach Option $LesOptions {
	lappend LesOrdresPourGIF $Option
    }
    lappend LesOrdresPourGIF "fin create canvas"

    if {$CeQuOnVeut=="" || $CeQuOnVeut=="Visible"} {
	set ScrollRegion [lindex [$K configure -scrollregion] 4]
	if {$ScrollRegion!=""} {
	    scan [$K xview] "%f %f" xVd xVf
	    scan [$K yview] "%f %f" yVd yVf
	    scan $ScrollRegion "%f %f %f %f" xSRd ySRd xSRf ySRf
	    set xd [expr $xSRd+$xVd*($xSRf-$xSRd)]
	    set yd [expr $ySRd+$yVd*($ySRf-$ySRd)]
	    set xf [expr $xSRd+$xVf*($xSRf-$xSRd)]
	    set yf [expr $ySRd+$yVf*($ySRf-$ySRd)]
	} else {
	    set xd 0
	    set yd 0
	    set xf [lindex [$K configure -width] 4]
	    set yf [lindex [$K configure -height] 4]
	}
	Espionne "$xd $yd $xf $yf"
	set LesObjets [$K find enclosed $xd $yd $xf $yf]
    }
    if {$CeQuOnVeut=="OnVeutTout"} {
	set LesObjets [$K find withtag all]
	set xd 0
	set yd 0
	set xf [lindex [$K configure -width] 4]
	set yf [lindex [$K configure -height] 4]
    }
    foreach Id $LesObjets {
	set Type [$K type $Id]
	set LesOptions {}
	foreach OptionValeurs [$K itemconfigure $Id] {
	    set Option [lindex $OptionValeurs 0]
	    set Valeur [lindex $OptionValeurs 4]
	    if {$Valeur == {}} { continue } 
	    if {[regexp " " $Valeur]} { set Valeur "\{$Valeur\}" }
	    lappend LesOptions "$Option $Valeur"
	}
	lappend LesOrdresPourGIF "create $Type [$K coords $Id]"
	foreach Option $LesOptions {
	    lappend LesOrdresPourGIF $Option
	}
	lappend LesOrdresPourGIF "fin create $Type"
    }
    if {$LesOrdresPourGIF=={}} { return "" }

    set LargeurImage [expr ($xf-$xd)]
    return [CreeLeFichierGIF $K $LesOrdresPourGIF [list $xd $yd $xf $yf] $NomDuFichierGIF [list $LargeurImage]]
}


Index by: file name | procedure name | procedure call | annotation
File generated 2022-04-05 at 12:55.