The Wayback Machine - http://web.archive.org/web/20140416002426/http://wfr.tcl.tk:80/1326

## TtcReader : lecteur de fichier .TTC

Le format .TTC est un fichier texte enregistant le contenu d'un widget "text" de Tk, avec son contenu.

TtcReader permet d'afficher de tels fichiers. Il ne s'agit que d'un petit logiciel de démonstration pour .TTC.

TtcReader est un éditeur basique qui peut modifier le texte mais pas le contenu des widgets embarqués dedans.

     #!/bin/bash
    	  # lancement de l'interpréteur wish\
    	  exec wish "$0" "${1+"$@"}"

    	package require Tk
     # ______________________________

     # 							TTCReader
     # Lecteur de fichier texte au format TTC (TousTags Compris )
     #_______________________________

     source TTC.tcl

     wm title . "Lecteur Ttc *** TtcReader "
     frame .f
     pack .f  -fill x
     frame .f2
     pack .f2  -fill both -expand true

     button .f.ouvrir -text "ouvrir un fichier .ttc" -command {destroy .f2.texttc ; text .f2.texttc -bg ivory -xscrollcommand {.f2.scrolx set}  -yscrollcommand {.f2.scroly set} -wrap none ;pack .f2.texttc -fill both -expand true -side left ; loadTTCfile .f2.texttc }
     pack .f.ouvrir -fill x -expand true -side left

     button .f.sauver -text "sauver un fichier en .ttc" -command { saveTagsAndText .f2.texttc }
     pack .f.sauver  -fill x -expand true -side left

     scrollbar .f2.scrolx  -orient horizontal -command {.f2.texttc xview}
     pack .f2.scrolx -side bottom  -fill x

     scrollbar .f2.scroly -orient vertical -command {.f2.texttc yview}
     pack .f2.scroly -side right  -fill y

     text .f2.texttc -bg ivory -xscrollcommand {.f2.scrolx set}  -yscrollcommand {.f2.scroly set} -wrap none
     pack .f2.texttc -fill both -expand true -side left

fichier TTC.tcl à copier au niveau de TtcReader pour le sourcer

      #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
     #<PROCEDURES_TTC>

     # Le format TTC permet de sauvegarder dans un fichier texte les indications de mise en page d'un texte d'un widget "text" de tcl-tk
     # les configurations des tags sont récupérées par la procédure dumptags,
     # le texte et ses tags le sont par la commande dump
     # il en est de même des indications d'image
     # les widgets sont non seulement sauvegardés, mais leur contenu éditable l'est aussi

     # la procédure "undump" permet de réafficher le texte avec son formatage
     # à  partir du résultat de la commande "dump"
     # et de la procédure "dumptags"
     # et de la procédure "dumpwindows"

     variable ttcFile ;  # Il importe de définir une variable ''ttcFile'' afin de connaitre le nom du fichier ttc pour les sauvegardes rapides.

     variable saveFlag 0 ;  # la variable saveflag est prévue pour distinguer une fonction "Save" d'une fonction  "Save As..."

     variable fenetre "" ; 	# la variable fenetre est INDISPENSABLE
    				  # pour que la proc undump relise les "contenu" sur plusieurs niveaux d'imbrication des widgets.

     proc undump {w content} {
     variable ttcFile

     variable fenetre
     set fenetre $w

    	foreach {type value pos } $content {
    		switch -- $type {
    			variable {variable $value $pos}
    			text {$w insert $pos $value}
    			image {$w image create  $pos -image [image create photo -file [file join [file dirname $ttcFile ] $value]] -name  $value}
    			tag {eval [list $w tag configure $value] $pos }
    			tagon {set on($value) $pos}
    			tagoff {$w tag add $value $on($value) $pos ; unset on($value) }
    			mark  {$w mark set $value $pos }
    			window { 	set suffix [lindex [split $value .]  [expr [llength [split $value .] ] -1]  ]
    		 		catch [$w window create $pos -window $w.$suffix]				}
    			Dwindow { variable fenetre ;
    					undumpdraw $fenetre $pos 					}

    			Button {eval [concat "button" $w.$value  $pos ]  }
    			Checkbutton  {eval [concat "checkbutton"  $w.$value  $pos ] }
    			Canvas  {variable fenetre ; eval [concat "canvas"  $w.$value  $pos ] ;set fenetre $w.$value }
    			Entry {eval [concat "entry" $w.$value  $pos ] }
    			Frame  {eval [concat "frame" $w.$value  $pos ] }
    			Label  {eval [concat "label" $w.$value  $pos ] }
    			Listbox  {eval [concat "listbox" $w.$value  $pos ] }
    			Menubutton {eval [concat "menubutton"  $w.$value  $pos ] }
    			Message {eval [concat  "message"  $w.$value  $pos ] }
    			Radiobutton  {eval [concat "radiobutton"  $w.$value  $pos ] }
    			Scale  {eval [concat  "scale"  $w.$value  $pos ] }
    			Scrollbar  {eval [concat  "scrollbar"  $w.$value  $pos ] }
    			Spinbox  {eval [concat "spinbox"  $w.$value  $pos ] }
    			Text  {variable fenetre; eval [concat "text"  $w.$value  $pos ] ; set fenetre $w.$value}
    			contenu {variable fenetre ; 	undump $fenetre  $pos ; }
    			draw {variable fenetre  ; undumpdraw $fenetre $pos}

    		}
    	}

     }

     proc undumpdraw {w content } {
     variable fenetre
     variable ttcFile

    	foreach {type value pos } $content {
    		switch -- $type {

    			Button {eval [concat "button" $w.$value  $pos ]  }
    			Checkbutton  {eval [concat "checkbutton"  $w.$value  $pos ] }

    			Canvas  {variable fenetre; eval [concat "canvas"  $w.$value  $pos ] ;			}
    			Dwindow {		undumpdraw $w.[lindex [split $value .] end ] $pos }

    			Entry {eval [concat "entry" $w.$value  $pos ] }
    			Frame  {eval [concat "frame" $w.$value  $pos ] }
    			Label  {eval [concat "label" $w.$value  $pos ] }
    			Listbox  {eval [concat "listbox" $w.$value  $pos ] }
    			Menubutton {eval [concat "menubutton"  $w.$value  $pos ] }
    			Message {eval [concat  "message"  $w.$value  $pos ] }
    			Radiobutton  {eval [concat "radiobutton"  $w.$value  $pos ] }
    			Scale  {eval [concat  "scale"  $w.$value  $pos ] }
    			Scrollbar  {eval [concat  "scrollbar"  $w.$value  $pos ] }
    			Spinbox  {eval [concat "spinbox"  $w.$value  $pos ] }
    			draw {variable fenetre  ; undumpdraw $w.[lindex [split $value .] end] $pos}

    				arc {eval $w create arc $value $pos }
    				line {eval $w create line $value $pos }
    				rectangle {eval $w create rectangle $value $pos}
    				polygon {eval $w create polygon $value $pos}
    				oval {eval $w create oval $value $pos}
    				text {eval $w create text $value $pos }
    				image {tk_messageBox -message pos=$pos ;$w  create image $value -image [image create photo -file [file join [file dirname $ttcFile ] [lindex $pos end] ]] }
    				bitmap {eval $w create bitmap $value $pos}
    				window {variable fenetre ; 	eval $w create window $value -window $w.[ lindex [split  [lindex $pos 1] . ] end ]		}

    			}
    			}
     }

     proc dumpcanvas w {

    	set res {}

    	foreach element [$w find all]  {
    	set items {}
    		foreach option [$w itemconfigure $element] {
    			 if {[string compare [lindex $option 0]  -image] ==0} {
    			tk_messageBox -message "procDumpCanvas image element=$element "
    			set iname [ $w itemcget $element -image]
    				if { [lindex $option 3] ne [lindex $option 4]} {
    				lappend items [lindex $option 0] [lindex [split [lindex [lindex [$iname configure] 2] end] / ] end ] ;
    				}
    			} else {
    				if { [lindex $option 3] ne [lindex $option 4]} {
    				lappend items [lindex $option 0] [lindex $option 4]
    				}
    				}
    				}

    		if [llength $items] {lappend res [$w type $element] [$w coord $element] $items }

    	}
      	return $res

     }

     proc dumptags w {
    	set res {}
    	foreach tagName [$w tag names] {
    		set items {}
    		foreach balise [$w tag configure $tagName] {
    			if { [lindex $balise 3] ne [lindex $balise 4]} {
    				lappend items [lindex $balise 0] [lindex $balise 4]
    			}
    		}
    		if [llength $items] {lappend res tag $tagName $items}
    	}
    	set res
     }

     proc dumpwindows w  {
    	# il faut retrouver dans cette proc un shema semblable à  dumptags : trois chaines dans une liste.

    	set res {}
    	foreach widget [winfo children $w] {
    		set suffix [lindex [split $widget .] [ expr [llength [split $widget .] ] - 1 ] ]

    		set items {}
    		foreach opti [$widget configure] {
    			if { [lindex $opti 3] ne [lindex $opti 4]} {
    				lappend items [lindex $opti 0] [lindex $opti 4]
    			}
    		}
    		if [llength $items] {lappend res [winfo class $widget]  $suffix  $items}

    		if {[string compare  [winfo class $widget]  Entry] == 0} {
    			foreach {opt val } $items {
    				if {[string compare $opt "-textvariable"] == 0 } {
    				variable $val
    					lappend res variable $val [set $val]
    				}
     			}
    		}

    		if {[string compare  [winfo class $widget]  Text] == 0}  {
    		set contenu [dumptags $widget ]\n[dumpwindows $widget]\n[$widget dump 1.0 end]

    					lappend res contenu $widget  $contenu
    		}

    		if {[string compare  [winfo class $widget]  Canvas] == 0}  {

    		set contenu [dumpwindows $widget]
    		if {$contenu != ""} {
    		lappend res Dwindow  $widget  $contenu }

    		set draw [dumpcanvas $widget]
    		if {$draw != ""} {
    					lappend res draw $widget  $draw}

    		}
    	}

    	set res
     }

     proc saveTagsAndText { w } {
    		variable application
    		variable ttcFile

    		# Il importe d'avoir une variable ''ttcFile'' afin de connaitre le nom du fichier ttc pour les sauvegardes rapides.
    		# ceci n'est pas nécessaire si on supprime la distinction entre ''sauvegarder'' et ''sauvegarder sous...''

    		# la variable saveflag est prévue pour distinguer éventuellement une fonction "Save" d'une fonction  "Save As..."
    		variable saveFlag

    		set  types {
    		  {{Fichier TTC} {.ttc}} {{Fichier Texte} {.txt}} {{Tout fichier } {.*}}
    		}

     # si le fichier a déja été sauvegardé sous un nom, l'enregistrement se fait de manière transparente.
    		if {$saveFlag == 1} {
    			 set choix $ttcFile
    			 set idf [open $choix w]
    			set dumpie [dumptags $w ]\n[dumpwindows $w]\n[$w dump 1.0 end]
    			puts -nonewline $idf $dumpie
    		 	close $idf
    		tk_messageBox -message "le fichier $choix a bien été enregistré.
    		The file $choix is saved well. "
    			return
    		}

    		# sinon une boite tk_getSaveFile s'ouvre, pour choisir un nom de fichier :
    		if {$saveFlag==0} {
    				  set choix [ tk_getSaveFile \
    		-title " Sauvegarder sous ... / Save as ..." -defaultextension .ttc -filetypes $types] ;
    		set fichier $choix
    		} else {
    		  if [catch {set choix $fichier}] {
    			tk_messageBox -type ok -icon warning \
    				-message "Aucun fichier n'a encore été défini, utilisez :\n''Sauvegarder sous''.
    				Not yet defined file: use ''Save as ...''."
    			return
    		  }
    		}

    		if {$choix==""} {
    		  tk_messageBox -type ok -icon warning \
    			  -message "Erreur d'écriture ... le fichier n'a pas été enregistré.
    			Write error ... the file was not saved."
    		} else {
    		   set idf [open $choix w]

    		set dumpie [dumptags $w ]\n[dumpwindows $w]\n[$w dump 1.0 end]

    		  puts -nonewline $idf $dumpie
    		  close $idf
    		  set ttcFile $choix

    		set saveFlag 1

    		  }
    		}

     proc loadTTCfile w {

     variable ttcFile

     set  types {
    		  {{Fichier TTC} {.ttc}} {{Fichier Texte} {.txt}} {{Tout fichier } {.*}}
    		}

    	set choix [tk_getOpenFile  -defaultextension .ttc -filetypes $types]
    	set ttcFile $choix
    	if [ catch { open $choix } FIC ] {
    		  tk_messageBox -type ok -icon warning \
    			  -message "Impossible d'ouvrir le fichier $choix
    			The file $choix cannot be open."
    		  return 1
    		} else {

    		  set contenu [ read -nonewline $FIC ]
    		  regsub -all {\ {4}} $contenu "\t" contenu

    	undump $w $contenu

    		  close $FIC
    		  return 0
    		}

     }

     #Fin des procédures TTC
     #\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Exemple de fichier TTC qui peut être lu dans TtcReader ou Toutankamon.

Copier ce texte dans un notepad quelconque, et sauvegardez le en .txt ou .ttc. Ce fichier appelle une image canard.gif. Mettez une image GIF au même niveau que ce fichier texte et renommez la canard.gif.

tag sel {-background #c3c3c3 -elide {} -foreground #000000 -relief raised} tag (0)bg {-background #1cd9d9 -borderwidth {} -elide {}} tag (1)fg {-borderwidth {} -elide {} -foreground #d9d911} tag (0)Fonte {-borderwidth {} -elide {} -font {Helvetica 16 bold }} tag (1)bg {-background #181cd9 -borderwidth {} -elide {}} tag (1)Fonte {-borderwidth {} -elide {} -font {Helvetica 16 bold italic}} tag (2)bg {-background #d9112c -borderwidth {} -elide {}} tag (3)fg {-borderwidth {} -elide {} -foreground #d9d9e0} tag (3)bg {-background #d90cd9 -borderwidth {} -elide {}} tag (4)fg {-borderwidth {} -elide {} -foreground #d9d924} tag (2)Fonte {-borderwidth {} -elide {} -font {Times 20 bold roman}} tag (4)bg {-background #d9d920 -borderwidth {} -elide {}} tag (5)fg {-borderwidth {} -elide {} -foreground #060973} tag (3)Fonte {-borderwidth {} -elide {} -font {TkFixedFont 16 bold }} tag (4)Fonte {-borderwidth {} -elide {} -font {TkFixedFont 24 bold italic}} tag (5)bg {-background #1461d9 -borderwidth {} -elide {}} tag (6)fg {-borderwidth {} -elide {} -foreground #d9d941} tag (5)Fonte {-borderwidth {} -elide {} -font {{Times New Roman} 20 bold italic}} tag (6)Fonte {-borderwidth {} -elide {} -font {Times 16 bold roman}} Label label0 {-background red -borderwidth 3 -foreground yellow -relief raised -text {ceci est un "label"}} Button button0 {-background yellow -borderwidth 3 -command {tk_messageBox -message {Bravo! vous avez bien appuyé.}} -foreground black -text {ceci est un bouton: appuyez!}} Canvas canvas0 {-background salmon -borderwidth 3 -closeenough 1.0 -height 252 -relief raised -width 450} draw .f2.t.canvas0 {line {90.0 90.0 150.0 90.0} {-smooth true -width 25.0} line {50.0 90.0 150.0 120.0} {-arrow both -smooth true -tags current -width 15.0} line {17.0 400.0 35.0 25.0} {-arrow both -fill red -smooth true -width 8.0} text {290.0 200.0} {-anchor ne -font {helvetica 14 bold italic underline} -text {text de dessin non éditable}}} text {Ceci est une exemple de fichier au } 1.0 tagon (1)bg 1.35 tagon (0)Fonte 1.35 tagon (1)fg 1.35 tagon (0)bg 1.35 text format 1.35 tagoff (0)bg 1.41 tagoff (1)fg 1.41 tagoff (0)Fonte 1.41 tagoff (1)bg 1.41 text { .TTC, qui est un fichier texte qui incorpore des } 1.41 tagon (1)Fonte 1.91 text co 1.91 tagon (3)fg 1.93 tagon (2)bg 1.93 text mm 1.93 tagoff (2)bg 1.95 tagoff (3)fg 1.95 text andes 1.95 tagoff (1)Fonte 1.100 text { tcl/Tk. } 1.100 window .f2.t.label0 2.0 text { et conjointement } 2.1 window .f2.t.button0 2.19 text { mais un dessin, nommé } 2.20 tagon (2)Fonte 2.43 tagon (4)fg 2.43 tagon (3)bg 2.43 text canvas 2.43 tagoff (3)bg 2.49 tagoff (4)fg 2.49 tagoff (2)Fonte 2.49 text { en langage tcl/Tk est aussi insérable: } 2.49 text { } 3.0 window .f2.t.canvas0 4.0 text {et bien sur n'importe} 4.1 mark tk::anchor1 4.22 tagon sel 4.22 text { quoi d'autr} 4.22 mark current 4.34 text e, 4.34 tagoff sel 4.36 mark insert 4.36 text { sauf les } 4.36 tagon (3)Fonte 4.46 tagon (5)fg 4.46 tagon (4)bg 4.46 text menus 4.46 tagoff (4)bg 4.51 tagoff (5)fg 4.51 tagoff (3)Fonte 4.51 text { qui sont réfractaire à } 4.51 tagon (4)Fonte 4.75 text TTC 4.75 tagoff (4)Fonte 4.78 text {. } 4.78 image canard.gif 5.0 text { et comme on le voit un fichier image } 5.1 tagon (5)Fonte 5.40 tagon (6)fg 5.40 tagon (5)bg 5.40 text gif 5.40 tagoff (5)bg 5.43 tagoff (6)fg 5.43 tagoff (5)Fonte 5.43 text { } 5.43 tagon (6)Fonte 5.44 text {se charge sans problèmes.} 5.44 tagoff (6)Fonte 5.69 text { } 5.69 text { } 6.0 text { } 7.0 text { } 8.0 text { } 9.0

voir aussi :

TTC : sauvegarder les tags et les images avec le texte d'un widget text

TouTanKamon : éditeur de texte .TTC