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

#rR gscope_pipala.tcl

proc ZincrSite {{Value ""}} {
    #rR Attention existe dans zincr_tools.tcl et gscope_pipala.tcl
    global ZincrSite
    if {$Value!=""} { set ZincrSite $Value } 
    if { ! [info exists ZincrSite]} { set ZincrSite "/wali" }
    return $ZincrSite
}


proc HtmlBlastDatabaseInventory {} {
    BlastDatabaseInventory "ResetAll"
    set LesBases [BlastDatabaseInventory ListOf ProBestFirst]
    set LL {}
    set lesClefs [list BlastDatabase Type NbSequences NbLetters DBLIST]
    lappend LL $lesClefs
    set lesTailles [dbSize [lindex $LesBases 1]]
    foreach base $LesBases {
	set type   [BlastDatabaseInventory $base Type]
	set size   [BlastDatabaseInventory $base Size]
	set NbSequences ""
	set NbLetters ""
	scan $size "%d %s %d %s" NbSequences sequences NbLetters letters
	set dbList [BlastDatabaseInventory $base DBLIST]
	lappend LL [list $base $type $NbSequences $NbLetters $dbList]
    }
    
    set lesLignes {}
    lappend lesLignes "<table style='empty-cells:show;margin:2em;'>"
    lappend lesLignes "  <tbody>"
    set PremiereLigne 1
    foreach L $LL {
	lappend lesLignes "    <tr>"
	foreach k $lesClefs e $L {
	    set Cadrage ""
	    if {$PremiereLigne} {
		if {$e=="DBLIST"} { set Cadrage "style='text-align:left;' " } 
		lappend lesLignes "      <th $Cadrage>$e</th>"
	    } else {
		if {[regexp {^[0-9]+$} $e]} { set Cadrage "style='text-align:right;' " }
		if {$e==0} {set e ""}
		if {$k=="BlastDatabase"} {set BaseCourante $e}
		set ligne "<td $Cadrage>$e</td>"
		lappend lesLignes $ligne
	    }
	}
	set PremiereLigne 0
	lappend lesLignes "    </tr>"
    }
    lappend lesLignes "  </tbody>"
    lappend lesLignes "</table>"
    set Table [join $lesLignes "\n"]

    return $Table
}

proc SelectBlastDatabase {{Selected ""} {Name ""} {Class ""} {Type ""}} {
    if {$Name ==""} { set Name  "SelectBlastDatabase" }
    if {$Class==""} { set Class "SelectBlastDatabase" }
    if {$Type ==""} { set Type  "ProNucBestFirstWithTitle" }
    set Databases [BlastDatabaseInventory ListOf $Type]
    set LesDatabases [split $Databases "\n"]
#   set LesDatabases [linsert $LesDatabases 0 "CeQuOnVeut"]
    set LeHtml {}
    set Col ""
    if {$Selected!=""} { set Col " style='background-color:lightgreen;'" }  
    lappend LeHtml "<select $Col name='$Name' class='$Class' onClick='inputChanged(this);'>"
    lappend LeHtml "  <option value='NoBlastDatabase'>Select BlastDatabase</option>"
    foreach Database $LesDatabases {
	scan $Database "%s" Base
	set Sel ""
	set Col ""
	set Text $Database
	if {$Base=="$Selected"} {
	    set Sel " Selected"
	    set Col " style='background-color:lightgreen;'"
	}
	lappend LeHtml "  <option $Sel $Col value='$Base'>$Text</option>"
    }
    lappend  LeHtml "</select>"
    return [join $LeHtml "\n"]
}

proc CanvaAsSvg {args} {
    global CAS

    set BlastFile ""

    lassign $args Qui Quoi W H File

    if {$Qui=="create" && $Quoi=="svg"} {
	set BlastFile $File
	set CAS(Current,BlastFile) $BlastFile
	if {[info exists CAS($BlastFile)]} { array unset CAS $BlastFile* }
	set CAS($BlastFile) 1
    }
    set BlastFile $CAS(Current,BlastFile)

    #rR Retour pour Qui Quoi
    if {[info exists CAS($BlastFile,$Qui,$Quoi)]} { return $CAS($BlastFile,$Qui,$Quoi) }
    if {$Quoi=="SequenceDesBanques"} {
	set SDB ""
	if {[info exists CAS($BlastFile,$Qui,BId)]} {
	    set BId $CAS($BlastFile,$Qui,BId)
	    set SDB [SequenceDesBanques $BId]
	    if {$SDB!=""} { return $SDB }
	}
	return "Sorry I didn't found any information about $Qui"
    }
    if {$Quoi=="WholeSubject"} {
	set WholeSubject ""
	if {[info exists CAS($BlastFile,$Qui,BId)]} {
	    set BId $CAS($BlastFile,$Qui,BId)
	    set Texte [ContenuDuFichier $BlastFile]
	    if {[regexp ">$BId \[^>\]+(>|$)" $Texte Match]} {
		set WholeSubject [string trimright $Match ">"]
		regsub "  Database:" $WholeSubject "" WholeSubject
		return $WholeSubject
	    }
	}
	return "Sorry I didn't found any information about $Qui"
    }
    #rR Retour pour Qui Quoi

    lassign $args Commande Forme
    if {$Commande=="close" && $Forme=="svg"} {
	lappend CAS($BlastFile,ContentOf,svg) "</svg>"
	set CAS($BlastFile,ContentOf,svg) [join $CAS($BlastFile,ContentOf,svg) "\n"]
	return $CAS($BlastFile,ContentOf,svg)
    }
    if {$Commande=="create"} {
	set iOptions 4
	if {$Forme=="rectangle"} { set iOptions 6 }
	set Coords  [lrange $args 2 $iOptions-1]
	set Options [lrange $args $iOptions end]
	if {$Forme=="svg"} {
	    lassign $Coords W H
	    lappend CAS($BlastFile,ContentOf,svg) "<svg id='IAmTheSvg' width='$W' height='$H' version='1.1' xmlns='http://www.w3.org/2000/svg' xmlns:xlink='http://www.w3.org/1999/xlink'>"	
	    return $Coords
	}
	foreach {K V} $Options {
	    set K [string range $K 1 end]
	    set Option($K) $V
	}
	set Type ""
	set BId ""
	if {[info exists Option(tags)]} {
	    lassign $Option(tags) BId File Alig Subj Type
	}
	set Id "${Forme}_${Type}_${BId}"
	lappend CAS($BlastFile,ListOf,Id) "$Id"
	
	if {[info exists Option(tags)]} {
	    lassign $Option(tags) BId File Alig Subj Type
	    set CAS($BlastFile,$Id,BId)  $BId
	    set CAS($BlastFile,$Id,Id)   $Id
	    set CAS($BlastFile,$Id,File) $File
	    set CAS($BlastFile,$Id,Alig) $Alig
	    set CAS($BlastFile,$Id,Subj) $Subj
	    set CAS($BlastFile,$Id,Type) $Type
	}
	set Outline "none" ; if {[info exists Option(outline)]} { set Outline $Option(outline) } 
	set Fill    "none" ; if {[info exists Option(fill)   ]} { set Fill    $Option(fill)    } 
	set Outline [HtmlCompatibleColor $Outline]
	set Fill    [HtmlCompatibleColor $Fill]
	set Element ""

	if {$Forme=="rectangle"} {
	    lassign $Coords dX dY fX fY
	    set X $dX
	    set Y $dY
	    set W [expr $fX-$dX]
	    set H [expr $fY-$dY]
	    FormateLesCoordonnees X Y W H
	    set Element "<rect class='$Type' x='$X' y='$Y' width='$W' height='$H' id='$Id' style='stroke:$Fill; stroke-width:1.0; fill:$Fill;'/>"
	}
	if {$Forme=="line" || $Forme=="polyline"} {
	    set Points [join $Coords " "]
	    FormateLesCoordonnees Points
	    set Element "<polyline points='$Points' id='$Id' style='stroke:$Outline; stroke-width:1.0; fill:$Fill;'/>"
	}
	if {$Forme=="text"} {
	    lassign $Coords X Y
	    FormateLesCoordonnees X Y 
	    set Texte "" ; if {[info exists Option(text)]} { set Texte $Option(text) } 
	    set Element "<text class='$Type' x='$X' y='$Y' id='$Id' style='stroke-width: 0; font-family: Courier; font-size: 10pt; fill: black;' text-anchor='middle'>$Texte</text>"
	}
	lappend CAS($BlastFile,ContentOf,svg) $Element
    }
    return ""
}

proc HtmlCompatibleColor Color {
    if {[regexp -nocase {^#[a-z0-9]{12}$} $Color]} {
	lassign [split $Color ""] D  a b c d  e f g h  i j k l
	return "#$a$b$e$f$i$j"
    }
    package require Tk
    catch {set Color [ColorHexa $Color]}
    return $Color
}

proc BindSvg args {
    return 
}

proc BoutonneLaFenetreSvg args {
    set args [string map [list "'" "prime"] $args]
    set NomDuBouton [lindex $args 1]
    regsub -all " " $NomDuBouton "_" NomDuBouton
    return "VirtualButton_$NomDuBouton"
}

proc FormateLesCoordonnees args {
    foreach aC $args {
	upvar $aC C
	set LeF {}
	foreach N [split $C " "] {
	    set FN [format "%.1f" $N]
	    lappend LeF $FN
	}
	set C [join $LeF " "]
    }
    return
}



proc HtmlBlastIllustre {{BlastFile ""} {Site ""} {ExpectDeRef ""} {NbSubject ""} {LesBIdsAutorises ""} {SelectedOrganism ""}} {
    
    if {$Site==""} { set Site [ZincrSite] }
    set ParamScience "science=[Science]&"

    if {[regexp "^palignupload"   $BlastFile]} { regsub "^palignupload"   $BlastFile "/tempor/palign/upload"   BlastFile }
    if {[regexp "^palignarchive"  $BlastFile]} { regsub "^palignarchive"  $BlastFile "/tempor/palign/archive"  BlastFile }
    if {[regexp "^paligndepot"    $BlastFile]} { regsub "^paligndepot"    $BlastFile "/tempor/palign/depot"    BlastFile }
    if {[regexp "^palignsessions" $BlastFile]} { regsub "^palignsessions" $BlastFile "/tempor/palign/sessions" BlastFile }
    
    set Svg [IllustreLeBlast $BlastFile $ExpectDeRef $NbSubject $LesBIdsAutorises $SelectedOrganism "PourSvgFromHtmlBlastIllustre"]
    if {[regexp "^Sorry" $Svg]} { return $Svg }
    set ScriptBlastIllustre [Chabada "TemplateBlastIllustre.js" "_site_=$Site" "_paramscience_=$ParamScience"]
    set Html                [Chabada "TemplateBlastIllustre.html" "ScriptBlastIllustre=$ScriptBlastIllustre" "Svg=$Svg" "site=$Site"]
    if {[regexp -nocase scope $Site]} {
	set Html [Chabada $Html "SpecificCss=[CssWscope]"]
    }
    
    return $Html
}

proc IllustreLeBlast {{FichierBlast ""} {ExpectDeRef ""} {NbSubject ""} {LesBIdsAutorises ""} {SelectedOrganism ""} {PourSvg ""}} {
    #rR IllustreLeBlast a remplacé IllustreLeBlastCanva dans /home/chalmel/gscopublic/blast.tcl
    #rR Ecrit par Frederic Chalmel
    #rR Modifié par Raymond pour qu'il crée un fichier Svg pour le web ;)
    Espionne $PourSvg
    
    #rR pour facilietr les tests
    foreach Param [list FichierBlast ExpectDeRef NbSubject LesBIdsAutorises SelectedOrganism] {
	if {[regexp "PourSvg" [set $Param]]} {
	    set PourSvg [set $Param]
	    set $Param ""
	}
    }
    if {$PourSvg==""} { set PourSvg [PourWscope] } 
    #rR Ca semble tordu mais c'est pour permettre l'appel depuis Affiche où on ne fait que IllustreLeBlast FichierBlast
    if { $PourSvg!=0 && ! [regexp "FromHtmlBlastIllustre" $PourSvg]} { return [HtmlBlastIllustre $FichierBlast "/zscope" $ExpectDeRef $NbSubject $LesBIdsAutorises $SelectedOrganism] }
    #rR HtmlBlastIllustre appellera IllustreLeBlast en mettant PourSvgFromHtmlBlastIllustre

    if {[regexp "PourSvg" $PourSvg]} { set PourSvg 1 }
    if {$PourSvg==""} { set PourSvg [PourWscope] }
    if {$ExpectDeRef     ==""} { set ExpectDeRef "NoLimit" }
    if {$NbSubject       ==""} { set NbSubject   "NoLimit" }
    if {$SelectedOrganism==""} { set SelectedOrganism "None" }
    if {$FichierBlast    ==""} { set FichierBlast "/home/ripp/bac/b25.blast" } 
#   if {$FichierBlast    ==""} { set FichierBlast "/genomics/link/CilioCarta/blastp/HSAP00001" } 

    if { ! [file exists $FichierBlast]} {
	if {[EstUnPAB $FichierBlast]} {
	    set FB [GscopeFile $FichierBlast "blastp"]
	    if {[file exists $FB]} { set FichierBlast $FB }
	} else {
	    return "Sorry. $FichierBlast does not exist."
	}
    }
    set TailleQuery [TailleDeLaQueryDuBlast $FichierBlast]
    if {$TailleQuery == 0} {return "Sorry. The query length is 0."}

    if {$ExpectDeRef == "" } {set ExpectDeRef "1e-3"
    } elseif {$ExpectDeRef == "NoLimit"} {set ExpectDeRef "1e200"}
    if {$NbSubject   == "" } {set NbSubject   "250"
    } elseif {$NbSubject   == "NoLimit"} {set NbSubject   "1e200"}

    DepouilleLeBlast TabBlast $FichierBlast $ExpectDeRef $NbSubject

    set FichierTFA ""
    if {[EstUnPAB [file tail $FichierBlast]]} {
	set Nom [file tail    $FichierBlast]
	set Dir [file dirname $FichierBlast]
	if {$Dir == "."} {set Dir [pwd]}
	set DirDuRepertoireDuGenome [lindex [split $Dir "/"] end]
	if {[regexp "^blastn|^blastx" $DirDuRepertoireDuGenome]} {
	    set FichierTFA "[RepertoireDuGenome]/nucmask/$Nom"
	    if {![file exists $FichierTFA]} {
		set FichierTFA "[RepertoireDuGenome]/nuctfa/$Nom"
	    } 
	} elseif {[regexp "^blastp|^tblastn" $DirDuRepertoireDuGenome]} {
	    if {[file exists "[RepertoireDuGenome]/genscanpredictions/$Nom"]} {
		set FichierTFA "[RepertoireDuGenome]/genscanpredictions/$Nom"
	    } else {
		set FichierTFA "[RepertoireDuGenome]/prottfa/$Nom"
	    }
	} elseif {[regexp "^mrnablast" $DirDuRepertoireDuGenome]} {
	    set FichierTFA "[RepertoireDuGenome]/mrnahuman/$Nom"
	}
    }
    if {![file exists $FichierTFA]} {set FichierTFA ""}

    if {      $SelectedOrganism == "ToPreserve"} {
	set LesOrganismesAConserver [LaSelectionDeNoe 1 NoSave]
	set LesOrganismesAEliminer {}
    } elseif {$SelectedOrganism == "ToEliminate"} {
	set LesOrganismesAEliminer [LaSelectionDeNoe 1 NoSave]
	set LesOrganismesAConserver {}
    } else {
	set LesOrganismesAConserver {}
	set LesOrganismesAEliminer {}
    }
    if {$PourSvg} {
	set LargeurMax        1600
	set HauteurMax        1600
	set LargeurFenetre    $LargeurMax
	set HauteurFenetre    $HauteurMax
    } else {
	set LargeurMax        [expr [winfo screenwidth  .]*1/3 - 50]
	set HauteurMax        [expr [winfo screenheight .]*2/3     ]
	set LargeurFenetre    [expr [winfo screenwidth  .]*1/3 - 50]
	set HauteurFenetre    [expr [winfo screenheight .]*2/3     ]
    }
    set HBox              25.0
    set HSmallBox         15.0
    set BordY             50.0
    set BordX             200.0
    set EcartY            10.0
    set YTypeDeBlast      [expr $BordY/4]
    set YNomQuery         [expr $BordY*2/3]
    set CentreX           [expr $LargeurMax/2]
    set XTexteGauche      [expr $BordX/2]
    set XTexteDroite      [expr $LargeurMax - $BordX/2]
    set YDebut            $BordY
    set YFin              [expr $YDebut + $HBox]
    set YTaille           [expr $YDebut + ($YFin - $YDebut)/2]
    set TailleMaxNomQuery 100
    set Police            "Courier 10"
    set ColorOutLine      "White"
    set ColorFillLine     "black"    
    set Rapport           [expr ($LargeurMax - 2 * $BordX) / $TailleQuery]

    set LesRegionsMasquees        [LesRegionsMasqueesDeLaQuery $FichierTFA  ]
    set LesPetitesRegionsDuBlast  [LesRegionsDuTabBlast        TabBlast]

    set OldDebutGdeRegion         0
    set OldFinGdeRegion           0
    set LesGdesRegionsDuBlast     {}
    set LesPetitesRegionsOccupees {}
    foreach LaPetiteRegion $LesPetitesRegionsDuBlast {
	set Pos            [lindex $LaPetiteRegion 0]
	set Frequence      [lindex $LaPetiteRegion 1]
	set Debut          [lindex $LaPetiteRegion 2]
	set Fin            [lindex $LaPetiteRegion 3]
	set DebutGdeRegion [lindex $LaPetiteRegion 4]
	set FinGdeRegion   [lindex $LaPetiteRegion 5]

	if {$FinGdeRegion < $DebutGdeRegion} {
	    set tmp $FinGdeRegion;set FinGdeRegion $DebutGdeRegion;set DebutGdeRegion $tmp
	}
	
	lappend LesPetitesRegionsOccupees [list "$Debut" "$Fin"]
	
	if {$OldDebutGdeRegion == $DebutGdeRegion && $OldFinGdeRegion == $FinGdeRegion} {continue}
	lappend LesGdesRegionsDuBlast [list "$DebutGdeRegion" "$FinGdeRegion"]
	set OldDebutGdeRegion $DebutGdeRegion
	set OldFinGdeRegion   $FinGdeRegion
    }
    foreach UneRegionMasquee $LesRegionsMasquees {
	set Debut [lindex $UneRegionMasquee 0]
	set Fin   [lindex $UneRegionMasquee 1]
	lappend LesPetitesRegionsDuBlast  [list "0" "N" "$Debut" "$Fin"]
	lappend LesPetitesRegionsOccupees [list         "$Debut" "$Fin"]
    }
    set LesRegionsVides [LesRegionsVidesDeLaListe $LesPetitesRegionsOccupees $TailleQuery]
    foreach UneRegionVide $LesRegionsVides {
	set Debut [lindex $UneRegionVide 0]
	set Fin   [lindex $UneRegionVide 1]
	lappend LesPetitesRegionsDuBlast [list "0" "0" "$Debut" "$Fin"]
    }

    set TousBIdAutorises 1
    if { $LesBIdsAutorises != "" } {
	set TousBIdAutorises 0
	foreach BId $LesBIdsAutorises {set BIdAutorise($BId) 1}
    }

    if {![info exists TabBlast(NbSubject)]} {Espionne "NbSubject n'existe pas" ; return ""}
    set NbSubjectDansBlast [set TabBlast(NbSubject)  ]
    set NomQuery           [set TabBlast(Query)      ]
    set TypeDeBlast        "[set TabBlast(TypeDeBlast)]: [set TabBlast(Database)]"
    set PetitNomQuery      $NomQuery
    if {$TailleMaxNomQuery < [string length $NomQuery]} { 
	set PetitNomQuery [string range $NomQuery 0 $TailleMaxNomQuery]
	append PetitNomQuery "..."
    }
    set EmpilementTotal 0
    set LesBIds {}
    for {set i 1} {$i <= $NbSubjectDansBlast} {incr i} {
	set BId    [set TabBlast($i)]
	if {$TousBIdAutorises || [info exists BIdAutorise($BId)]} {
	    lappend LesBIds $BId
	}
    }
    set LesBanquesId {}
    set i 0

    foreach BId $LesBIds {
	incr i
	if {$ExpectDeRef < [set TabBlast($BId,1,Expect)] || $NbSubject < $i} {break}
	set Access    [set TabBlast($BId,Access)   ]
       
	set EstCeUnDesOrga 0
	if {$LesOrganismesAEliminer != "" || $LesOrganismesAConserver != ""} {
	    foreach Orga  [LesOrganismesEnStock $BId $Access] {
		Espionne "$BId\t$Access\t$Orga"
		if {   $LesOrganismesAEliminer != "" && \
			[regexp -nocase $Orga [join $LesOrganismesAEliminer "\t"]]} {
		    set EstCeUnDesOrga 1
		    break
		}
		if {    $LesOrganismesAConserver != "" && \
			[regexp -nocase $Orga [join $LesOrganismesAConserver "\t"]]} {
		    set EstCeUnDesOrga 1
		    break
		}
	    }
	    if {!$EstCeUnDesOrga && $SelectedOrganism == "ToPreserve" } {continue}
	    if { $EstCeUnDesOrga && $SelectedOrganism == "ToEliminate"} {continue}
	}
	lappend LesBanquesId $BId
	
	set NbSegment [set TabBlast($BId,NbSegment)]
	set NMaxSubject 0
	for {set j 1} {$j <= $NbSegment} {incr j} {
	    set DQ [set TabBlast($BId,$j,DQ)]
	    set FQ [set TabBlast($BId,$j,FQ)]
	    set DS [set TabBlast($BId,$j,DS)]
	    set FS [set TabBlast($BId,$j,FS)]
	    if {$FQ < $DQ} {set tmp $FQ;set FQ $DQ;set DQ $tmp}
	    
	    set LesPetitesRegionsRecouvertes {}
	    set NMaxSegment 0
	    foreach UneRegion $LesPetitesRegionsDuBlast {
		set Frequence         [lindex $UneRegion 1]
		set DebutPetiteRegion [lindex $UneRegion 2]
		set FinPetiteRegion   [lindex $UneRegion 3]
		if {$Frequence == 0 || $Frequence == "N" } {continue}

		if {![info exists Empilement($DebutPetiteRegion,$FinPetiteRegion)]} {
		    set Empilement($DebutPetiteRegion,$FinPetiteRegion) 0
		}
		if {$DQ <= $DebutPetiteRegion && $FinPetiteRegion <= $FQ} {
		    incr Empilement($DebutPetiteRegion,$FinPetiteRegion)
		    if {$NMaxSegment <  [set Empilement($DebutPetiteRegion,$FinPetiteRegion)]} {
			set NMaxSegment [set Empilement($DebutPetiteRegion,$FinPetiteRegion)]
		    }
		    lappend LesPetitesRegionsRecouvertes $UneRegion
		}
	    }
	    foreach UneRegion $LesPetitesRegionsRecouvertes {
		set DebutPetiteRegion [lindex $UneRegion 2]
		set FinPetiteRegion   [lindex $UneRegion 3]
		set Empilement($DebutPetiteRegion,$FinPetiteRegion) $NMaxSegment
	    }
	    set PosYSurEtagereDe($BId,$j) [expr $EmpilementTotal + $NMaxSegment] 
	    if {$NMaxSubject < $NMaxSegment} {set NMaxSubject $NMaxSegment}
	}
	set EmpilementTotal [expr $EmpilementTotal + $NMaxSubject]
	foreach UneRegion $LesPetitesRegionsDuBlast {
	    set Frequence         [lindex $UneRegion 1]
	    set DebutPetiteRegion [lindex $UneRegion 2]
	    set FinPetiteRegion   [lindex $UneRegion 3]
	    if {$Frequence == 0 || $Frequence == "N" } {continue}
	    unset Empilement($DebutPetiteRegion,$FinPetiteRegion)
	}
    }
    set HauteurMax [expr 2 * $BordY + $HBox +  $EmpilementTotal * ($EcartY + $HSmallBox)]
    if {$HauteurMax < $HauteurFenetre} {
	set HauteurFenetre $HauteurMax
    }

    #rR Creation du Svg ********************************************************************************
    if {$PourSvg} {
	set K    "CanvaAsSvg"
	set Bind "BindSvg"
	set BoutonneLaFenetre "BoutonneLaFenetreSvg"
	$K create svg $LargeurMax $HauteurMax $FichierBlast
    } else {
	set K    [UnCanva $LargeurMax $HauteurMax $LargeurFenetre $HauteurFenetre]
	set Bind "bind"
	set BoutonneLaFenetre "BoutonneLaFenetre"
    }
    $K configure -background white 
    LesBanquesIdEnStock $K $LesBanquesId
    set Milieu [expr $LargeurMax/2]

    FormateLesCoordonnees Milieu XTexteGauche XTexteDroite YTypeDeBlast YNomQuery YTaille YTaille

    $K create text $Milieu       $YTypeDeBlast -text "$TypeDeBlast"   -font "$Police" -tags [list common "$FichierBlast" "" "" "AvecTypeDeBlast"]
    $K create text $Milieu       $YNomQuery    -text "$PetitNomQuery" -font "$Police" -tags [list common "$FichierBlast" "" "" "AvecNomQuery"]
    $K create text $XTexteGauche $YTaille      -text "1"              -font "$Police" -tags [list common "$FichierBlast" "" "" "Avec1"]
    $K create text $XTexteDroite $YTaille      -text "$TailleQuery"   -font "$Police" -tags [list common "$FichierBlast" "" "" "AvecTailleQuery"]
    
    foreach UneRegion [lsort -increasing -integer -index 2 $LesPetitesRegionsDuBlast] {
	set Frequence [lindex $UneRegion 1]
	set Debut     [lindex $UneRegion 2]
	set Fin       [lindex $UneRegion 3]
	set XDebut    [expr $BordX + $Debut * $Rapport ]
	set XFin      [expr $BordX + $Fin   * $Rapport ]
	set ColorFill [ColoriageDeLaFrequence $Frequence]
	set PositionX($Debut) $XDebut
	set PositionX($Fin)   $XFin
	set ColorFill [HtmlCompatibleColor $ColorFill]
	FormateLesCoordonnees XDebut YDebut XFin YFin
	$K create rectangle $XDebut $YDebut $XFin $YFin -outline $ColorFill -fill $ColorFill -tags [list query "$FichierBlast" "$Frequence" "" "AvecQueryFrequence"]
    }
    
    set YIni [expr $BordY + $HBox + $EcartY]
    set m 0
    foreach BId       [LesBanquesIdEnStock $K] {
	set NbSegment [set TabBlast($BId,NbSegment)  ]
	set Expect    [set TabBlast($BId,1,Expect)   ]
	set Subject   [set TabBlast($BId,SubjectBrut)]
	set TailleSbjct [set TabBlast($BId,Taille)   ]
	for {set j 1} {$j <= $NbSegment} {incr j} {
	    set DQ             [set TabBlast($BId,$j,DQ)]
	    set FQ             [set TabBlast($BId,$j,FQ)]
	    set AlignementBrut [set TabBlast($BId,$j,AlignBrut)]
	    set TypeRegion     [set TabBlast($BId,$j,Orientation)]
	    
	    if {$FQ < $DQ} {set tmp $FQ;set FQ $DQ;set DQ $tmp}
	    if {$TypeRegion == "" && [regexp "BLASTP" $TypeDeBlast]} {set TypeRegion "Prot / Prot"}
	    set ColorFill [ColoriageDuMapping $TypeRegion]
	    set ColorFill [HtmlCompatibleColor $ColorFill]
	    set n [set PosYSurEtagereDe($BId,$j)]
	    
	    set YDebut [expr $YIni + $n * ($EcartY + $HSmallBox)]
	    set YFin   [expr $YDebut + $HSmallBox]
	    set XDebut [set PositionX($DQ)]
	    set XFin   [set PositionX($FQ)]
	    FormateLesCoordonnees XDebut YDebut XFin YFin
	    $K create rectangle $XDebut $YDebut $XFin $YFin -outline black -fill $ColorFill -tags [list "$BId-$j" "$FichierBlast" "$AlignementBrut" ""         "AvecAlignement"]
	}
	set XDebutLine 0
	set XFinLine   $LargeurMax
	set n          [set PosYSurEtagereDe($BId,1)]
	set YLine      [expr $YIni + $n * ($EcartY + $HSmallBox) - $EcartY/2]
	set YTexte     [expr $YIni + $n * ($EcartY + $HSmallBox) + $HSmallBox /2]       
	
	FormateLesCoordonnees XDebutLine YLine XTexteGauche YTexte XTexteDroite 

	$K create line $XDebutLine $YLine $XFinLine $YLine -fill $ColorFillLine
	$K create text $XTexteGauche $YTexte -text "$BId"                 -font "$Police"   -tags [list "$BId" "$FichierBlast" ""                "$Subject" "AvecAccess"    ]
	$K create text $XTexteDroite $YTexte -text "$TailleSbjct $Expect" -font "$Police"   -tags [list "$BId" "$FichierBlast" ""                ""         "AvecSubject"   ]
    }
    
    regsub {\.canvas} $K "" w
    if {[info exists Nom]} {
	set B [$BoutonneLaFenetre $w "BLAST\nShow / Browse  / Other"]
	$Bind $B <1>     "AfficheFichier $FichierBlast AvecSegAlignementAvecAligneurs"
	$Bind $B <2>     "IllustreLeBlast \[ButineArborescence\]"
	$Bind $B <3>     "IllustreLeBlast \[ChoisirUnBlast $Nom\]"
    } else {
	set B [$BoutonneLaFenetre $w "BLAST\nShow / Browse"]
	$Bind $B <1>     "AfficheFichier $FichierBlast AvecSegAlignementAvecAligneurs"
	$Bind $B <2>     "IllustreLeBlast \[ButineArborescence\]"
    }
    set C [$BoutonneLaFenetre $w "APPEARANCES\nColor Subject/Query\nDefault" ]
    $Bind $C <1>         "CouleursDesBoites"
    $Bind $C <2>         "CouleursDesFrequences"
    $Bind $C <Shift-1>   "IllustreLeBlast $FichierBlast  $ExpectDeRef $NbSubject \[LesBanquesIdEnStock $K UnSet\]"
    
    set S [$BoutonneLaFenetre $w "OPTIONS\nNbSubject 250 / x  /NoLimit\nExpect    1e-3/ x  /NoLimit\nOrga      Keep/Elim/Default"]
    $Bind $S <1>         "IllustreLeBlast $FichierBlast  $ExpectDeRef {}         \[LesBanquesIdEnStock $K\]"
    $Bind $S <2>         "IllustreLeBlast $FichierBlast  $ExpectDeRef \[Entre\]  \[LesBanquesIdEnStock $K\]"
    $Bind $S <3>         "IllustreLeBlast $FichierBlast  $ExpectDeRef NoLimit     {}"
    $Bind $S <Shift-1>   "IllustreLeBlast $FichierBlast  {}           $NbSubject \[LesBanquesIdEnStock $K\]"
    $Bind $S <Shift-2>   "IllustreLeBlast $FichierBlast  \[Entre\]    $NbSubject \[LesBanquesIdEnStock $K\]"
    $Bind $S <Shift-3>   "IllustreLeBlast $FichierBlast  NoLimit      $NbSubject {}"
    $Bind $S <Control-1> "IllustreLeBlast $FichierBlast  $ExpectDeRef $NbSubject \[LesBanquesIdEnStock $K\] ToPreserve"
    $Bind $S <Control-2> "IllustreLeBlast $FichierBlast  $ExpectDeRef $NbSubject \[LesBanquesIdEnStock $K\] ToEliminate"
    $Bind $S <Control-3> "IllustreLeBlast $FichierBlast  $ExpectDeRef $NbSubject"    
    
    $K bind "AvecAccess"     <1> "MappingDeLaSelection    $K"
    $K bind "AvecAccess"     <2> "SubjectDeLaSelection    $K"
    $K bind "AvecAccess"     <3> "FetchDeLaSelection      $K"
    $K bind "AvecSubject"    <1> "MappingDeLaSelection    $K"
    $K bind "AvecSubject"    <2> "SubjectDeLaSelection    $K"
    $K bind "AvecSubject"    <3> "FetchDeLaSelection      $K"
    $K bind "AvecAlignement" <1> "AlignementDeLaSelection $K"
    $K bind "AvecAlignement" <2> "SubjectDeLaSelection    $K"
    $K bind "AvecAlignement" <3> "FetchDeLaSelection      $K"
    
    if {$PourSvg} {
	$K close svg
	return [$K ContentOf svg]
    }
    
    regexp {^\.[^\.]+} $K w
    regsub {.canvas$} $K ".buttons.dismiss" BoutonDismiss
    $BoutonDismiss configure -command "LesBanquesIdEnStock $K UnSet ;destroy $w"
    return $K
}


proc RRParseSvg {{FichierSvg ""} {FichierSvgOut ""}} {
    if {[regexp "\n" $FichierSvg]} {
	set Texte $FichierSvg
	set FichierSvg "FromText"
	if {$FichierSvgOut==""} { set FichierSvgOut "GetSvg" }
    } else {
	if {$FichierSvg   ==""} { set FichierSvg "/genomics/link/CilioCarta2014/CanvasToSvgFile.svg" }
	if {$FichierSvgOut==""} {
	    set FichierSvgOut $FichierSvg
	    regsub ".svg$" $FichierSvgOut "" FichierSvgOut
	    append FichierSvgOut "_Out.svg"
	}
	set Texte [ContenuDuFichier $FichierSvg]
    }
    set Svg [ValeurDeLaBalise "svg" Texte "NePasRogner" AttSvg]
    set SvgOut $Texte
    regsub -all "\{>" $Svg "\{@" Svg
    #    Espionne $AttSvg
    while 1 {
	set B [ProchaineBalise Svg Att "Rogner"]
#	Espionne "[string length $Svg] Balise=$B Att: $Att :::::::::::::::::::::::::::"
#	Espionne $B
	if {[regexp { id='([^']+)'} $Att Match ID]} {
	    set LesChampsDuId $ID
#	    Espionne "Pour la balise <$B> LesChamps"
#	    EspionneL $LesChampsDuId
	    lassign $LesChampsDuId Acc FichierBlast AliBrut Subject Type
	    set dMatch [string first [string range $Match 0 10] $SvgOut]
	    set fMatch [expr $dMatch + [string length $Match]]

	    set SvgOut [string replace $SvgOut $dMatch $fMatch " id='${Type}_$Acc' class='$Type' data-alibrut='$AliBrut' data-subject='$Subject' "]
#	    if {[incr i]>3} { Espionne $SvgOut;  exit }
	}
	if {$B==""} { break }
    }
    regsub -all "='@" $SvgOut "='>" SvgOut
    if {$FichierSvgOut=="GetSvg"} { return $SvgOut }
    return [Sauve $SvgOut dans $FichierSvgOut ]
}


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