#_______________________
#PhotoReducPlus
#version 2
#daniel MACOUIN 2007/2025
#licence NOL
# : pas plus d'obligations pour vous que pour moi !
#______________________

# ce programme est écrit en tcl/tk
# Il ne fait qu'une chose : 
# réduire ou agrandir les dimensions d'une image 
# selon un coefficient entier a choisir
# il y a deux coefficients, un pour la hauteur ,variable globale coefHauteur, et parallelement coefLargeur, les deux fixés à 3 par défaut.


package require Tk
  
  catch {package require Img}



#<variables_globales>
	global cheminPR
	set cheminPR [pwd]  
	
	global repertoire
	set repertoire ""
	
	global dossierReduc 
	set dossierReduc "" 
	
	global coefHauteur
	set coefHauteur 3
	
	global coefLargeur
	set coefLargeur 3
	
	global selecteur
	set selecteur R

#<interface>
wm title . "PhotoReducPlus"

option add .Button.activeBackground azure 

pack [frame .fa] -side left -expand true -fill both
pack [frame .fc -bg #808080] -side left -expand true -fill x
pack [frame .fb] -side left -expand true -fill both

pack [frame .fa.fr ] -side top -expand true -fill x
	pack [label .fa.fr.lmode -text "Images à choisir" -relief raise  -bg AliceBlue ]  -side left -expand true  
#£ 	pack [radiobutton .fa.fr.r1 -text "Rapide" -variable selecteur -value "R" ] -side left -expand true 
#£ 	pack [radiobutton .fa.fr.r2 -text "Ulis" -variable selecteur -value "U"  ] -side left -expand true 
pack [label .fa.label1 -text "REPERTOIRE SOURCE" -font {helvetica 10 bold } -fg white  -bg black -relief sunken -bd 6] -side top -expand true -fill x
pack [text .fa.repertoire -relief groove -bd 5 -width 30 -cursor hand1 -bg ivory -yscrollcommand ".fa.y set " ]  -side right -after .fa.label1 -expand true -fill both
pack [scrollbar .fa.y -orient v -command { .fa.repertoire yview }] -side right -expand true -fill y 

pack [frame .fb.f ] -side top -expand true -fill x
	set imgUndo [ image create photo -file [file join [file dirname  [info script] ] undo.gif] ]
	set imgRedo [ image create photo -file [file join [file dirname [info script] ] redo.gif] ]
	pack [button .fb.f.bu  -image $imgUndo -command Defaire -bg red] -side left 
	pack [button .fb.f.br  -image $imgRedo -command Refaire -bg red] -side left 
	
	pack [button .fb.f.bAbout -text " à propos... "  -relief raise  -bg AliceBlue  -command { AboutPhotoReduc } ] -side right  -expand true  
	pack [button .fb.f.bAide -text "   aide   "  -relief raise  -bg yellow  -command { AfficheAide } ] -side right -expand true  
	
pack [label .fb.label1 -text "PHOTOS A REDUIRE" -font {helvetica 10 bold} -fg white -bg black -relief sunken -bd 6] -side top -expand true -fill x
pack [text .fb.repR -relief groove -bd 5 -width 40 -bg ivory   -fg  HotPink  -yscrollcommand ".fb.y set "  -undo 1] -side left  -after .fb.label1 -expand true -fill both
pack [scrollbar .fb.y -orient v -command { .fb.repR yview }] -side left -expand true -fill y

pack [message .fc.m1 -text "PHOTO REDUC PLUS" -fg red -bg black -relief sunken -bd 9 -font {helvetica  16} ] -side top -expand true -fill x
pack [button .fc.b1 -bg AliceBlue  -text "Ouvrez un répertoire contenant vos photos à réduire" \
	-command { AllerRepertoire }	]  -side top  -expand true 
pack [label .fc.l1 -textvariable repertoire  -bg gray -fg yellow  -font {helvetica 10 bold}] -expand true -fill x -side top -after .fc.b1
pack [button .fc.b2  -bg AliceBlue -text "Ouvrez un répertoire pour sauver vos photos à réduites" -command { set dossierReduc [tk_chooseDirectory] } ]  -side top -expand true  
pack [label .fc.label2 -textvariable dossierReduc  -bg gray -fg yellow  -font {helvetica 10 bold}] -expand true -fill x -side top -after .fc.b2

pack [frame .fc.fChoixReduc  ] -expand true -fill x -side top -after .fc.label2 
pack [label .fc.fChoixReduc.labelCoefH -text "Coefficient hauteur" -bg black -fg white ] -side left -expand true -fill x  
pack [entry .fc.fChoixReduc.coefHauteur -textvariable coefHauteur -width 3  -relief sunken -bg AliceBlue ] -side left -expand true 
pack [label .fc.fChoixReduc.labelCoefL -text "Coefficient largeur" -bg black -fg white  ] -side right -expand true -fill x
pack [entry .fc.fChoixReduc.coefLargeur -textvariable coefLargeur -width 3  -relief sunken ] -side right -expand true 

#<objectif>
pack [canvas .fc.canvas0  -height 130 -width 200 -bg #808080 -borderwidth 5 -relief raise] -side top  -expand true
.fc.canvas0 create oval 50 10 160 120 -width 9 -fill ivory
.fc.canvas0 create oval 62 15 148 115 -width 9 -fill white
.fc.canvas0 create oval 105 45 130 95 -width 0 -fill LightBlue   
.fc.canvas0 create oval 95 25 122 100 -width 0 -fill white
.fc.canvas0 create line 10 10 10 129 -width 3 -fill LightBlue 
.fc.canvas0 create line 190 10 190 129 -width 3 -fill LightBlue
.fc.canvas0 create line 10 129 190 129 -width 3 -fill LightBlue

pack [frame .fc.info ] -expand true -fill x -side bottom
 
 #£ pack [message .fc.info.m2 -text "Cliquez sur chacun des  fichiers de la fenêtre de gauche que vous voulez reduire ou agrandir, ils s'inscriront dans la fenêtre de droite, toute la liste pourra alors subir la transformation " -font { helvetica 8}] -side bottom -fill x -expand true

pack [frame .fc.fbouton] -expand true -fill x -side bottom
pack [button .fc.fbouton.bVoir  -text " voir img origine "   -fg black -relief raise  -font {-weight bold} -command {AfficheVisu } ] -side left 
pack [button .fc.fbouton.bReduire -text " Reduire "  -fg black -relief raise  -font {-weight bold} -command { PhotoReduction} ] -side right
pack [button .fc.fbouton.bAgrandir  -text "Agrandir" -fg black  -relief raise -font {-weight bold} -command {PhotoAgrandir} ] -side right
 pack [label .fc.info.voyant -text " "  -relief sunken  -font {-weight bold}] -side right -fill x -expand true

#<PROCEDURES>

proc AllerRepertoire { } {
	global repertoire
	set repertoire [tk_chooseDirectory  -title [::msgcat::mc  "PhotoReduc: cd répertoire "]]
	.fa.repertoire delete 1.0 end
	set fichiers [glob -type f -directory $repertoire  * ]
	set j 0
	foreach i $fichiers {
	set k [file tail $i]
 	if { ([string compare [file extension $i ]  ".GIF" ] == 0) | ([string compare [file extension $i ]  ".gif" ] == 0) | ([string compare [file extension $i ]  ".jpg" ] == 0) | ([string compare [file extension $i ]  ".JPG" ] == 0) | ([string compare [file extension $i ]  ".JPEG" ] == 0) | ([string compare [file extension $i ]  ".jpeg" ] == 0) | ([string compare [file extension $i ]  ".png" ] == 0)} {
	.fa.repertoire tag configure selectFichier$j
		.fa.repertoire insert 1.0 "$k \n" selectFichier$j 
		.fa.repertoire tag bind selectFichier$j <Enter> ".fa.repertoire tag configure 	selectFichier$j  -background red -foreground yellow " 
			.fa.repertoire tag bind selectFichier$j <Leave> " .fa.repertoire tag configure 	selectFichier$j -background ivory -foreground black "  
		.fa.repertoire tag bind selectFichier$j <1> " .fa.repertoire tag configure 	selectFichier$j -background green -foreground black ; InsererChemin {$i} ; 	"	
 		}
	incr j
	}
  }

proc InsererChemin {chemin} {
	.fb.repR insert end $chemin
	.fb.repR insert end "\n"
	
	.fb.repR see end 
}

proc AfficheVisu { } {

destroy .foto
toplevel .foto 
wm title .foto "PhotoRduc : Visualisation des images originelles"

pack [scrollbar .foto.x -command {.foto.visu xview} -orient h] -side bottom  -fill x 
pack [text .foto.visu -yscrollcommand ".foto.y set "  -xscrollcommand ".foto.x set " ]  -side left -expand true -fill both 
pack [scrollbar .foto.y -command {.foto.visu yview} ] -side right  -fill y 

bind .foto <3> {destroy .foto} 

set textePremier [ .fb.repR get 1.0 end]
set listeFichiers [split $textePremier \n]

	foreach fichier $listeFichiers {
	set filename "$fichier"
	
	set foto [image create photo  -file "$filename"	]
	
	.foto.visu insert end "\n$filename \n"
	.foto.visu image create insert -image $foto -name FOTO
	}
}

proc Defaire {} {
	catch {.fb.repR edit undo}

	  }
	  
	  
proc Refaire {} {
	catch {.fb.repR edit redo}
	  }
	
#£ PROC ULIS a desactiver	
proc ConfirmerMode { } {
# permet d'arrêter le lancement de la reduction en mode ulis
#  gourmand en temps de traitement
global selecteur

  if {$selecteur eq "U" } {
 	set reponseBox 	[tk_messageBox -message "ATENTION !
	Le mode ULIS est très lent
	êtes vous certain de vouloir continuer" \
	-icon warning -type okcancel ]
	
	switch -- $reponseBox {
	cancel { return }
	ok {	
		PhotoReduction 
	}
		}
  } else {
	PhotoReduction 
	}
}


proc PhotoReduction { } {
# la boucle ouvre les images correspondant aux fichiers listés dans la fenêtre de gauche
# et les sauvegarde dans le repertoire préalablement déterminé
#  en les réduidsant au tiers.
global repertoire
global dossierReduc
global coefHauteur
global coefLargeur

#£ tk_messageBox -message " $coefHauteur \n $coefLargeur "
 global selecteur R


set couleur [.fc.info.voyant cget -background]
.fc.info.voyant configure -bg red
after 50
update
destroy .fotoR
toplevel .fotoR
wm title .fotoR "PhotoReduc : Images reduites  "
pack [text .fotoR.visu -yscrollcommand ".fotoR.y set " ]  -side left -expand true -fill both 
pack [scrollbar .fotoR.y -command {.fotoR.visu yview} ] -side right  -fill y 
bind .fotoR <3> {destroy .fotoR } 


set textePremier [ .fb.repR get 1.0 end]
set listeFichiers [lrange [split $textePremier \n] 0 end-2]

   foreach fichier  $listeFichiers  {
	set fotoSource [image create photo  -file $fichier	]	
	set fotoReduite [image create photo ] 
	
	if { $selecteur eq "R" } {
	$fotoReduite copy $fotoSource -subsample  $coefLargeur $coefHauteur 
	.fotoR.visu image create insert -image $fotoReduite -name FOTOREDUITE
	
		if { [string compare [file tail $fichier ]  "" ] ==1} {
			if { ( [file extension $fichier ] eq ".gif" ) |  ( [file extension $fichier ] eq ".GIF" ) } {
				$fotoReduite write [file join $dossierReduc "PR_[file tail $fichier]" ] -format GIF  
			} else {
				$fotoReduite write [file join $dossierReduc "PR_[file tail $fichier]" ] -format png ; #png a remplcé jpg qui devra etre reinclus pour les images jpeg
			}
		raise .fotoR.visu 
		}
	}  else {
			set coefUlis [expr 1.00 / $coefHauteur ]
			catch {set fotoReduite [shrink $fotoSource $coefUlis] }
	
		.fotoR.visu image create insert -image $fotoReduite -name FOTOREDUITE
	
		if { [string compare [file tail $fichier ]  "" ] ==1} {
			if { ( [file extension $fichier ] eq ".gif" ) |  ( [file extension $fichier ] eq ".GIF" ) } {
				$fotoReduite write [file join $dossierReduc "U_[file tail $fichier]" ] -format GIF  
			} else {
		$fotoReduite write [file join $dossierReduc "U_[file tail $fichier]" ] -format JPEG
	}
	}
	raise .fotoR.visu 
	}
  }
			
	.fc.info.voyant configure -bg green
update
after 1000
.fc.info.voyant configure -bg $couleur
}

proc PhotoAgrandir { } {
# la boucle ouvre les images correspondant aux fichiers listés dans la fenêtre de gauche
# et les sauvegarde dans le repertoire préalablement déterminé
#  en les réduidsant au tiers.
global repertoire
global dossierReduc
global coefHauteur
global coefLargeur

global selecteur R


set couleur [.fc.info.voyant cget -background]
.fc.info.voyant configure -bg red
after 50
update
destroy .fotoR
toplevel .fotoR
wm title .fotoR "PhotoReducPlus : Images agrandies "
pack [text .fotoR.visu -yscrollcommand ".fotoR.y set " ]  -side left -expand true -fill both 
pack [scrollbar .fotoR.y -command {.fotoR.visu yview} ] -side right  -fill y 
bind .fotoR <3> {destroy .fotoR } 


set textePremier [ .fb.repR get 1.0 end]
set listeFichiers [lrange [split $textePremier \n] 0 end-2]

   foreach fichier  $listeFichiers  {
	set fotoSource [image create photo  -file $fichier	]	
	set fotoPlus [image create photo ] 
	
	if { $selecteur eq "R" } {
	$fotoPlus copy $fotoSource -zoom $coefLargeur  $coefHauteur 
	.fotoR.visu image create insert -image $fotoPlus -name FOTOPlus
	
		if { [string compare [file tail $fichier ]  "" ] ==1} {
			if { ( [file extension $fichier ] eq ".gif" ) |  ( [file extension $fichier ] eq ".GIF" ) } {
				$fotoPlus write [file join $dossierReduc "GR_[file tail $fichier]" ] -format GIF 
			} elseif  { ( [file extension $fichier ] eq ".jpg" ) |  ( [file extension $fichier ] eq ".JPG" ) | ( [file extension $fichier ] eq ".jpeg" ) |  ( [file extension $fichier ] eq ".JPEG" ) } {
							$fotoPlus write [file join $dossierReduc "GR_[file tail $fichier]" ] -format JPG				
			} else {
				$fotoPlus write [file join $dossierReduc "GR_[file tail $fichier]" ] -format png ; #png a remplcé jpg qui devra etre reinclus pour les images jpeg
			}
		raise .fotoR.visu 
		}
	}  else {
			set coefUlis [expr 1.00 / $coefHauteur ]
			catch {set fotoPlus [shrink $fotoSource $coefUlis] }
	
		.fotoR.visu image create insert -image $fotoPlus -name FOTOPlus
	
		if { [string compare [file tail $fichier ] "" ] ==1} {
			if { ( [file extension $fichier ] eq ".gif" ) |  ( [file extension $fichier ] eq ".GIF" ) } {
				$fotoPlus write [file join $dossierReduc "U_[file tail $fichier]" ] -format GIF  
			} else {
		$fotoPlus write [file join $dossierReduc "U_[file tail $fichier]" ] -format JPEG
	}
	}
	raise .fotoR.visu 
	}
  }
			
	.fc.info.voyant configure -bg green
update
after 1000
.fc.info.voyant configure -bg AliceBlue 
}



#_____________ALGORITMES ULIS ____________________

# shrinking without transparency :  methode ULIS
#_________________________________________________

proc shrink {Image coef} 	{
	  # check coef
	  if {$coef > 1.0} \
	  { error "bad coef \"$coef\": should not be greater than 1.0" }
	  if {abs($coef - 1.0) < 1.e-4} { return $Image }
	  # get the old image content
	  set Width [image width $Image]
	  set Height [image height $Image]
	  if {$Width * $Height == 0} { error "bad image" }
	  # create corresponding planes
	  for {set Y 0} {$Y < $Height} {incr Y} \
	  {
		set r:Row {}
		set g:Row {}
		set b:Row {}
		for {set X 0} {$X < $Width} {incr X} \
		{
		  foreach {r g b} [$Image get $X $Y] break
		  foreach c {r g b} { lappend $c:Row [set $c] }
		}
		foreach c {r g b} { lappend $c:Data [set $c:Row] }
	  }
	  # compute the new image content
	  set width [expr {round($Width * $coef)}]
	  set height [expr {round($Height * $coef)}]
	  set ey 0
	  set Y2 0
	  set cy2 $height
	  for {set y 0} {$y < $height} {incr y} \
	  {
		set r:row {}
		set g:row {}
		set b:row {}
		# Y1 is the top coordinate in the old image
		set Y1 $Y2
		set cy1 [expr {$height - $cy2}]
		incr ey $Height
		set Y2 [expr {$ey / $height}]
		set cy2 [expr {$ey % $height}]
		if {$Y1 == $Y2} { set cy1 $cy2 }
		set ex 0
		set X2 0
		set cx2 $width
		for {set x 0} {$x < $width} {incr x} \
		{
		  set X1 $X2
		  set cx1 [expr {$width - $cx2}]
		  incr ex $Width
		  set X2 [expr {$ex / $width}]
		  set cx2 [expr {$ex % $width}]
		  if {$X1 == $X2} { set cx1 $cx2 }
		  # compute pixel
		  foreach c {r g b} { set $c 0; set _$c 0 }
		  for {set Y $Y1} {$Y <= $Y2} {incr Y} \
		  {
			# compute y coef
			switch $Y \
			  $Y1	 { set cy $cy1 } \
			  $Y2	 { set cy $cy2 } \
			  default { set cy $height }
			if {$cy == 0} { continue }
			if {$cy > $Height} { set cy $Height }
			for {set X $X1} {$X <= $X2} {incr X} \
			{
			  # compute x coef
			  switch $X \
				$X1	 { set cx $cx1 } \
				$X2	 { set cx $cx2 } \
				default { set cx $width }
			  if {$cx == 0} { continue }
			  if {$cx > $Width} { set cx $Width }
			  # weight each initial pixel by cx & cy
			  set cxy [expr {$cx * $cy / double($Width) / $Height}]
			  foreach c {r g b} \
			  {
				set comp [lindex [set $c:Data] $Y $X]
				incr $c [expr {round($comp * $cxy)}]
				set _$c [expr {[set _$c] + $cxy}]
			  }
			}
		  }
		  set _ {}
		  foreach c {r g b} \
		  {
			set comp [set $c]
			if {$comp > 255} { set comp 255 }
			lappend $c:row $comp
			lappend _ [set _$c]
		  }
		}
		foreach c {r g b} { lappend $c:data [set $c:row] }
	  }
	  # merge the planes
	  for {set y 0} {$y < $height} {incr y} \
	  {
		set row {}
		for {set x 0} {$x < $width} {incr x} \
		{
		  foreach c {r g b} { set $c [lindex [set $c:data] $y $x] }
		  lappend row [format #%02x%02x%02x $r $g $b]
		}
		lappend data $row
	  }
	  # create the new image
	  set image [image create photo]
	  # fill the new image
	  catch {$image put $data }
	  # return the new image
	  return $image
	}
#£ 	  # return the new image
#£ 	  return $image
#£ 	}
	
proc AboutPhotoReduc { } {
destroy .about
	toplevel .about  -bg pink 
	wm title .about "PhotoReduc info"
	wm geometry .about 160x250+250+250
	pack [text .about.t -bg AntiqueWhite	-wrap word -font "helvetica 12 bold "] -expand true -fill both
	.about.t insert end " 
PHOTOREDUC Plus
version 2	
Daniel MACOUIN .2007-2025
________________

Licence NOL :

 pas d'obligations,
 ni pour vous,
 ni pour moi.
________________"
	

	wm overrideredirect .about 1
	
	bind .about <Enter> {destroy .about}	
}


proc AfficheAide {} {
toplevel .aide
wm title .aide "AIDE de PhotoReduc "

pack [text .aide.texte -width 45 -bg lavender -relief sunken -bd 5 -yscrollcommand ".aide.y  set"  -wrap word -font {helvetica 13} ] -side left -expand true -fill both 
pack [scrollbar .aide.y -orient v -command {.aide.texte yview } ] -side left -before .aide.texte  -fill y -expand true
bind .aide <3> {destroy .aide }
.aide.texte insert end {

 Cette fenêtre se ferme par un clic! droit 
____________________

AIDE DE PHOTOREDUC 
____________________


PhotoReduc divise  ou multiplie par un nombre entier (trois par défaut) la taille des images au formats JPEG, PNG ou GIF.
	ATTENTION : ce programme écrit en TclTk nécessite le package Img pour reconnaitre le format jpeg. Si ce package est mal installé sur votre ordinateur, PhotoReduc ne pourra traiter que les images GIF ou PNG

PhotoReduc permet de préparer une liste d'images à réduire ou à agrandir à partir d'un ou plusieurs répertoires et d'effectuer en rafale la modification de dimensions.

* On ouvre un dossier où se trouvent des images, et la liste des fichiers JPEG, GIF, PNG s'inscrit ligne par ligne dans la fenêtre de gauche.

* En cliquant sur le nom d'un fichier, son chemin complet s'inscrit dans la fenêtre de droite.
* On peut renouveler l'opération en ouvrant d'autres dossiers. 

* On peut visualiser à tout moment les images choisies en cliquant sur ''VOIR IMG ORIGINE''.

* On peut supprimer une image de la liste comme on le ferait dans un traitement de texte ordinaire.
	
	>> On choisit le coefficient de modification désiré dans la petite lucarne prévue à cet effet. Par défaut il est sélectionné 3. 
	.	
	>> Quand la liste est établie, en cliquant sur "Agrandir" ou "Réduire" , on sauvegarde les images transformée dans le fichier préalablement choisi pour les accueillir. Les images réduite sont renommées avec le préfixe "PR", les agrandies avec le préfixe "GR"
		
		 Leur nom est alors PR_nomImageOrigine pour le mode rapide ou GR_nomImageOrigine pour les images agrandies.
		 Leur nom est alors U_nomImageOrigine pour le mode Ulis (selon les anciennes versions de PhotoReduc)

	Les images modifiées s'affichent dans une fenêtre ad hoc.

____________________
 }
#<tag>
.aide.texte tag configure clic -font  {helvetica 10 italic }  -foreground white -background DarkGreen 
.aide.texte tag add clic 3.0 {3.0 lineend} 

.aide.texte tag configure titre -font  {helvetica 14 bold}  -foreground blue
.aide.texte tag add titre 6.0 {6.0 lineend} 

#£ set logo [image create photo  -file [file join [pwd] photoreduc.gif ] ]
#£ .aide.texte image create 6.0 -image $logo -name PhotoReduc
}





