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

proc MsfToHtml {{FichierMsf ""} {FichierHtml ""}} {
    if {$FichierMsf==""} { set FichierMsf [ButineArborescence "All" "."] }
    if {$FichierMsf==""} { return "" }

    if {$FichierHtml=="-"} {
	set RetourNom   0
	set RetourTexte 1
	set FichierHtml "[TmpFile].html"
    }
    if {$FichierHtml==""} {
	set RetourNom   1
	set RetourTexte 0
	set FichierHtml [FichierPourSaveAs [TmpFile].html]
    }

    set FichierDump "[TmpFile].dumpordali"

    exec ordali -MSF $FichierMsf -Batch -NoCheckSeq -Groupe secator -Dump $FichierDump -Run -Exit
    if { ! [file exists $FichierDump]} { return "Problem" }
    HtmlOrdali $FichierDump $FichierHtml
    if {$RetourTexte} { return [ContenuDuFichier $FichierDump] }
    if {$RetourNom}   { return $FichierHtml }
    return
}

proc HtmlOrdali {{FichierDump ""} {FichierHTML ""}} {
    if {$FichierDump==""} {
	FaireLire "Please browse for the DumpOrdali file"
	set FichierDump [ButineArborescence "All" [pwd]]
    }
    if {$FichierDump=="" || ![file exists $FichierDump]} { return "" }
    return [FromDumpOrdaliToCanvasOrHtml [ContenuDuFichier $FichierDump] $FichierHTML]
}

proc Tagon {Value Index K} {
    global CouleurTag
    set CouleurTag $Value
}

proc Tagoff {Value Index K} {
    global CouleurTag
    set CouleurTag "CouleurTagParDefaut"
}

proc CouleurOrdali {ActionOuFB {LesCouleurs ""} {aTexteHTML ""}} {
    global CouleurTag
    global CouleurOrdali
    global CodeSpanOrdali
    if {$aTexteHTML!=""} { upvar $aTexteHTML TexteHTML }

    Wup "Initializes Couleurs if LesCouleurs not empty" 
    Wup "Returns the fg or bg colocouleurordr associated to the current Tag CouleurTag"
    Wup "Ordali uses Couleurs, Gscope uses Couleurs to create CouleurOrdali"

    if {$LesCouleurs!=""} {
	set LesTags [list CouleurTagParDefaut]
	set CouleurOrdali(CouleurTagParDefaut,fg) "black"
	set CouleurOrdali(CouleurTagParDefaut,bg) "white"
	foreach TexteCouleur $LesCouleurs {
	    ScanLaListe [split $TexteCouleur " "] Tag Fore Back
	    lappend LesTags $Tag
	    if {$Fore==""} { set Fore [set CouleurOrdali(CouleurTagParDefaut,fg)] }
	    if {$Back==""} { set Back [set CouleurOrdali(CouleurTagParDefaut,bg)] }
	    set CouleurOrdali($Tag,fg) $Fore 
	    set CouleurOrdali($Tag,bg) $Back
	}
    }
    set CodeSpan ""
    if {$ActionOuFB=="CreateHTML"} {
	append TexteHTML "\n<style type=\"text/css\">"
	append TexteHTML "\nPRE {font-size: 0.75em}"	
	foreach Tag $LesTags {
	    set Fore [set CouleurOrdali($Tag,fg)]
	    set Back [set CouleurOrdali($Tag,bg)]
	    set CodeSpan [NextALPHA $CodeSpan]
	    set CodeSpanOrdali($Tag) $CodeSpan
	    set CouleurOrdali($CodeSpan,fg) $Fore
	    set CouleurOrdali($CodeSpan,bg) $Back
	    append TexteHTML "\n  .$CodeSpan {background-color:$Back;color:$Fore}"
	}
	append TexteHTML "\n</style>\n"
	return
    }


    set FB $ActionOuFB

    if {[info exists CouleurOrdali($CouleurTag,$FB)]} { return [set CouleurOrdali($CouleurTag,$FB)] }
    if {$FB=="fg"} { return "NoColor" }
    if {$FB=="bg"} { return "NoColor" }
    return "UnknownGround"
}

proc BelleGauche Texte {
    set BeauTexte [format "%-12s  " $Texte]
    if {[regexp -nocase {[a-z]} $BeauTexte]} {
	set TexteHTML "<A HREF=http://igbmc.u-strasbg.fr/srs6bin/cgi-bin/wgetz?-newId+-e+\[\{SwissProt_SP_SpTrEmbl\}-id:$Texte\]+-view+SwissEntryView>$BeauTexte</A>" 
    } else {
	set TexteHTML $BeauTexte
    }
    return $TexteHTML
}

proc TextOnHTML {Value Index aTextOnHTML} {
    upvar $aTextOnHTML TextOnHTML
    global CouleurTag
    global CodeSpanOrdali
    global OldY
    global GaucheOrdali

    regsub -all {\{|\}} $Value "" Value

    regsub {\.} $Index " " XY
    scan $XY "%d %d" Y X

    if { ! [info exists OldY] || $Y!=$OldY} {
	append TextOnHTML "\n"
	set Gauche ""
	if {[info exists GaucheOrdali($Y)]} {
	    set Gauche [set GaucheOrdali($Y)]
	}
	append TextOnHTML [BelleGauche $Gauche]
    }
    set OldY $Y

    set CodeSpan [set CodeSpanOrdali($CouleurTag)]
    append TextOnHTML "<span class=$CodeSpan>$Value</span>"
    set PosY $Y
    set PosX [expr $X+[string length $Value]]
    return "$PosX $PosY"
}

proc TextOnCanva {Value Index K DecalX DecalY} {

    global CouleurTag

    regsub -all {\{|\}} $Value "" Value
    if {$Value == ""} { return "0 0"}


    Wup "Voir PrintOrdali ... pour compatibilite"
    set TailleFonte 10
    set OffsetLettre [font measure [list CourierNew $TailleFonte] Z]
    set HauteurLettre 14

    regsub {\.} $Index " " XY
    scan $XY "%d %d" Y X
    set x [expr ( $X + 2 + $DecalX)*$OffsetLettre ]
    set y [expr ( $Y + 1 + $DecalY)*$HauteurLettre]
    set FG [CouleurOrdali fg]
    set BG [CouleurOrdali bg]
    set fx [expr $x+[font measure [list CourierNew $TailleFonte] $Value]]
    set fy [expr $y+$HauteurLettre]

    if {$FG=="NoColor"} {
	set FG "black"
    }
    if {$BG!="NoColor"} {
	$K create rectangle $x $y $fx $fy -fill $BG -outline $BG
    }
    $K create text $x $y -text "$Value" -anchor nw -fill $FG -font [list CourierNew $TailleFonte]

    set PosX [expr round($fx/$OffsetLettre)]
    set PosY [expr round($fy/$HauteurLettre)]
    return "$PosX $PosY"
}

proc FromDumpOrdaliToCanvasOrHtml {Dump {KorH ""} {DecalX 0} {DecalY 0} {aExtremeX ""} {aExtremeY ""}} {
    global CouleurTag
    global GaucheOrdali

    if {$aExtremeX!=""} { upvar $aExtremeX ExtremeX }
    if {$aExtremeY!=""} { upvar $aExtremeY ExtremeY }
     
    set TexteHTML ""
    if {[regexp {^\.} $KorH] && ![regexp "/" $$KorH]} {
	set K $KorH
	set OnCanva 1
	set OnHTML  0
    } else {
	set FichierHTML $KorH
	set K ""
	if {$FichierHTML==""} { set FichierHTML "[TmpFile ordali].html" } 
	set OnCanva 0
	set OnHTML  1
    }

    set CouleurTag "CouleurTagParDefaut"

    set LeDump [split $Dump "\n"]

    set Fonte [ValeurDeLaBalise "font"  Dump "Rogner"]
    set Tags  [ValeurDeLaBalise "tags"  Dump "Rogner"]
    set Regle [ValeurDeLaBalise "regle" Dump "Rogner"]
    set Noms  [ValeurDeLaBalise "noms"  Dump "Rogner"]
    set Texte [ValeurDeLaBalise "texte" Dump "Rogner"]
    regsub -all "\n" $Regle "" Regle
    regsub -all "\n" $Noms  "" Noms
    regsub -all "\n" $Texte "" Texte
    eval set LesCouleurs [list $Tags]
    if {$OnCanva} { CouleurOrdali "Create" $LesCouleurs }
    if {$OnHTML } {
	append TexteHTML "<HTML><TITLE>Ordali</TITLE><HEAD></HEAD>"
	CouleurOrdali "CreateHTML" $LesCouleurs TexteHTML
	append TexteHTML "<Body>\n<PRE>"
    }

    set AttendFermante 0
    set ExtremeX $DecalX
    set ExtremeY $DecalY
    
    foreach {Action TexteDesToken} [list \
	    "Nommer" $Noms  \
	    "RegleH" $Regle \
	    "Taguer" $Texte \
	    "RegleB" $Regle ] {
	foreach Token [split $TexteDesToken " "] {
	    if {[regexp {\}$} $Token]} {
		set AttendFermante 0
		if {[info exists Mot]} {
		    append Mot " $Token"
		} else {
		    set Mot $Token
		}
	    }
	    if {$AttendFermante} {
		append Mot " $Token"
		continue
	    }
	    if { ! [info exists Mot] && [regexp {^\{} $Token]} {
		set AttendFermante 1
		set Mot $Token
		continue
	    }
	    
	    if { ! [info exists Mot]} {
		set Mot $Token
	    }
	    
	    if { ! [info exists Key]} {
		set Key $Mot
		unset Mot
		continue
	    }
	    if { ! [info exists Value]} {
		set Value $Mot
		unset Mot
		continue
	    }
	    set Index $Mot
	    
	    switch $Key {
		"tagon"   { Tagon  $Value $Index $K } 
		"tagoff"  { Tagoff $Value $Index $K } 
		"text"    {
		    if {$OnCanva} { set LoinXY [TextOnCanva $Value $Index $K $DecalX $DecalY]}
		    if {$OnHTML } {
			if {$Action=="RegleH"} { set Index [expr -$Index] }
			if {$Action=="RegleB"} { set Index [expr  $Index + 9999.0] }
			if {$Action=="Nommer"} {
			    set Y [expr int($Index)]
			    regsub -all -nocase {[^a-z0-9_]} $Value "" Nom
			    set GaucheOrdali($Y) $Nom
			} else {
			    set LoinXY [TextOnHTML  $Value $Index TexteHTML]
			    scan $LoinXY "%d %d" LoinX LoinY
			    set ExtremeX [Maxi $ExtremeX $LoinX]
			    set ExtremeY [Maxi $ExtremeY $LoinY]
			}
		    }
		} 
		"default" { }
	    }
	    unset Key Value Index Mot
	}
    }
    incr ExtremeX 1
    incr ExtremeY 1
    if {$OnHTML} {
	append TexteHTML "\n</PRE>\n</BODY>\n</HTML>"
	if {$FichierHTML=="RetourneTexteHTML"} {
	    return $TexteHTML
	} else {
	    return [Sauve $TexteHTML dans $FichierHTML]
	}
    }
    
    return $K
}

proc PrintOrdali w {
    global LongueurTotale Sequences

    set NombreDeSequences [array size Sequences]

    scan [$w.lessequences.scrollxseq get] "%f %f" xMin xMax
    scan [$w.lessequences.scrolly    get] "%f %f" yMin yMax

    set DebutX [Maxi 0 [expr int($LongueurTotale*$xMin)-1]]
    set FinX   [expr round($LongueurTotale*$xMax)]
    set DebutY [expr int($NombreDeSequences*$yMin)+1]
    set FinY   [expr round($NombreDeSequences*$yMax)+1]

    set DumpLesNoms  [$w.lessequences.textnomseq   dump -all $DebutY.0       $FinY.end]
    set DumpSequence {}
    for {set Y $DebutY} {$Y<=$FinY} {incr Y} {
	set DumpSequence [concat $DumpSequence [$w.lessequences.textsequence dump -all $Y.$DebutX $Y.$FinX]]
    }
    set DumpRegle {}
    foreach Y {1 2 3} {
	set DumpRegle    [concat $DumpRegle    [$w.lessequences.regle        dump -all $Y.$DebutX $Y.$FinX]]
    }    
    
    set K [UnCanva 1024 512]

    set DecalX 0
    set DecalY [expr -$DebutY]
    set K [FromDumpOrdaliToCanvasOrHtml $DumpLesNoms  $K $DecalX $DecalY RetDecalX RetDecalY]

    set DecalX [expr $RetDecalX-$DebutX+1]
    set K [FromDumpOrdaliToCanvasOrHtml $DumpSequence $K $DecalX $DecalY RetBidonX RetDecalY]

    set DecalY [expr $RetDecalY-2]
    set K [FromDumpOrdaliToCanvasOrHtml $DumpRegle    $K $DecalX $DecalY RetMaximX RetMaximY]

    Wup "Voir Text ... pour compatibilite"
    set TailleFonte 10
    set OffsetLettre [font measure [list Courier $TailleFonte] Z]
    set HauteurLettre 14
    set SizeX [expr $RetMaximX*$OffsetLettre]
    set SizeY [expr $RetMaximY*$HauteurLettre]
    $K configure -scrollregion [list 0 0 $SizeX $SizeY]
    $K configure -width $SizeX -height $SizeY
    set Id [$K find withtag "Cadre"]
    $K coords $Id 0 0 $SizeX $SizeY
    $K configure -background "white"
    
    return $K
}







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