#!/bin/sh # This line makes the next one a comment in Tcl \ exec wish "$0" ${1+"$@"} #/usr/bin/wish # SKuvaInfo - Valokuvien tiedot talteen # Apuna kaytetty: # - Frenzy's Pic(k)tOrama V251214 Written 25.12.2014 by: Jens Timmermann # - https://wiki.tcl-lang.org/page/Capture+a+window+into+an+image (7.5.2026) # # (C) 2026 Jorma Sajaniemi # 27.05.2026 1.0.0 # - Ensimmainen julkistettu versio # 28.05.2026 1.0.1 # - Lisatty kauttaviiva kotihakemiston loppuun, jos asetustiedostossa olemattoman hakemiston nimi # 30.05.2026 1.0.2 # - Korjattu edellisen sivuvaikutus perumiseen ensimmaisessa aloittamisessa # 28.06.2026 1.0.3 # - Muutettu Avaa kuva -toiminto nayttamaan oletusarvoisesti kaikki kuvat # - Korjattu paakuvasta lsort:illa kauaksi joutuvan infokuvan sijainti tiedostolistauksessa # - Lisatty kirjoitushistorian lukemisen kestavyytta historiatiedoston rakennevirheille # 28.06.2026 1.0.4 # - Lisatty varmistus infokuvan kirjoituskansiolle # 28.06.2026 1.0.5 # - Toteutettu edellinen initialdir-optiolla # 01.07.2026 1.1.0 # - Lisatty mahdollisuus antaa tiedostonimi komentoriviparametrina # - Pakotettu asetus- ja kirjoitushistoriatiedostot ISO8859-1 -koodistoon # - Lisatty lopetushetken tekstit kirjoitushistoriaan # 02.07.2026 1.1.1 # - Korjattu tyhjan kuvan virhe # 17.08.2026 1.1.2 # - Parametritiedoston kasittely huomioimaan Wine:lta tulleet # - Puuttuvan kuvan kasittely paremmaksi # 27.08.2026 2.0.0 # - Lisatty haku kirjoitushistoriaan # - Poistettu mahdollisuus kirjoitushistorian tyhjentamiseen # - Lisatty varoitus ajamisesta useana inkarnaationa # - Lisatty mahdollisuus avata kuva ulkoiseen ohjelmaan # - Lisatty loki-ikkuna # - Lisatty muokkausohje historiatiedoston alkuun # - Korjattu valilyonteja nimessaan sisaltavan kuvan infokuvan tallentaminen # - Viritelty fontteja Linux-yhteensopivammiksi # Global Variables of Operating System: set system $tcl_platform(os) # set homeDir [string trimright [pwd] /] set reso {800 600} set version "2.0.0" set kotiHak [string map {\\ /} "$::env(HOME)"] append kotiHak "/" if {[string range $kotiHak 0 0] == "/"} { set linux 1 } else { set linux 0 } #Set Packages package require Img # if {![info exists starkit::topdir]} { # #LoadProcedures (only when startet from Wish) # if {[catch {source $homeDir/PIRGFX.tcl}]!=0} {puts "PIRGFX"; break} # if {[catch {source $homeDir/PIRAPP.tcl}]!=0} {puts "PIRAPP"; break} # set exe 0 # } else { # #Only within executable StartKit # catch {package require PIRGFX} # catch {package require PIRAPP} # set exe 1 # } proc writeFile {filename inhalt} { if {![catch {open $filename "w"} write]} { fconfigure $write -encoding iso8859-1 puts $write $inhalt close $write } } # --------------------------------------------------------------- # --------------------------------------------------------------- # Globaalit muuttujat # --------------------------------------------------------------- # --------------------------------------------------------------- set ajoTied "${kotiHak}SKuvaInfo_Ajossa.txt" set asetusTied "${kotiHak}SKuvaInfo_Asetukset.txt" set historiaTied "${kotiHak}SKuvaInfo_Historia.txt" if {[file isfile $ajoTied]} { set vastaus [tk_messageBox -title "Kirjoitushistorian sotkemisvaara!" -message "SKuvaInfo on ilmeisesti auki toisessa ikkunassa. Jatkaminen voi sotkea kirjoitushistorian!\n\nLopetetaanko?" -icon warning -type yesno] if {"{$vastaus}" == "{yes}"} { exit } } else { writeFile $ajoTied "Suoritus kesken. Jos kesken olevaa suoritusta ei ole, voit poistaa tiedoston.\n" } set histCol "#fff5e6" set imgluettu [image create photo] set imgzoomattu [image create photo] set fidx 0 # Kuvatiedostotyypit: set kuvatyypit { {{Kuvat} {.jpg}} {{Kuvat} {.jpeg}} {{Kuvat} {.png}} {{Kuvat} {.gif}} {{Kuvat} {.bmp}} {{Kaikki tiedostot} *} } set aitoKuva 1 set infoAnnettu 0 set alkupOtsikko "" set alkupTeksti "" set kuvaPuuttuu 1 set sovituszoom 1 set zoomtaso 1 set zoomkokokuva 0 # --------------------------------------------------------------- # --------------------------------------------------------------- # Proseduurit # --------------------------------------------------------------- # --------------------------------------------------------------- proc CaptureWindow {win {baseImg ""} {px 0} {py 0}} { # create the base image of win (the root of capturing process) if {$baseImg eq ""} { set baseImg [image create photo -format window -data $win] } # paste images of win's children on the base image foreach child [winfo children $win] { if {![winfo ismapped $child]} continue set childImg [image create photo -format window -data $child] regexp {\+(\d*)\+(\d*)} [winfo geometry $child] -> x y $baseImg copy $childImg -to [incr x $px] [incr y $py] image delete $childImg CaptureWindow $child $baseImg $x $y } return $baseImg } proc infonimi {fn} { set piste [string last "." $fn] if {$piste<0} { set tiedosto "0000__info.png" } else { set tiedosto [string range $fn 0 [expr $piste - 1]] append tiedosto "__info.png" } return $tiedosto } proc windowToFile { win } { global fn fidx dir newfile historia tiedostolista tila kotiHak set tiedosto [infonimi $fn] .pane.oikea.napattava configure -bg #c9b854 .pane.oikea.napattava.otsikko configure -state disabled -bg #e9d874 -fg black .pane.oikea.napattava.teksti configure -state disabled -bg #e9d874 -fg black .pane.oikea.napattava.picture.img configure -bg #e9d874 update set image [CaptureWindow $win] set types {{"Image Files" {.png}}} if {[file isdirectory $dir]} { set alkudir $dir } else { set alkudir $kotiHak tk_messageBox -icon warning -type ok -title "Kansio vaihtuu" -message "Kansio on kateissa. Valitse siis jokin muu kansio infokuvan tallentamista varten." } set filename [tk_getSaveFile -filetypes $types \ -initialdir $alkudir \ -initialfile $tiedosto \ -defaultextension .png] .pane.oikea.napattava configure -bg #86b300 .pane.oikea.napattava.otsikko configure -state normal -bg #ffffff -fg grey .pane.oikea.napattava.teksti configure -state normal -bg #ffffff -fg grey .pane.oikea.napattava.picture.img configure -bg #ffffff if {[llength $filename]} { set takakautettu [string map {\ \\\ } $filename] if { [catch "$image write -format png $takakautettu"] } { tk_messageBox -icon warning -type ok -title "Virhe" -message "Infokuvan tallennuksessa tapahtui jokin virhe." } image delete $image tiedotHistoriaan "$dir$fn" [.pane.oikea.napattava.otsikko get 0.1 end] [.pane.oikea.napattava.teksti get 0.1 end] # Jos tallennus eri hakemistoon, niin historiatieto myos sinne (ellei sellaista jo ole) set piste [string last "/" $filename] set kirjHak [string range $filename 0 $piste] if { $kirjHak != $dir } { set uusiAvain [infonimi "$kirjHak$fn"] if { ! [dict exists $historia $uusiAvain] } { tiedotHistoriaan "$kirjHak$fn" [.pane.oikea.napattava.otsikko get 0.1 end] [.pane.oikea.napattava.teksti get 0.1 end] } } poimiAlkup if {! $tila} { set newfile $filename avaaKuva 0 } else { step 1 if { [string range [lindex $tiedostolista $fidx] end end] == "!" } { set siisti [string range [lindex $tiedostolista $fidx] 0 end-1] set tiedostolista [lreplace $tiedostolista $fidx $fidx $siisti] } } } else { image delete $image return } } # --------------------------------------------------------------- # Kirjoitushistoria: set historia [dict create] proc tyhjennaHistoria {} { global historia aitoKuva set historia [dict create] if {! $aitoKuva} { .pane.oikea.bbar.monitoimi configure -state disable -text "Ei kirjoitushistoriassa" } } proc tiedotHistoriaan {k o t} { global historia if {$k != "viim"} { set pngNimi [infonimi $k] } else { set pngNimi $k } dict set historia $pngNimi Kuva $k dict set historia $pngNimi Otsikko $o dict set historia $pngNimi Teksti $t } proc kirjoitaHistoria {} { global historia version historiaTied .pane.oikea.napattava.inforivi.clue configure -text "Tallennetaan kirjoitushistoria ..." tiedotHistoriaan "viim" [.pane.oikea.napattava.otsikko get 0.1 end] [.pane.oikea.napattava.teksti get 0.1 end] set fileId [open $historiaTied "w"] fconfigure $fileId -encoding iso8859-1 puts $fileId "SKuvaInfo v. $version -- Tee muutoksia vain jos olet varma asiastasi ja ota varmuuskopio ennen muutosten tekoa!" puts $fileId "Huom: Kansioiden erotin kuvatiedostojen polkunimissa on \"/\" -- ei siis \"\\\" edes Windowsissa." puts $fileId "Huom: Polkunimissa olevista kieliversioiduista kansioiden nimista (esim. Kuvat vs. Pictures) kaytettava sita, jota historiatiedoissa jo esiintyy." dict for {avain arvo} $historia { dict with arvo { puts $fileId "#@Kuva:\n$Kuva" puts $fileId "#@Otsikko:\n$Otsikko" puts $fileId "#@Teksti:\n$Teksti" } } puts $fileId "#@Loppu\n" close $fileId .pane.oikea.napattava.inforivi.clue configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -text " " } proc trimmaaEnd {str} { # return [string range $str 0 [expr [string length $str]-2]] return [string trimright $str] } proc lueHistoria {} { global historia historiaTied if {[file isfile $historiaTied]} { .pane.oikea.napattava.inforivi.clue configure -text "Ladataan kirjoitushistoria ..." set fileId [open $historiaTied "r"] fconfigure $fileId -encoding iso8859-1 set rivit [split [read $fileId] "\n"] close $fileId set tilanne 0 set otsikko "" set teksti "" .pane.oikea.napattava.teksti insert end "\n" foreach rivi $rivit { if {[string equal -length 3 $rivi "#@K"]} { if {$tilanne} { set teksti [trimmaaEnd $teksti] tiedotHistoriaan $kuva $otsikko $teksti set otsikko "" set teksti "" } set tilanne 1 } elseif {[string equal -length 3 $rivi "#@O"]} { set tilanne 2 set otsikko "" } elseif {[string equal -length 3 $rivi "#@T"]} { set otsikko [trimmaaEnd $otsikko] set tilanne 3 set teksti "" } elseif {[string equal -length 3 $rivi "#@L"]} { if {$tilanne == 3} { set teksti [string range $teksti 0 [expr [string length $teksti]-2]] tiedotHistoriaan $kuva $otsikko $teksti } .pane.oikea.napattava.inforivi.clue configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -text " " return } else { if {$tilanne == 1} { set kuva $rivi } elseif {$tilanne == 2} { if {$otsikko == ""} { set otsikko "$rivi\n" } else { set otsikko "$otsikko$rivi\n" } } elseif {$tilanne == 3} { if {$teksti == ""} { set teksti "$rivi\n" } else { set teksti "$teksti$rivi\n" } } } } .pane.oikea.napattava.inforivi.clue configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -text " " update } } proc lopetus {} { global aitoKuva dir ulkoinenOhjelma asetusTied ajoTied if {$aitoKuva} { if {[muutosPeruminen 1]} { poimiAlkup return } } kirjoitaHistoria # writeFile $asetusTied [string trimright $dir /]/ writeFile $asetusTied "$dir\n$ulkoinenOhjelma\n" file delete $ajoTied exit } # --------------------------------------------------------------- # Kuvien ja hakemistojen kasittely: proc setImg {} { global tiedostolista dir fn fidx imgzoomattu imgluettu zoomkokokuva historia aitoKuva kuvaPuuttuu tila .pane.vasen.files.liste selection set $fidx $fidx .pane.vasen.files.liste see $fidx if {$tila} { if {[string index $fn end] == "!"} { set fn [string replace $fn end-1 end] } } if {[string match "*__info.png" $fn]} { set aitoKuva 0 .pane.oikea.napattava configure -bg #c9b854 .pane.oikea.napattava.picture.img configure -bg #e9d874 .pane.oikea.bbar.monitoimi configure -bg #e9d874 if {[dict exists $historia "$dir$fn"]} { .pane.oikea.bbar.monitoimi configure -state normal -text "Poimi kirjoitushistoriasta" } else { .pane.oikea.bbar.monitoimi configure -state disable -text "Ei kirjoitushistoriassa" } } else { set aitoKuva 1 .pane.oikea.napattava configure -bg #86b300 .pane.oikea.napattava.picture.img configure -bg #ffffff .pane.oikea.bbar.monitoimi configure -bg gray90 .pane.oikea.bbar.monitoimi configure -state normal -activebackground gray48 -text "Tallenna infokuvaksi" } if {$fidx == 0} { .pane.oikea.bbar.back configure -state disabled } else { .pane.oikea.bbar.back configure -state normal } if {$fidx >= [llength $tiedostolista] - 1} { .pane.oikea.bbar.next configure -state disabled } else { .pane.oikea.bbar.next configure -state normal } if {$tila} { # Seuraava tarvitaan, koska fn:n lopussa oli joskus ylimaarainen tyhje, jos infokuva puuttuu. # En tosin ymmarra, miksi siella sellainen on ollut. En myoskaan saanut ongelma enaa myohemmin toistumaan. # Mutta olkoonnyt varmuuden vuoksi, kun ei siita haittaakaan ole. (19.9.2026) set fn [string trimrigh $fn] if {[string match "*__info.png" $fn]} { set fi $fn } else { set fi [infonimi $fn] } .pane.oikea.napattava.otsikko replace 0.1 end [trimmaaEnd [dict get $historia "$dir$fi" Otsikko]] .pane.oikea.napattava.teksti replace 0.1 end [trimmaaEnd [dict get $historia "$dir$fi" Teksti]] } poimiAlkup .pane configure -cursor watch .pane.oikea.napattava.inforivi.clue configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -text "Ladataan ..." .pane.oikea.napattava.inforivi.fname configure -text "$fn" $imgluettu blank if {[catch {$imgluettu configure -file $fn}]} { .pane.vasen.files.liste selection set $fidx .pane.vasen.files.liste see $fidx $imgzoomattu blank .pane configure -cursor arrow .pane.oikea.napattava.inforivi.clue configure -bg pink -text "Kuva kateissa eli poistettu, siirretty tai nimetty uudelleen." .pane.oikea.napattava.inforivi.size configure -text " x " # .pane.oikea.napattava.picture.img configure -bg #ffffff .pane.oikea.napattava.picture.img configure -bg pink .pane.oikea.napattava.picture.img yview moveto 0.0 .pane.oikea.napattava.picture.img xview moveto 0.0 .pane.oikea.bbar.zoomon configure -state disabled .pane.oikea.bbar.zoomout configure -state disabled .pane.oikea.bbar.zoomin configure -state disabled set kuvaPuuttuu 1 return } set kuvaPuuttuu 0 set x [image width $imgluettu] set y [image height $imgluettu] if {$fn==""} { .pane.oikea.napattava.inforivi.size configure -text " x " } else { .pane.oikea.napattava.inforivi.size configure -text "$x x $y" } .pane.oikea.bbar.zoomon configure -state normal .pane.oikea.bbar.zoomout configure -state normal .pane.oikea.bbar.zoomin configure -state normal set zoomkokokuva 1 sovitus .pane configure -cursor arrow .pane.oikea.napattava.inforivi.clue configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -text " " } proc poimiAlkup {} { global alkupOtsikko alkupTeksti set alkupOtsikko [.pane.oikea.napattava.otsikko get 0.1 end] set alkupTeksti [.pane.oikea.napattava.teksti get 0.1 end] } proc sovitus {} { global imgzoomattu imgluettu zoomtaso sovituszoom # Alkuzoomauksen laskeminen !!! set x [image width $imgluettu] set y [image height $imgluettu] update set winx [winfo width .pane.oikea.napattava.picture.img] set winy [winfo height .pane.oikea.napattava.picture.img] set xzoom [expr ($x / $winx) + 1] set yzoom [expr ($y / $winy) + 1] if {$yzoom > $xzoom} {set xzoom $yzoom} set sovituszoom $xzoom set zoomtaso $xzoom kuvaEsille $zoomtaso } proc zoommuutos {muutos} { global zoomtaso zoomkokokuva set uusizoom [expr $zoomtaso + $muutos] if {$uusizoom >= 1 && $uusizoom <= 40} { set zoomtaso $uusizoom kuvaEsille $zoomtaso } set zoomkokokuva 0 } proc zoomJuuEi {} { global zoomtaso zoomkokokuva sovituszoom if {$zoomkokokuva} { if {$zoomtaso == $sovituszoom && $zoomtaso > 1} { set zoomtaso [expr $zoomtaso - ($zoomtaso / 2)] } set zoomaus $zoomtaso } else { set zoomaus $sovituszoom } kuvaEsille $zoomaus set zoomkokokuva [expr 1-$zoomkokokuva] } proc kuvaEsille {zoomaus} { global imgluettu imgzoomattu zoomtaso sovituszoom $imgzoomattu blank if {$zoomaus != $sovituszoom} { $imgzoomattu copy $imgluettu -subsample $zoomaus $zoomaus } else { $imgzoomattu copy $imgluettu -subsample $zoomaus $zoomaus } .pane.oikea.napattava.picture.img yview moveto 0.0 .pane.oikea.napattava.picture.img xview moveto 0.0 if {$zoomtaso == 1} { .pane.oikea.bbar.zoomin configure -state disabled } else { .pane.oikea.bbar.zoomin configure -state normal } if {$zoomtaso == 40} { .pane.oikea.bbar.zoomout configure -state disabled } else { .pane.oikea.bbar.zoomout configure -state normal } } proc muutosPeruminen {lopetus} { global alkupOtsikko alkupTeksti aitoKuva infoAnnettu set Otsikko [.pane.oikea.napattava.otsikko get 0.1 end] set Teksti [.pane.oikea.napattava.teksti get 0.1 end] if {([string length [string trim $Otsikko]] == 0 && [string length [string trim $Teksti]] == 0) || ([string equal $Otsikko $alkupOtsikko] && [string equal $Teksti $alkupTeksti])} { return 0 } if ($aitoKuva) { if {$lopetus} { set verbi "Lopeta" set substantiivi "lopetus" } else { set verbi "Siirry" set substantiivi "siirtyminen" } set vastaus [tk_messageBox -title "Tallentamattomia muutoksia!" -message "Tekstimuutoksia ei ole tallennettu!\n\nOK: $verbi silti\nPeruuta: Peru $substantiivi" -icon warning -type okcancel] return [expr "{$vastaus}" == "{cancel}"] } if {! $infoAnnettu} { tk_messageBox -icon info -type ok -title "Tallentamattomia muutoksia!" -message "Vihje: Infokuvan kohdalla tehdyt muutokset voi tallentaa vain varsinaisen kuvan kohdalla.\n" set infoAnnettu 1 } return 0 } proc vaihtoKaikkiHaetuissa {} { global tiedostolista fn fidx dir kansiolista kotiHak set dir [lindex $kansiolista $fidx] .nfo.dir configure -text " $dir " if {[file isdirectory $dir]} { set jdir $dir } else { set jdir $kotiHak } cd $jdir } proc step {fwd} { global tiedostolista fn fidx tila if {[muutosPeruminen 0]} {return} # set dummy 0 .pane.vasen.files.liste selection clear 0 [llength $tiedostolista] if $fwd { if {$fidx < [llength $tiedostolista]} { set fidx [expr $fidx + 1] set fn [lindex $tiedostolista $fidx] } } else { if {$fidx > 0} { set fidx [expr $fidx - 1] set fn [lindex $tiedostolista $fidx] } } if {$tila < 0} { vaihtoKaikkiHaetuissa } setImg } proc stepToive {fwd} { global tiedostolista fidx if { $fwd && ($fidx < ([llength $tiedostolista] - 1))} { step 1 } if { (! $fwd) && ($fidx > 0)} { step 0 } } proc aseta_tiedostolista {} { global tiedostolista #set tiedostolista [lsort [glob -nocomplain *.tbg *.tif *.gif *.jpg *.jpeg *.png *.pcx *.tga *.bmp *.xbm *.xpm]] set tiedostolista [lsort [glob -nocomplain *.gif *.jpg *.jpeg *.png *.bmp ]] set lngth [llength $tiedostolista] if {$lngth > 1} { # Ekaa ei voi siirtaa, eika myoskaan tokaa, joten aloitetaan kolmannesta set edellisen_infonimi [infonimi [lindex $tiedostolista 1]] for {set x 2} {$x<$lngth} {incr x} { set nykyinen [lindex $tiedostolista $x] if {[string match "*__info.png" $nykyinen]} { if {[string compare $edellisen_infonimi $nykyinen]} { # Ei ole alkuperaisen perassa, siis etsi alkuperainen ja siirra sen peraan set tamako [expr $x - 2] while {$tamako >= 0} { if {[string compare [infonimi [lindex $tiedostolista $tamako]] $nykyinen] == 0} { set tiedostolista [lreplace $tiedostolista $x $x] set tiedostolista [linsert $tiedostolista [expr $tamako + 1] $nykyinen] set tamako 0 } incr tamako -1 } } } set edellisen_infonimi [infonimi $nykyinen] } } .nfo.count configure -text "Kansiossa [llength $tiedostolista] kuvatiedostoa" } proc avaaKansio {kysy} { global dir imgzoomattu tiedostolista fn fidx kotiHak if {$kysy} { if { $tiedostolista != [] } { if {[muutosPeruminen 0]} {return -1} } if {[file isdirectory $dir]} { set alkudir $dir } else { set alkudir $kotiHak } set newdir [string trimright [tk_chooseDirectory -mustexist 1 -initialdir $alkudir]] if {$newdir == ""} { return } set dir "$newdir/" } cd $dir aseta_tiedostolista set fn [lindex $tiedostolista 0] set fidx 0 .nfo.dir configure -text " $dir " .pane.vasen.files.liste selection clear 0 [llength $tiedostolista] normaalitilaan if {$kysy} { if {[llength $tiedostolista] <=0} { $imgzoomattu blank .pane.oikea.bbar.zoomon configure -state disabled .pane.oikea.bbar.zoomout configure -state disabled .pane.oikea.bbar.zoomin configure -state disabled .pane.oikea.bbar.back configure -state disabled .pane.oikea.bbar.next configure -state disabled .pane.oikea.bbar.monitoimi configure -state disable update tk_messageBox -icon warning -title "Valitse kuvahakemisto" -message "Ei kuvia !\nValitse kansio, jossa on kuvia." -type ok } else { setImg } } } proc avaaKuva {kysy} { global kuvatyypit dir imgzoomattu tiedostolista fn fidx newfile kotiHak if {$kysy} { if { $tiedostolista != [] } { if {[muutosPeruminen 0]} {return -1} } if {[file isdirectory $dir]} { set alkudir $dir } else { set alkudir $kotiHak } set newfile [string trimright [tk_getOpenFile -title "Valitse kuva" -filetypes $kuvatyypit -initialdir $alkudir]] } if {$newfile == ""} {return -1} set piste [string last "." $newfile] if {$piste<0} {return -1} set tyyppi [string tolower [string range $newfile $piste end]] if {$tyyppi != ".jpg" && $tyyppi != ".jpeg" && $tyyppi != ".png" && $tyyppi != ".gif" && $tyyppi != ".bmp"} { tk_messageBox -icon warning -title "Ei-tuettu tyyppi" -message "Kuvan tyyppi ei ole tuettu.\nValitse kuva, jonka tyyppi on JPEG, PNG, GIF tai BMP." -type ok return -1 } set piste [string last "/" $newfile] if {$piste<0} {return -1} set dir [string range $newfile 0 $piste] set fn [string range $newfile [expr $piste + 1] end] cd $dir aseta_tiedostolista set fidx [lsearch $tiedostolista $fn] # set fn [lindex $tiedostolista $fidx] .nfo.dir configure -text " $dir " .pane.vasen.files.liste selection clear 0 [llength $tiedostolista] normaalitilaan setImg return 0 } proc monitoimiToiminto {} { global aitoKuva dir fn historia kuvaPuuttuu if {$aitoKuva} { if {$kuvaPuuttuu} { set vastaus [tk_messageBox -title "Kuva puuttuu!" -message "Olet tallentamassa kuvatonta infokuvaa.\n\nJatketaanko?" -type okcancel] if {"{$vastaus}" == "{cancel}"} { return } } poimiAlkup windowToFile .pane.oikea.napattava } else { .pane.oikea.napattava.otsikko replace 0.1 end [trimmaaEnd [dict get $historia "$dir$fn" Otsikko]] .pane.oikea.napattava.teksti replace 0.1 end [trimmaaEnd [dict get $historia "$dir$fn" Teksti]] poimiAlkup step 0 } } # --------------------------------------------------------------- # Kayttoliittyma esiin: set f_yleis "-family Arial -size 9" # Create TopLevelWindow (Form) wm title . "SKuvaInfo - Valokuvien tiedot talteen" wm iconname . "SKuvaInfo" wm protocol . WM_DELETE_WINDOW lopetus # wm minsize . 950 800 # wm geometry . [regsub { } $reso {x}] wm geometry . "1100x900" # Valikko frame .mbar -borderwidth 2 -relief groove pack .mbar -side top -fill both menubutton .mbar.file -text "Tiedosto" -menu .mbar.file.m -relief flat set m [menu .mbar.file.m -tearoff 1] $m add command -label "Avaa kuva" -command "avaaKuva 1" $m add command -label "Avaa kansio" -command "avaaKansio 1" $m add separator $m add command -label "Aseta ulkoinen ohjelma" -command pyydaUlkoinen $m add command -label "Avaa kuva ulkoiseen ohjelmaan" -command avaaUlkoisessa -state disabled $m add separator $m add command -label "Lopeta" -command lopetus menubutton .mbar.haku -text "Haku kirjoitushistoriasta" -menu .mbar.haku.m -relief flat set m [menu .mbar.haku.m -tearoff 1] $m add command -label "Aloita uusi haku" -command "aloitaUusiHaku" $m add separator $m add command -label "Hakusivu" -state disabled -command "haku_flap flap_nyky" $m add command -label "Tulossivu" -state disabled -command "haku_flap flap_tul" $m add command -label "Tehtyjen hakujen sivu" -state disabled -command "haku_flap flap_kaikki" $m add separator $m add command -label "Palaa normaalitilaan" -state disabled -command palaaNormaalitilaan menubutton .mbar.help -text "Ohje" -menu .mbar.help.m -relief flat set m [menu .mbar.help.m -tearoff 1] $m add command -label "Ohje" -command "ohje 0" $m add command -label "Tietoja" -command { tk_messageBox -icon info -title "Tietoja" -message "SKuvaInfo v. $version\nTcl/Tk v. [info tclversion]\n\n(c) 2026 Jorma Sajaniemi\n\nsaja.kapsi.fi/skuvainfo" -type ok } pack .mbar.file .mbar.haku .mbar.help -side left -padx 2 #Info Line frame .nfo button .nfo.dir -relief raised -borderwidth 2 -padx 2 -pady 2 -font $f_yleis -text " " -command "avaaKansio 1" label .nfo.count -font $f_yleis -text " " pack .nfo.dir .nfo.count -side left -fill x pack .nfo -side top -fill x #PanedFrame panedwindow .pane -sashwidth 6 -sashrelief ridge pack .pane -side top -expand yes -fill both # Vasen palsta frame .pane.vasen #FileList frame .pane.vasen.files listbox .pane.vasen.files.liste -listvariable tiedostolista -yscroll ".pane.vasen.files.scroll set" -selectmode single -exportselection false -activestyle none -relief sunken -font $f_yleis -width [expr $linux ? 35 : 40] scrollbar .pane.vasen.files.scroll -relief sunken -command ".pane.vasen.files.liste yview" pack .pane.vasen.files.scroll -side right -fill y pack .pane.vasen.files.liste -side left -expand true -fill both .pane.vasen.files.liste selection set 0 0 # Oikea palsta frame .pane.oikea panedwindow .pane.oikea.napattava -relief flat -bd 14 -bg #86b300 -orient vertical #Image frame .pane.oikea.napattava.picture text .pane.oikea.napattava.picture.img -yscrollcommand ".pane.oikea.napattava.picture.scrollY set" -xscrollcommand ".pane.oikea.napattava.picture.xfill.scrollX set" -state disabled -background white -selectbackground white -relief sunken -padx 2 -cursor arrow .pane.oikea.napattava.picture.img image create end -image $imgzoomattu scrollbar .pane.oikea.napattava.picture.scrollY -command ".pane.oikea.napattava.picture.img yview" frame .pane.oikea.napattava.picture.xfill scrollbar .pane.oikea.napattava.picture.xfill.scrollX -orient horiz -command ".pane.oikea.napattava.picture.img xview" frame .pane.oikea.napattava.picture.xfill.filler -height 16 -width 16 pack .pane.oikea.napattava.picture.xfill.filler -side right pack .pane.oikea.napattava.picture.xfill.scrollX -side left -expand true -fill x pack .pane.oikea.napattava.picture.xfill -side bottom -fill x pack .pane.oikea.napattava.picture.scrollY -side right -fill y pack .pane.oikea.napattava.picture.img -side left -expand true -fill both pack .pane.oikea.napattava.picture -side top -expand true -fill both # Tekstialueet text .pane.oikea.napattava.otsikko -font {-family times -size 16} -height 2 -wrap word -fg grey text .pane.oikea.napattava.teksti -font {-family times -size 12} -height 10 -wrap word -fg grey pack .pane.oikea.napattava.otsikko -side top -fill x pack .pane.oikea.napattava.teksti -side top -fill x .pane.oikea.napattava.otsikko insert end {Kirjoita otsikko} .pane.oikea.napattava.teksti insert end "Kirjoita tarkemmat tiedot" # Inforivi frame .pane.oikea.napattava.inforivi label .pane.oikea.napattava.inforivi.size -relief groove -borderwidth 2 -padx 2 -font $f_yleis -text " [image width $imgluettu] x [image height $imgluettu] " label .pane.oikea.napattava.inforivi.fname -relief groove -borderwidth 2 -padx 2 -font $f_yleis -text " " label .pane.oikea.napattava.inforivi.clue -bg [.pane.oikea.napattava.inforivi.fname cget -bg] -relief flat -font $f_yleis -text " " -anchor center label .pane.oikea.napattava.inforivi.paivays -font $f_yleis -text [clock format [clock seconds] -format %d.%m.%Y] label .pane.oikea.napattava.inforivi.ohjelma -font "$f_yleis -slant italic" -text " SKuvaInfo v. $version" pack .pane.oikea.napattava.inforivi.size -side left pack .pane.oikea.napattava.inforivi.fname -side left pack .pane.oikea.napattava.inforivi.clue -side left -expand true pack .pane.oikea.napattava.inforivi.ohjelma -side right pack .pane.oikea.napattava.inforivi.paivays -side right pack .pane.oikea.napattava.inforivi -side bottom -fill x pack .pane.vasen.files -side left -fill both -expand true pack .pane.oikea.napattava -side top -fill both -expand true .pane.oikea.napattava add .pane.oikea.napattava.picture .pane.oikea.napattava.otsikko .pane.oikea.napattava.teksti #Bottomframe/Buttons frame .pane.oikea.bbar -borderwidth 2 # button .pane.oikea.bbar.back -text " Back " -bg gray90 -command {step 0} button .pane.oikea.bbar.zoomon -bg gray90 -text " Zoomaus / Koko kuva " -state disabled -command {zoomJuuEi} button .pane.oikea.bbar.zoomout -bg gray90 -text " Zoom - " -state disabled -command {zoommuutos 1} button .pane.oikea.bbar.zoomin -bg gray90 -text " Zoom + " -state disabled -command {zoommuutos -1} button .pane.oikea.bbar.back -bg gray90 -text " Edellinen " -state disabled -command {step 0} button .pane.oikea.bbar.next -text " Seuraava " -state disabled -command {step 1} button .pane.oikea.bbar.monitoimi -text "Tallenna infokuvaksi" -command monitoimiToiminto pack .pane.oikea.bbar.zoomon .pane.oikea.bbar.zoomout .pane.oikea.bbar.zoomin .pane.oikea.bbar.back .pane.oikea.bbar.next .pane.oikea.bbar.monitoimi -side left -expand true -fill x pack .pane.oikea.bbar -side top -fill x pack .pane.vasen .pane.oikea -side left -fill both -expand true -padx 2 .pane add .pane.vasen .pane.oikea # --------------------------------------------------------------- # Nappaintoiminnot: #bind . { #set reso [list [winfo width .] [winfo height .]] #} bind . {wm iconify .} bind .pane.vasen.files.liste {stepToive 0} bind .pane.vasen.files.liste {stepToive 1} #ListBox Selection bind .pane.vasen.files.liste <> { if {! [muutosPeruminen 0]} { set fidx [.pane.vasen.files.liste curselection] set fn [lindex $tiedostolista $fidx] if {$tila < 0} { vaihtoKaikkiHaetuissa } setImg } else { .pane.vasen.files.liste selection clear 0 [llength $tiedostolista] .pane.vasen.files.liste selection set $fidx } } #MousePressOverImage bind .pane.oikea.napattava.picture.img {.pane.oikea.napattava.picture.img configure -cursor fleur} bind .pane.oikea.napattava.picture.img {.pane.oikea.napattava.picture.img configure -cursor arrow} bind .pane.vasen.files {.pane.vasen.files.liste yview scroll [expr {int(pow(%D/-120,3))}] units} focus -force .pane.vasen.files #. configure -cursor icon # --------------------------------------------------------------- # --------------------------------------------------------------- # --------------------------------------------------------------- # ---------------------------------------------------- # Loki-ikkuna # ---------------------------------------------------- set lokiikkunaAvattu 0 proc avaaLokiikkuna {} { global lokiikkunaAvattu if {$lokiikkunaAvattu} { return } set lokiikkunaAvattu 1 toplevel .loki wm title .loki "SKuvaInfo - Loki" wm iconname .loki "SKuvaInfo - Loki" wm protocol .loki WM_DELETE_WINDOW "wm withdraw .loki" text .loki.loki -height 20 -cursor arrow pack .loki.loki -expand true -padx 2 } proc lokiin {ilmoitus} { global lokiikkunaAvattu if {! $lokiikkunaAvattu} { avaaLokiikkuna } wm state .loki normal raise .loki .loki.loki insert end $ilmoitus .loki.loki yview moveto 1 } # ------------------------------------------- # Ohje-ikkuna # ------------------------------------------- set ohjeikkunaAvattu 0 proc avaaOhjeikkuna {} { global ohjeikkunaAvattu if {$ohjeikkunaAvattu} { return } set ohjeikkunaAvattu 1 toplevel .ohje wm withdraw .ohje wm title .ohje "SKuvaInfo - Ohje" wm iconname .ohje "SKuvaInfo - Ohje" wm protocol .ohje WM_DELETE_WINDOW "wm withdraw .ohje" set n .ohje.teksti pack [frame $n -borderwidth 4] -side top -fill both -expand true text $n.pohja -height 30 -wrap word -cursor arrow -insertbackground #adebad -bg #adebad -font {-size 10} -yscrollcommand ".ohje.teksti.hissi set" scrollbar $n.hissi -command ".ohje.teksti.pohja yview" pack $n.pohja -side left -fill both -expand true pack $n.hissi -side left -fill y $n.pohja tag configure ots -font {-size 12 -slant italic -weight bold} $n.pohja tag configure vih -font {-size 10 -weight bold} -foreground green $n.pohja tag configure pun -font {-size 10 -weight bold} -foreground red $n.pohja tag configure fix -font {-size 9 -family Courier} set n .ohje.painike pack [frame $n -borderwidth 2] -side top -fill x pack [button $n.ok -text "Sulje" -command "wm withdraw .ohje"] } proc ohje {teksti} { global ohjeikkunaAvattu if {! $ohjeikkunaAvattu} { avaaOhjeikkuna } wm state .ohje normal raise .ohje if {$teksti == 0} { .ohje.teksti.pohja replace 1.0 end "\nSKuvaInfo: Yleisohje\n\n" ots .ohje.teksti.pohja insert end "Valitse kuva ja zoomaa se siihen kokoon ja kohtaan, jossa haluat sen olevan infokuvassa.\ Kirjoita sitten kuvan esittelytekstit ja tallenna kuva+tekstit infokuvaksi \"Tallenna infokuvaksi\" -painikkeella.\ \n\nKirjoittamasi tekstit tallentuvat kirjoitushistoriaan, josta voit poimia ne muokkaamista varten infokuvan kohdalla.\ (Muista korvata entinen infokuva tallentamalla kuva ja uudet tekstit uudestaan infokuvaksi.)\ \n\nKuvia voi hakea kirjoitushistorian tekstien perusteella (valikon vaihtoehto \"Haku kirjoitushistoriasta\" / \"Aloita uusi haku\").\ Hakuikkunan eri toiminnoilla on omat ohjeensa.\ \n\nValikoista puheen ollen: voit napsauttaa valikon alussa olevaa kapeaa katkoviivaa, jolloin\ pudotusvalikko aukeaa omaan pieneen, liikuteltavaan ikkunaansa. Siten se on jatkossa aina helposti saatavilla.\ \n\nTallennettavan tiedoston oletusnimi on __info.png (huomaa kaksi alaviivaa).\ Voit vaihtaa nimen tallennusvaiheessa, mutta se ei ole suositeltavaa, koska silloin\ ohjelma ei tunnista infokuvaa infokuvaksi ja kirjoistushistoria ei toimi kyseisen infokuvan kohdalla.\ \n\nOhjelma ei tee muutoksia originaaleihin kuvatiedostoihin." lower . .ohje } elseif {$teksti == 1} { .ohje.teksti.pohja replace 1.0 end "\nSKuvaInfo: Hakuehdot\n\n" ots .ohje.teksti.pohja insert end "Kukin hakufraasi on lainausmerkein rajattu teksti, jota haetaan sellaisenaan kirjoitushistoriasta.\ Jos hakufraasi on yksi sana tai sanan osa, niin lainausmerkit voivat puuttua.\ \n\nJos hakufraasit ovat esimerkiksi\n\n Liisa Mat \"Lapinlahden asema\"\n\nja\ vaatimus on \"Oltava kaikki\" ja haun kohdistukseksi on ruksittu ainakin Otsikkko ja Selitys,\ niin kuva, jonka otsikkona on \"Matin ja Liisan junamatka\" ja jonka selitys on \"Taivastelua Lapinlahden asemalla\",\ valikoituu haun tulokseen.\n\nTai jos hakufraasit ovat esimerkiksi\n\n 2023 2024 2025\n\nja vaatimus on \"Ei ainuttakaan\"\ ja kohdistus on Polkunimi, niin tulokseen tulee kaikki tiedot pois lukien sellaiset kuvatiedostot ja kokonaiset hakemistot\ kuvineen ja alihakemistoineen, joiden nimiin on kirjoitettu jokin e.m. (vuosi)luvuista.\ Tuloksen teksteihin voi sitten kohdistaa haluamansa jatkohaun." lower .haku .ohje } elseif {$teksti == 2} { .ohje.teksti.pohja replace 1.0 end "\nSKuvaInfo: Haun tulos\n\n" ots .ohje.teksti.pohja insert end "Kirjoitushistoriasta poimitut tekstit on ryhmitelty hakemistoittain.\ Hakemistoja avaamalla saat kuvien tekstit esille.\ \n\n\"Kuva esiin\"-linkki avaa kuvan SKuvaInfo-ohjelman kuvaikkunaan ja laittaa kuvaikkunan kuvalistaan\ kansion muutkin haetut kuvat.\ Kuvaikkuna toimii sitten muuten normaalisti, mutta ohjelma poimii\ jokaisen kuvan ja infokuvan kohdalla tekstit kirjoitushistoriasta aina automaattisesti.\ \n\n\"Kaikki kuvat esiin\" -painike vie kuvaikkunaan hakutuloksen kaikki kuvat niiden sijaintikansiosta\ riippumatta. Toiminto on mahdollinen vain, jos kuvia/kansioita ei ole kovin paljon.\ \n\nJos kirjoitushistoriassa on teksti, joka liittyy poistettuun, siirrettyn tai uudelleennimettyyn kuvaan,\ niin asia ilmaistaan huutomerkein. Esimerkiksi " .ohje.teksti.pohja insert end "! " vih .ohje.teksti.pohja insert end "! " pun .ohje.teksti.pohja insert end "ilmoittaa varsinaisen kuvan olevan paikallaan, mutta infokuvan olevan kateissa.\ Kateissa oleva kansio ilmaistaan vastaavasti.\ \n\nJos haluat katsella jonkun muun haun tulosta, niin \"Vaihda\"-painike vie tehtyjen hakujen sivulle,\ josta voit sitten valita haluamasi haun tuloksen." lower .haku .ohje } elseif {$teksti == 3} { .ohje.teksti.pohja replace 1.0 end "\nSKuvaInfo: Erilaiset jatkohaut\n\n" ots .ohje.teksti.pohja insert end "Jatkohaulla voit tarkentaa nykyisen haun antamaa tulosta.\n\nEdellisen\ tason jatkohaku kohdistuu puolestaan samaan tulosjoukkoon kuin mihin nykyinen jatkohaku kohdistui. Sen avulla voit\ siis \"peruuttaa\" nykyhakua aiempaan tilanteeseen ja kohdistaa jatkohaun siihen.\ Siten saat helposti aikaan useita erilaisia jatkohakuja samaan tulokseen.\n\nJos taas haluat peruuttaa useamman tason,\ niin valitse haluamasi jatkohaun kohde tehtyjen hakujen sivulta.\ Tai ole aloittavinasi jatkohaku nykyiseen tulokseen ja valitse sitten esiin tulevasta hakuketjusta\ haluamasi aiempi haku uuden jatkohaun pohjaksi." lower .haku .ohje } elseif {$teksti == 4} { .ohje.teksti.pohja replace 1.0 end "\nSKuvaInfo: Kuvan avaaminen ulkoiseen ohjelmaan\n\n" ots .ohje.teksti.pohja insert end "Voit avata SKuvaInfossa auki olevan kuvan haluamaasi ulkoiseen ohjelmaan.\ Ulkoisen ohjelman kutsumuoto on (toivottavasti) kerrottu kyseisen ohjelman omassa ohjeessa ja\ monesti tarvitaan vain ohjelman nimi ja avattavan kuvatiedoston nimi.\n\nKirjoita\ ohjelman polkunimeen kuuluvien \"\\\"- ja \" \"-merkkien eteen merkki \"\\\" ja\ laita \"%%\" kohtaan, jossa kuvatiedoston nimen tulee olla.\n\nEsimerkiksi\ IrfanView-ohjelman kutsumuoto voisi olla Windowsissa vaikkapa\n\n" .ohje.teksti.pohja insert end " C:\\\\Program\\ Files\\\\IrfanView\\\\i_view64.exe %%" fix .ohje.teksti.pohja insert end "\n\n\Vastaavasti Linuxissa Gwenview-ohjelman kutsumuoto on\n\n" .ohje.teksti.pohja insert end " /usr/bin/gwenview %%" fix .ohje.teksti.pohja insert end "\n\nJos tapaat avata kuvia ulkoiseen ohjelmaan tiuhaan, niin \"Tiedosto\"-valikko\ kannattaa irrottaa omaksi pieneksi, liikuteltavaksi ikkunakseen napsauttamalla valikon alussa olevaa kapeaa katkoviivaa.\n" lower .asetaulk .ohje } else { .ohje.teksti.pohja replace 1.0 end "\nEi ohjetta. Hmmm..." } # Seuraava on turha ja tarpeeton # focus -force .ohje } # ------------------------------------------- # Haku-ikkuna: # ------------------------------------------- set hakuikkunaAvattu 0 set vaatimus 0 set kohd_p 0 set kohd_o 0 set kohd_s 0 set A_on_a 0 proc avaaHakuikkuna {} { global vaatimus kohd_p kohd_o kohd_s A_on_a hakuikkunaAvattu histCol if {$hakuikkunaAvattu} { return } set hakuikkunaAvattu 1 toplevel .haku wm withdraw .haku wm title .haku "SKuvaInfo - Haku" wm iconname .haku "SKuvaInfo - Haku" wm protocol .haku WM_DELETE_WINDOW haku_sulje set m .haku pack [ttk::notebook $m.seli] -side top -fill both -expand true $m.seli add [frame $m.seli.flap_nyky] -text "Hakusivu" $m.seli add [frame $m.seli.flap_tul] -text "Tulossivu" $m.seli add [frame $m.seli.flap_kaikki] -text "Tehtyjen hakujen sivu" ttk::notebook::enableTraversal $m.seli set n $m.seli.flap_nyky.teksti pack [frame $n -borderwidth 2] -side top -fill both -expand true text $n.pohja -height 30 -wrap word -cursor arrow -insertbackground white -yscrollcommand ".haku.seli.flap_nyky.teksti.hissi set" scrollbar $n.hissi -command ".haku.seli.flap_nyky.teksti.pohja yview" pack $n.pohja -side left -fill both -expand true pack $n.hissi -side left -fill y set n $m.seli.flap_nyky.alapainikkeet pack [frame $n -borderwidth 2] -side bottom -fill x set vaatimus 0 set k $n.vaatimus frame $k pack $k -side top -fill both label $k.je -text "Vaatimus:" radiobutton $k.ka -text "Oltava kaikki seuraavat" -variable vaatimus -value 0 radiobutton $k.jo -text "Oltava ainakin yksi seuraavista" -variable vaatimus -value 1 radiobutton $k.ei -text "Ei saa olla ainuttakaan seuraavista" -variable vaatimus -value -1 pack $k.je $k.ka $k.jo $k.ei -side left set k $n.haettava frame $k pack $k -side top -fill both label $k.he -text "Hakufraasi(t):" entry $k.fraasit -width 90 button $k.ohje -text Ohje -command "ohje 1" pack $k.he $k.fraasit $k.ohje -side left bind .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit haku_hae set k $n.riip frame $k pack $k -side top -fill both label $k.re -text "Pienet ja suuret kirjaimet: " checkbutton $k.rr -text "Tulkitaan samoiksi" -variable A_on_a set A_on_a 1 pack $k.re $k.rr -side left set k $n.kohdistus frame $k pack $k -side top -fill both label $k.ke -text "Haun kohdistus: " checkbutton $k.kp -text "Polkunimi" -variable kohd_p checkbutton $k.ko -text "Otsikko" -variable kohd_o set kohd_o 1 checkbutton $k.ks -text "Selitys" -variable kohd_s set kohd_s 1 pack $k.ke $k.kp $k.ko $k.ks -side left set k $n.suorituspainikkeet frame $k pack $k -side top -fill both label $k.f1 -text " " button $k.hae -text " Hae " -bg lightgreen -command haku_hae label $k.f2 -text " " button $k.seis -text " Seis " -bg red -command haku_seis label $k.f3 -text " " pack $k.f1 $k.hae $k.f2 $k.seis $k.f3 -side left set n $m.seli.flap_tul.ylapainikkeet pack [frame $n -borderwidth 2] -side top -fill x button $n.vaihda -text "Vaihda" -command ".haku.seli select .haku.seli.flap_kaikki" -state disabled label $n.tiedot -fg green -font {-size 10 -weight bold} -text "Haun -- tulos (------ osumaa) " button $n.kuviin -text "Kaikki kuvat esiin" -command "ohje 2" -state disabled button $n.kopioi -text "Kopioi teksti" -command "kopioi_tulos" -state disabled button $n.ohje -text "Ohje" -command "ohje 2" pack $n.vaihda $n.tiedot $n.kuviin $n.kopioi $n.ohje -side left set n $m.seli.flap_tul.teksti pack [frame $n -borderwidth 2] -side top -fill both -expand true # text $n.pohja -height 30 -wrap word -cursor arrow -insertbackground white -bg $histCol -yscrollcommand ".haku.seli.flap_tul.teksti.hissi set" text $n.pohja -height 30 -wrap word -cursor arrow -insertbackground white -yscrollcommand ".haku.seli.flap_tul.teksti.hissi set" scrollbar $n.hissi -command ".haku.seli.flap_tul.teksti.pohja yview" pack $n.pohja -side left -fill both -expand true pack $n.hissi -side left -fill y $n.pohja insert end "Ei tehty ainuttakaan hakua.\n" set n $m.seli.flap_tul.alapainikkeet pack [frame $n -borderwidth 2] -side bottom -fill x button $n.jatko -text "Tee jatkohaku" -command "tee_jatkohaku 0" -state disabled button $n.edell -text "Tee edellisen tason jatkohaku" -command "tee_jatkohaku -1" -state disabled button $n.ohje -text "Ohje" -command "ohje 3" pack $n.jatko $n.edell $n.ohje -side left set n $m.seli.flap_kaikki.ylapainikkeet pack [frame $n -borderwidth 2] -side top -fill x button $n.kopioi -text "Kopioi teksti" -command "kopioi_haut" -state disabled pack $n.kopioi -side left text $m.seli.flap_kaikki.pohja -height 30 -wrap word -cursor arrow -insertbackground white -yscrollcommand ".haku.seli.flap_kaikki.hissi set" scrollbar $m.seli.flap_kaikki.hissi -command ".haku.seli.flap_kaikki.pohja yview" pack $m.seli.flap_kaikki.pohja -fill both -side left -expand true pack $m.seli.flap_kaikki.hissi -side left -fill y $m.seli.flap_kaikki.pohja insert end "Ei tehty ainuttakaan hakua.\n" set m .haku.tilanne frame $m -borderwidth 2 -relief groove pack $m -side top -fill both label $m.t pack $m.t -side left -fill both set m .haku.valmis frame $m -borderwidth 2 -relief groove pack $m -side top -fill both button $m.uusi -text "Aloita uusi haku" -command "haun_aloitus 0" label $m.f2 -text " " button $m.teko -text "Hakusivu" -command ".haku.seli select .haku.seli.flap_nyky" button $m.tulos -text "Tulossivu" -command ".haku.seli select .haku.seli.flap_tul" button $m.tehdyt -text "Tehtyjen hakujen sivu" -command ".haku.seli select .haku.seli.flap_kaikki" label $m.f3 -text " " button $m.sulje -text "Sulje" -command haku_sulje label $m.f4 -text " " pack $m.f4 $m.sulje $m.f3 $m.tehdyt $m.tulos $m.teko $m.f2 $m.uusi -side right set t .haku.seli.flap_nyky.teksti.pohja $t tag configure otsikko -font {-size 10 -weight bold} $t tag configure otsikko2 -background lightgreen -font {-size 10 -weight bold} $t tag configure linkki -foreground SkyBlue2 -underline 1 $t tag configure linkki2 -foreground SkyBlue2 -underline 1 -font {-size 10} $t tag configure normi -font {-size 10} $t tag bind uusi_haku <1> "haun_aloitus 0" $t tag bind tehdyt_haut <1> ".haku.seli select .haku.seli.flap_kaikki" set t .haku.seli.flap_tul.teksti.pohja # $t tag configure otsikko -font {-size 10 -weight bold} # $t tag configure otsikko2 -background lightgreen -font {-size 10 -weight bold} # $t tag configure linkki -foreground SkyBlue2 -underline 1 # $t tag configure linkki2 -foreground blue -underline 1 # $t tag configure kansio -background lightgreen # $t tag configure kuva -background gray90 # $t tag configure hist -background $histCol $t tag configure normi -font {-size 10} $t tag configure otsikko -font {-size 12 -weight bold} $t tag configure otsikko2 -background lightgreen -font {-size 10 -weight bold} $t tag configure linkki -foreground SkyBlue2 -underline 1 -font {-size 10} $t tag configure linkki2 -foreground blue -underline 1 -font {-size 10} $t tag configure kansio -background lightgreen -font {-size 10 -weight bold} $t tag configure kuva -background gray90 -font {-size 10} $t tag configure hist -background $histCol -font {-size 10} $t tag configure vih -font {-size 10 -weight bold} -foreground green $t tag configure pun -font {-size 10 -weight bold} -foreground red # $t tag bind uusi_haku <1> "haun_aloitus 0" # $t tag bind tehdyt_haut <1> ".haku.seli select .haku.seli.flap_kaikki" $t tag bind jatkohakuun_klik <1> "jatkohakuun_klik" $t tag bind hakuun_klik <1> "hakuun_klik" $t tag bind a_t_klik <1> "a_t_klik" $t tag bind a_kaikki_klik <1> "a_kaikki_klik 1" $t tag bind s_kaikki_klik <1> "a_kaikki_klik 0" set t .haku.seli.flap_kaikki.pohja $t tag configure otsikko -background lightgreen -font {-size 10 -weight bold} $t tag configure linkki -foreground blue -underline 1 } proc haku_flap {flap} { .haku.seli select .haku.seli.$flap wm state .haku normal raise .haku lower . .haku focus -force .haku } proc kopioi_tulos {} { clipboard clear clipboard append [.haku.seli.flap_tul.teksti.pohja get 1.0 end] raise . lower .haku . tk_messageBox -icon info -type ok -title "Teksti kopioitu" -message "Nykyinen teksti kopioitu leikepoydalle." raise .haku lower . .haku focus -force .haku } proc kopioi_haut {} { clipboard clear clipboard append [.haku.seli.flap_kaikki.pohja get 1.0 end] raise . lower .haku . tk_messageBox -icon info -type ok -title "Teksti kopioitu" -message "Nykyinen teksti kopioitu leikepoydalle." raise .haku lower . .haku focus -force .haku } # ---------------- Hakeminen: set hakuKesken 0 # Tulosten sailyttaminen: set hakuJatkettu(1) 0 set hakuJoukko(1) 0 set hakuVaat(1) 0 set hakuFraasit(1) "" set hakuKohd(1) "Polkunimi" set hakuIPSama(1) 1 set hakuTulos(1) [dict create] set vapaa_tulosnro 1 set pohjadict "historia" set pohjahaku -1 set historiassa 0 set tutkittavia 0 set seis 0 proc haun_aloitus {jatkohaku} { global vapaa_tulosnro pohjahaku pohjadict tutkittavia historia hakuTulos hakuKesken hakuJatkettu hakuikkunaAvattu if {! $hakuikkunaAvattu} { avaaHakuikkuna } if {$hakuKesken} { raise . lower .haku . tk_messageBox -title "Haku kesken" -icon warning -message "Uutta hakua ei voi juuri nyt aloittaa, koska edellisen haun suoritus on kesken." -type ok raise .haku lower . .haku return } set historiassa [dict size $historia] if {[dict exists $historia "viim"]} { incr historiassa -1 } if {$historiassa < 1} { tk_messageBox -title "Kirjoitushistoriassa ei tietoja" -icon warning -message "Hakua ei voi suorittaa, koska kirjoitushistoriassa ei ole tietoja." -type ok return } # Seuraavat tarvitsisi tehda oikeastaan vain ihan ensimmaisella kerralla: .mbar.haku.m entryconfigure 3 -state normal .mbar.haku.m entryconfigure 4 -state normal .mbar.haku.m entryconfigure 5 -state normal if {$jatkohaku} { set pohjadict "hakuTulos($jatkohaku)" } else { set pohjadict "historia" } # set tutkittavia [dict size [expr \$$pohjadict]] set tutkittavia [dict size [subst $$pohjadict]] if {(! $jatkohaku) && [dict exists $historia "viim"]} { incr tutkittavia -1 } set pohjahaku $jatkohaku .haku.seli.flap_nyky.alapainikkeet.vaatimus.ka configure -state normal .haku.seli.flap_nyky.alapainikkeet.vaatimus.jo configure -state normal .haku.seli.flap_nyky.alapainikkeet.vaatimus.ei configure -state normal .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit configure -state normal -fg black .haku.seli.flap_nyky.alapainikkeet.kohdistus.kp configure -state normal .haku.seli.flap_nyky.alapainikkeet.kohdistus.ko configure -state normal .haku.seli.flap_nyky.alapainikkeet.kohdistus.ks configure -state normal .haku.seli.flap_nyky.alapainikkeet.riip.rr configure -state normal .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.hae configure -state normal .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state disabled # .haku.valmis.uusi configure -state disabled # .haku.seli.flap_tul.alapainikkeet.jatko configure -state disabled .haku.valmis.sulje configure -state normal .haku.tilanne.t configure -bg [.haku.tilanne cget -bg] -text " " .haku.seli select .haku.seli.flap_nyky .haku.seli.flap_nyky.teksti.pohja replace 0.1 end "\n" .haku.seli.flap_nyky.teksti.pohja insert end "Kirjoitushistoriassa $historiassa tietoa" otsikko if {$jatkohaku} { # .haku.seli.flap_nyky.teksti.pohja insert end "\nJatkohaku hakuun numero $jatkohaku." .haku.seli.flap_nyky.teksti.pohja insert end ", joihin on tehty seuraava haku" otsikko if { $hakuJatkettu($jatkohaku) } { .haku.seli.flap_nyky.teksti.pohja insert end " ja jatkohau(t)" otsikko } .haku.seli.flap_nyky.teksti.pohja insert end ":" otsikko .haku.seli.flap_nyky.teksti.pohja insert end "\n\n" hakuKuvaus $jatkohaku 1 .haku.seli.flap_nyky.teksti.pohja insert end "\n\nHaku kohdistuu saatuun tulokseen." } else { .haku.seli.flap_nyky.teksti.pohja insert end "." otsikko .haku.seli.flap_nyky.teksti.pohja insert end "\n\nHaku kohdistuu koko kirjoitushistoriaan." } .haku.seli.flap_nyky.teksti.pohja insert end "\n\nSiis: \n\n" .haku.seli.flap_nyky.teksti.pohja insert end "Tutkittavana $tutkittavia tietoa." otsikko2 .haku.seli.flap_nyky.teksti.pohja insert end "\n\n" .haku.seli.flap_nyky.teksti.pohja insert end "Anna hakuperusteet ja napsauta Hae-painiketta." otsikko2 if { $vapaa_tulosnro != 1} { .haku.seli.flap_nyky.teksti.pohja insert end "\n\n\n\n(Vai haluatko sittenkin " normi if { $jatkohaku } { .haku.seli.flap_nyky.teksti.pohja insert end "aloittaa koko kirjoitushistoriaan kohdistuvan " normi .haku.seli.flap_nyky.teksti.pohja insert end "uuden haun" "linkki2 uusi_haku" .haku.seli.flap_nyky.teksti.pohja insert end " tai " normi } .haku.seli.flap_nyky.teksti.pohja insert end "valita jonkin jo tehdyn haun" "linkki2 tehdyt_haut" .haku.seli.flap_nyky.teksti.pohja insert end " uuden jatkohaun pohjaksi?)\n" normi } .haku.seli.flap_nyky.teksti.pohja yview moveto 1 wm state .haku normal raise .haku lower . .haku focus -force .haku } # Varsinainen haun tekeminen: proc haku_hae {} { global pohjahaku pohjadict tutkittavia seis hakuKesken vaatimus kohd_p kohd_o kohd_s A_on_a historia vapaa_tulosnro hakuJatkettu hakuJoukko hakuVaat hakuFraasit hakuKohd hakuIPSama tulosLkm hakuTulos tulosYview tulosAvattu tulosKansio tulosKansioAuki avausPyynnosta avausEi tulosKansionTiedosto if {! ($kohd_p || $kohd_o || $kohd_s)} { raise . lower .haku . tk_messageBox -title "Kohdistus puuttuu" -icon warning -message "Valitse ainakin yksi kohdistus." -type ok raise .haku lower . .haku focus -force .haku return } # Poimitaan hakufraasit: set fraasit [string trim [.haku.seli.flap_nyky.alapainikkeet.haettava.fraasit get]] set ff {} set fos {} set fp {} while {$fraasit != ""} { if {[string index $fraasit 0] != "\""} { set flop [string first " " $fraasit] set flip [string first "\"" $fraasit] if {$flip > 0 && $flip < $flop} { set flop $flip } if {$flop < 0} { set flop [string length $fraasit] } incr flop -1 set fc [string range $fraasit 0 $flop] } else { set fraasit [string replace $fraasit 0 0] set flop [string first "\"" $fraasit] if {$flop < 0} { raise . lower .haku . tk_messageBox -title "Lainausmerkki puuttuu" -icon warning -message "Poista pariton lainausmerkki." -type ok raise .haku lower . .haku focus -force .haku return } if {$flop == 0} { raise . lower .haku . tk_messageBox -title "Fraasi puuttuu" -icon warning -message "Laita lainausmerkkeihin jotain." -type ok raise .haku lower . .haku focus -force .haku return } incr flop -1 set fc [string range $fraasit 0 $flop] incr flop } if {$A_on_a} { set fu [string tolower $fc] } else { set fu $fc } lappend ff "$fc" lappend fos "$fu" lappend fp [string map {"\\" "/"} "$fu"] set fraasit [string trimleft [string replace $fraasit 0 $flop]] } if {[llength $ff] == 0} { raise . lower .haku . tk_messageBox -title "Haettava puuttuu" -icon warning -message "Anna ainakin yksi hakufraasi." -type ok raise .haku lower . .haku focus -force .haku return } # Kaikki ok, siis tehdaan haku: set hakuKesken 1 .haku.seli.flap_nyky.alapainikkeet.vaatimus.ka configure -state disabled .haku.seli.flap_nyky.alapainikkeet.vaatimus.jo configure -state disabled .haku.seli.flap_nyky.alapainikkeet.vaatimus.ei configure -state disabled .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit configure -state readonly -fg gray .haku.seli.flap_nyky.alapainikkeet.kohdistus.kp configure -state disabled .haku.seli.flap_nyky.alapainikkeet.kohdistus.ko configure -state disabled .haku.seli.flap_nyky.alapainikkeet.kohdistus.ks configure -state disabled .haku.seli.flap_nyky.alapainikkeet.riip.rr configure -state disabled .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.hae configure -state disabled .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state normal .haku.valmis.uusi configure -state disabled .haku.valmis.sulje configure -state disabled bind .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit {} # Itse haku: # Seuraavaa tarvitaan erityisesti silloin, kun edellinen haku on hylatty sen takia, etta kaikki tutkitut ovat olleet osumia. # Siina tapauksessa vapaa_tulosnro on pysynyt samana ja hakuTuloksessa on siis jo valmiina edellisen haun tulos. set hakuTulos($vapaa_tulosnro) [dict create] set osumia 0 set prosenttimaara 5 set prosenttiosuus [expr (($tutkittavia * $prosenttimaara) / 100) + 1] set osalaskuri 1 set laskuri 0 set tehty 0 set loppusyy 0 set aika [time { dict for {avain arvo} [subst $$pohjadict] { dict with arvo { if {$pohjahaku} { set Kuva [dict get $historia $avain Kuva] set Otsikko [dict get $historia $avain Otsikko] set Teksti [dict get $historia $avain Teksti] # dict get $historia $avain Kuva Otsikko Teksti } if {$kohd_p} { set hp $Kuva if {$A_on_a} { set hp [string tolower $hp] } } if {$kohd_o} { set hos $Otsikko } else { set hos "" } if {$kohd_s} { append hos $Teksti } if {$A_on_a} { set hos [string tolower $hos] } set on_nahty 1 set i [expr [llength $ff] - 1] while {( $on_nahty || $vaatimus) && ($i != -1) } { set on_nahty 0 if {$kohd_p && ([string first [lindex $fp $i] $hp] != -1)} { set on_nahty 1 } if {! $on_nahty && ([string first [lindex $fos $i] $hos] != -1)} { set on_nahty 1 } if {$on_nahty && $vaatimus} break incr i -1 } if {$vaatimus < 0} {set on_nahty [expr 1 - $on_nahty]} if {$on_nahty && $Kuva != "viim"} { incr osumia dict set hakuTulos($vapaa_tulosnro) $avain OK "Ok" } } incr osalaskuri -1 if {! $osalaskuri} { .haku.tilanne.t configure -bg lightyellow -text "Hausta tehty $tehty %. Osumia $osumia kpl." update if {$seis} { set seis 0 # Vaihtoehdot: Jatketaan Pidetaan Hylataan raise . lower .haku . set vastaus [tk_messageBox -title "Haku keskeytetty" -message "Haku keskeytetty!\n\nTalletaanko nykyiset osumat haun tulokseksi?\n\n(\"Kylla\" tallettaa nykyiset ja lopettaa haun. \"Ei\" peruu koko haun. \"Peruuta\" jatkaa hakemista.)" -icon warning -type yesnocancel] raise .haku lower . .haku focus -force .haku if {"{$vastaus}" == "{yes}"} { set loppusyy 1 break } if {"{$vastaus}" == "{no}"} { set loppusyy 2 break } .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state normal } incr laskuri $prosenttiosuus set osalaskuri $prosenttiosuus incr tehty $prosenttimaara } } }] # Haku tehty. Ilmoitetaan tulos ja laitetaan kaikki kuntoon: .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state disabled .haku.tilanne.t configure -text "Haku tehty. Prosessoidaan tulosta ..." update if {! $avausPyynnosta} { # Koneen tehon karkea arvioiminen set i [string first " " $aika] set a [string range $aika 0 $i] set hitaus [expr $a / [dict size $historia]] set x [expr 30000 / $hitaus] if {$x < 2000} { set x 2000 } elseif {$x > 4000} { set x 4000 } else { set x [expr 100 * ($x / 100)] } set avausPyynnosta $x set avausEi [expr 2 * $x] } # loppusyy: 0=kaikki tutkittu; 1=keskeytetty mutta pidetaan; 2=keskeytetty ja hylataan if {$loppusyy !=2 } { set hakuteksti "valmis. " set lopputeksti "" } else { set hakuteksti "peruttu. (" set lopputeksti ")" } if {$loppusyy} { set osuus [expr ($laskuri * 100) / $tutkittavia] set osateksti " Tutkittu $osuus % tiedoista." } else { set osateksti "" } if {$osumia && $osumia != $tutkittavia && $loppusyy != 2} { set hakuJatkettu($vapaa_tulosnro) $pohjahaku set hakuJoukko($vapaa_tulosnro) $tutkittavia set hakuVaat($vapaa_tulosnro) $vaatimus set hakuFraasit($vapaa_tulosnro) $ff set hk "" if { $kohd_p } { append hk "Polkunimi, " } if { $kohd_o } { append hk "Otsikko, " } if { $kohd_s } { append hk "Selitys, " } set hakuKohd($vapaa_tulosnro) [string replace $hk end-1 end] set hakuIPSama($vapaa_tulosnro) $A_on_a set tulosLkm($vapaa_tulosnro) $osumia if {$vapaa_tulosnro == 1} { .haku.seli.flap_tul.ylapainikkeet.kuviin configure -state normal .haku.seli.flap_tul.ylapainikkeet.kopioi configure -state normal .haku.seli.flap_tul.alapainikkeet.jatko configure -state normal .haku.seli.flap_kaikki.ylapainikkeet.kopioi configure -state normal .haku.seli.flap_kaikki.pohja replace 1.0 end "" } hakuKuvaus $vapaa_tulosnro 0 .haku.seli.flap_nyky.teksti.pohja replace 1.0 end "\n\n\n\n\n\n\n" .haku.seli.flap_nyky.teksti.pohja insert end "Aloita uusi haku" "linkki2 uusi_haku" .haku.seli.flap_nyky.teksti.pohja insert end " tai " .haku.seli.flap_nyky.teksti.pohja insert end "valitse jokin jo tehty haku" "linkki2 tehdyt_haut" .haku.seli.flap_nyky.teksti.pohja insert end " uuden jatkohaun pohjaksi.\n" if {$tulosLkm($vapaa_tulosnro) >= $avausPyynnosta} { set tulosAvattu($vapaa_tulosnro) 0 } else { avaa_tulos $vapaa_tulosnro } set tulosYview($vapaa_tulosnro) 0 tuo_tulos_esille $vapaa_tulosnro if { $tulosAvattu($vapaa_tulosnro) && (([llength $tulosKansio($vapaa_tulosnro)] + $tulosLkm($vapaa_tulosnro)) < 16) } { a_kaikki_klik 1 .haku.seli.flap_tul.ylapainikkeet.kuviin configure -bg lightgreen -command "kuviaEsiin -1 0" } else { .haku.seli.flap_tul.ylapainikkeet.kuviin configure -bg pink -command "ohje 2" } set lisateksti ". Tulos laitettu tehtyjen hakujen luetteloon numerolla $vapaa_tulosnro" if {$vapaa_tulosnro == 2} { .haku.seli.flap_tul.ylapainikkeet.vaihda configure -state normal } incr vapaa_tulosnro } elseif {$loppusyy != 2} { if {$osumia} { set lisateksti " eli kaikki tutkitut" } else { set lisateksti "" } append lisateksti ". Tulosta EI laitettu tehtyjen hakujen luetteloon. Muuta hakuperusteita" } else { set lisateksti "" } set ilmoitus "Haku $hakuteksti$osateksti Osumia $osumia kpl$lisateksti.$lopputeksti" .haku.tilanne.t configure -bg lightgreen -text $ilmoitus if {($osumia == 0 || $osumia == $tutkittavia) && $loppusyy != 2} { set vihje "" if {($osumia == 0) &&([llength $ff] == 1) && ([string range [lindex $ff 0] end end] == "*")} { set vihje "\n\nTarkoititko mahdollisesti [string range [lindex $ff 0] 0 end-1] ?" } raise . lower .haku . tk_messageBox -title "Hakua ei tallennettu" -icon warning -message "$ilmoitus$vihje" -type ok raise .haku lower . .haku focus -force .haku } .haku.seli.flap_nyky.alapainikkeet.vaatimus.ka configure -state normal .haku.seli.flap_nyky.alapainikkeet.vaatimus.jo configure -state normal .haku.seli.flap_nyky.alapainikkeet.vaatimus.ei configure -state normal .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit configure -state normal -fg black .haku.seli.flap_nyky.alapainikkeet.kohdistus.kp configure -state normal .haku.seli.flap_nyky.alapainikkeet.kohdistus.ko configure -state normal .haku.seli.flap_nyky.alapainikkeet.kohdistus.ks configure -state normal .haku.seli.flap_nyky.alapainikkeet.riip.rr configure -state normal .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.hae configure -state normal .haku.valmis.uusi configure -state normal bind .haku.seli.flap_nyky.alapainikkeet.haettava.fraasit haku_hae if {$osumia > 1} { # .haku.seli.flap_tul.alapainikkeet.jatko configure -state normal } .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state disabled .haku.valmis.sulje configure -state normal set hakuKesken 0 } proc haku_seis {} { global seis set seis 1 .haku.seli.flap_nyky.alapainikkeet.suorituspainikkeet.seis configure -state disabled } proc haku_sulje {} { wm withdraw .haku } # ---------------- Hakujen nayttaminen: proc hakuKuvaus {nro flappi} { global hakuJatkettu hakuJoukko hakuVaat hakuFraasit hakuKohd hakuIPSama tulosLkm vapaa_tulosnro # flappi: 0 = tehdyt haut, 1 = haun tekeminen, -1 = haun tekeminen, rekursiivinen kutsu if { $flappi } { if { $hakuJatkettu($nro) } {hakuKuvaus $hakuJatkettu($nro) -1} set t .haku.seli.flap_nyky.teksti.pohja } else { set t .haku.seli.flap_kaikki.pohja .haku.seli.flap_nyky.teksti.pohja tag bind jatkohakuun$nro <1> "haun_aloitus $nro" .haku.seli.flap_kaikki.pohja tag bind jatkohakuun$nro <1> "haun_aloitus $nro" } if { ($nro == 1) && (! $flappi ) } { $t insert end "\n" } set kuvaus "Haku $nro" if { $flappi } { $t insert end $kuvaus otsikko set kuvaus "" } if { $hakuJatkettu($nro) } {append kuvaus " -- Jatkohaku hakuun $hakuJatkettu($nro)"} append kuvaus "\n" if { ! $flappi } { $t insert end $kuvaus otsikko set kuvaus "\n" } append kuvaus "Vaatimus: " if { ! $hakuVaat($nro) } { append kuvaus "Oltava kaikki seuraavat" } elseif { $hakuVaat($nro) == 1 } { append kuvaus "Oltava ainakin yksi seuraavista" } else { append kuvaus "Ei saa olla ainuttakaan seuraavista" } append kuvaus "\nFraasit:" for {set i 0} {$i < [llength $hakuFraasit($nro)]} {incr i} { set f [lindex $hakuFraasit($nro) $i] append kuvaus " \"$f\" " } append kuvaus "\nPienet/suuret: Tulkittu " if { $hakuIPSama($nro) } { append kuvaus "samoiksi" } else { append kuvaus "eri" } append kuvaus " kirjaimiksi\n" append kuvaus "Kohdistus: $hakuKohd($nro)\n" if { ! $flappi } { append kuvaus "\n" } append kuvaus "Tutkittu $hakuJoukko($nro) tietoa. Osumia $tulosLkm($nro).\n" if { ! $flappi } { append kuvaus "\n" } $t insert end $kuvaus $t tag bind hakutulokseen$nro <1> "tuo_tulos_esille $nro" $t insert end "Siirry tulokseen" "linkki hakutulokseen$nro" $t insert end " " if { $flappi != 1 } { $t insert end "Tee jatkohaku" "linkki jatkohakuun$nro" $t insert end "\n\n" } else { # $t insert end "(On jo jatkohaun pohja)" } $t yview moveto 1 } proc tee_jatkohaku {taso} { global flap2_haku hakuJatkettu if {$taso == 0} { haun_aloitus $flap2_haku } else { haun_aloitus $hakuJatkettu($flap2_haku) } } # ---------------- Tuloksen nayttaminen: set flap2_haku 0 set avausPyynnosta 0 set avausEi 0 set tulosLkm(1) 1 set tulosAvattu(1) 0 set tulosYview(1) 0 set tulosKansio(1) {} set tulosKansioAvattu(1) {} set tulosKansioAuki(1) {} set tulosKansioKoko(1) {} set tulosKansioOlemassa(1) {} set tulosKansionTiedosto(1) {} set tulosKansionTiedostoJarj(1,0) {} set tulosKansionAlkup(1,0) {} set tulosKansionInfo(1,0) {} # ------------------ set hakToggleTehty -1 proc avaa_tulos {haku} { # Rakentaa listan tulokseen kuuluvista hakemistoista global tulosAvattu hakuTulos tulosKansio tulosKansioKoko tulosKansioOlemassa tulosKansionTiedosto tulosKansioAvattu tulosKansioAuki hakToggleTehty set hakemistot [dict create] foreach avain [dict keys $hakuTulos($haku)] { set i [string last "/" $avain] set hak [string range $avain 0 $i] if {[dict exists $hakemistot $hak]} { dict lappend hakemistot $hak $avain } else { dict set hakemistot $hak [list $avain] } } set listana {} foreach avain [dict keys $hakemistot] { lappend listana $avain } set tulosKansio($haku) [lsort $listana] set lkm_lista {} set tiedostolista_lista {} set olemassaolo_lista {} foreach hak $tulosKansio($haku) { lappend tiedostolista_lista [dict get $hakemistot $hak] lappend lkm_lista [llength [dict get $hakemistot $hak]] lappend olemassaolo_lista [file isdirectory $hak] } set kansioita [llength $lkm_lista] set tulosKansioKoko($haku) $lkm_lista set tulosKansioOlemassa($haku) $olemassaolo_lista set tulosKansionTiedosto($haku) $tiedostolista_lista set tulosKansioAvattu($haku) [lrepeat $kansioita 0] set tulosKansioAuki($haku) $tulosKansioAvattu($haku) # TEE hak_toggle:t if {$hakToggleTehty < $kansioita} { while {$hakToggleTehty < $kansioita} { # Tulee yksi ylimaarainen, mutta se ei haittaa set t .haku.seli.flap_tul.teksti.pohja $t tag bind k_t_klik$hakToggleTehty <1> "k_t_klik $hakToggleTehty" incr hakToggleTehty } } set tulosAvattu($haku) 1 } # ------------------ proc avaa_kansio {haku kansio} { global tulosKansio tulosKansioKoko tulosKansionTiedosto tulosKansionTiedostoJarj tulosKansionAlkup tulosKansionInfo tulosKansioAuki tulosKansioAvattu historia set tulosKansionTiedostoJarj($haku,$kansio) [lsort [lindex $tulosKansionTiedosto($haku) $kansio]] set alkup {} set info {} foreach tied $tulosKansionTiedostoJarj($haku,$kansio) { lappend info [file isfile $tied] lappend alkup [file isfile [dict get $historia $tied "Kuva"]] } set tulosKansionAlkup($haku,$kansio) $alkup set tulosKansionInfo($haku,$kansio) $info set tulosKansioAvattu($haku) [lreplace $tulosKansioAvattu($haku) $kansio $kansio 1] # set tulosKansioAuki($haku) [lreplace $tulosKansioAuki($haku) $kansio $kansio 1] } # ------------------ proc tulosta_kansio {kansio} { global flap2_haku tulosKansio tulosKansioKoko tulosKansioOlemassa tulosKansionTiedostoJarj tulosKansionAlkup tulosKansionInfo tulosKansioAuki tulosKansioAvattu historia set haku $flap2_haku set kansio_nimi [lindex $tulosKansio($haku) $kansio] set koko [lindex $tulosKansioKoko($haku) $kansio] set auki [lindex $tulosKansioAuki($haku) $kansio] set avattu [lindex $tulosKansioAvattu($haku) $kansio] set t .haku.seli.flap_tul.teksti.pohja set j [expr $kansio + 1] $t delete kansio$kansio+1c kansio$j if {$auki} { set toiminto "Sulje" } else { set toiminto "Avaa" set pit 63 if {! [lindex $tulosKansioOlemassa($haku) $kansio]} { incr pit -10 } if {[string length $kansio_nimi] > $pit + 3} { set kansio_nimi "...[string range $kansio_nimi end-$pit end]" } else { set kansio_nimi "...[string range $kansio_nimi 3 end]" } } $t insert kansio$j "$kansio_nimi" kansio if {! [lindex $tulosKansioOlemassa($haku) $kansio]} { $t insert kansio$j " ! Kansio kuvineen kateissa !" pun } $t insert kansio$j " ($koko kpl) " normi $t insert kansio$j "$toiminto" "linkki k_t_klik$kansio" $t insert kansio$j "\n" if {$auki} { set kuva 0 foreach tied $tulosKansionTiedostoJarj($haku,$kansio) { set h_tied [dict get $historia $tied] dict with h_tied { $t insert kansio$j "\n" set i [string last "/" $Kuva] incr i $t insert kansio$j "[string range $Kuva $i end]" kuva set alkup [lindex $tulosKansionAlkup($haku,$kansio) $kuva] set info [lindex $tulosKansionInfo($haku,$kansio) $kuva] $t insert kansio$j " " if {(! $alkup) || (! $info)} { if {$alkup} {set a_h "vih"} else {set a_h "pun"} if {$info} {set i_h "vih"} else {set i_h "pun"} $t insert kansio$j "! " $a_h $t insert kansio$j "!" $i_h } # bind voi olla tehty jo aiemmin, mutta helpointa on kuitenkin tehda uudestaan: $t tag bind k_e_klik$kansio$kuva <1> "k_e_klik $kansio $kuva" $t insert kansio$j " " $t insert kansio$j "Kuva esiin" "linkki k_e_klik$kansio$kuva" $t insert kansio$j "\n" set ot [tiivista $Otsikko] if {$ot != ""} {$t insert kansio$j "$ot\n" hist} set ot [tiivista $Teksti] if {$ot != ""} {$t insert kansio$j "$ot\n" hist} incr kuva } } } # $t insert kansio$j "\n" } proc tiivista {s} { # Merkkijono tiivisys s.e. white space (rivinvaihdot mukaanlukien) tiivistetty aina yhdeksi valilyonniksi set r [string map {\" LAInAUS} $s] set r [join [list {*}$r] " "] set r [string map {LAInAUS \"} $r] return $r } # ------------------ proc jatkohakuun_klik {} { global flap2_haku haun_aloitus $flap2_haku } # ------------------ proc hakuun_klik {} { haun_aloitus 0 } # ------------------ proc a_t_klik {} { global flap2_haku set haku $flap2_haku avaa_tulos $haku # Ja muodostetaan tulos kokonaisuudessaan uudelleen esille set flap2_haku 0 tuo_tulos_esille $haku } # ------------------ proc a_kaikki_klik {avaus} { global flap2_haku tulosKansio tulosKansioAuki tulosKansionTiedosto set haku $flap2_haku set kansioita [llength $tulosKansio($haku)] for {set kansio 0} {$kansio < $kansioita} {incr kansio} { if { [lindex $tulosKansioAuki($haku) $kansio] != $avaus } { k_t_klik $kansio } } if {$avaus} { # Poistetaan lajittelematon tiedostolista, koska kaikki avattu ja lajiteltu: set tulosKansionTiedosto($haku) {} } } # ------------------ proc k_t_klik {kansio} { global flap2_haku tulosKansioAvattu tulosKansioAuki set haku $flap2_haku if {[lindex $tulosKansioAuki($haku) $kansio] } { set tulosKansioAuki($haku) [lreplace $tulosKansioAuki($haku) $kansio $kansio 0] } else { if {! [lindex $tulosKansioAvattu($haku) $kansio] } { avaa_kansio $haku $kansio } set tulosKansioAuki($haku) [lreplace $tulosKansioAuki($haku) $kansio $kansio 1] } tulosta_kansio $kansio } # ------------------ proc k_e_klik {kansio kuva} { global flap2_haku set haku $flap2_haku kuviaEsiin $kansio $kuva } # ------------------ proc tuo_tulos_esille {haku} { global flap2_haku tulosLkm hakuJatkettu tulosAvattu tulosKansio tulosKansioKoko tulosKansioAuki tulosKansioAvattu tulosYview avausPyynnosta avausEi if {$haku == $flap2_haku} { .haku.seli select .haku.seli.flap_tul return } set tulosYview($flap2_haku) [lindex [.haku.seli.flap_tul.teksti.pohja yview] 0] set flap2_haku $haku if {$hakuJatkettu($flap2_haku)} { .haku.seli.flap_tul.alapainikkeet.edell configure -state normal } else { .haku.seli.flap_tul.alapainikkeet.edell configure -state disabled } .haku.seli.flap_tul.ylapainikkeet.tiedot configure -text "Haun $haku tulos ($tulosLkm($haku) osumaa) " set t .haku.seli.flap_tul.teksti.pohja if {! $tulosAvattu($haku)} { $t replace 1.0 end "\n\n\nHaun $haku tuloksessa on $tulosLkm($haku) tietoa. Tuloksen avaamiseen liittyy kaikenlaisia yksityiskohtia, joten sen tekeminen vie suurella aineistolla oman aikansa. Tee siis " $t insert end "jatkohaku" "linkki2 jatkohakuun_klik" $t insert end " tai " $t insert end "kokonaan uusi haku" "linkki2 hakuun_klik" $t insert end ". " if {$tulosLkm($haku) < $avausEi} { $t insert end "Hui hai, avaa nyt vain se haun tulos, kiitos!" "linkki a_t_klik" } } else { set kansioita [llength $tulosKansio($haku)] $t replace 1.0 end "\n" $t insert end "Haun $haku tulos ($tulosLkm($haku) historiatietoa $kansioita kansiossa)" otsikko $t insert end " " $t insert end "Avaa kaikki kansiot" "linkki a_kaikki_klik" $t insert end " " $t insert end "Sulje kaikki kansiot" "linkki s_kaikki_klik" $t insert end "\n\n" for {set i 0} {$i <= $kansioita} {incr i} { $t insert end " \n" # Seuraavassa -1c ei riita, koska silloin kaikki mark:it kulkevat end:in mukana yhtena nippuna $t mark set kansio$i end-2c } for {set i 0} {$i < $kansioita} {incr i} { tulosta_kansio $i } } $t yview moveto $tulosYview($haku) .haku.seli select .haku.seli.flap_tul } # ---------------- # Nayttotilan vaihto: normaali tila vs. haettuja kuvia set tila 0 # 0: normaali, 1: kansion haetut, -1: kaikki haetut # ------------------ proc kansionKuvatListoihin {haku kansio} { global tiedostolista kansiolista tulosLkm tulosKansio tulosKansioKoko tulosKansioOlemassa tulosKansionTiedostoJarj tulosKansionAlkup tulosKansionInfo historia set curdir [lindex $tulosKansio($haku) $kansio] set koko [lindex $tulosKansioKoko($haku) $kansio] set alkup $tulosKansionAlkup($haku,$kansio) set info $tulosKansionInfo($haku,$kansio) set dirLen [string length $curdir] incr dirLen -1 set kateissa 0 set i 0 foreach tied $tulosKansionTiedostoJarj($haku,$kansio) { set h_tied [dict get $historia $tied] dict with h_tied { set rivi [string replace $Kuva 0 $dirLen] if {! [lindex $alkup $i]} { append rivi " !" incr kateissa } lappend tiedostolista $rivi lappend kansiolista $curdir set rivi [string replace $tied 0 $dirLen] if {! [lindex $info $i]} { append rivi " !" incr kateissa } lappend tiedostolista $rivi lappend kansiolista $curdir } incr i } return $kateissa } # ------------------ proc kuviaEsiin {kansio kuva} { global flap2_haku tila histCol dir tiedostolista kansiolista fn fidx tulosLkm tulosKansio tulosKansioKoko tulosKansioOlemassa kotiHak set haku $flap2_haku if {$kansio < 0} { set tila -1 } else { set tila 1 } .mbar.haku.m entryconfigure 7 -state normal .nfo configure -bg $histCol .nfo.dir configure -bg $histCol .nfo.count configure -bg $histCol .pane.vasen.files.liste configure -bg $histCol set tiedostolista [] set kansiolista [] set txt "Haun tulos" if {$tila > 0} { set kateissa [kansionKuvatListoihin $haku $kansio] set dir [lindex $tulosKansio($haku) $kansio] append txt "ta: Samassa " if {[lindex $tulosKansioOlemassa($haku) $kansio]} { set jdir $dir } else { append txt "kateissa olevassa " set jdir $kotiHak } append txt "kansiossa olevat [lindex $tulosKansioKoko($haku) $kansio]" } else { set kateissa 0 set k 0 foreach curdir $tulosKansio($haku) { incr kateissa [kansionKuvatListoihin $haku $k] incr k } set dir [lindex $tulosKansio($haku) 0] if {[file isdirectory $dir]} { set jdir $dir } else { set jdir $kotiHak } append txt ": Kaikki kuvat eli $tulosLkm($haku)" } set fidx [expr $kuva+$kuva] set fn [lindex $tiedostolista $fidx] append txt " kuvaa infokuvineen" if {$kateissa} {append txt " (joista kateissa $kateissa)" } cd $jdir .nfo.dir configure -text " $dir " .nfo.count configure -text $txt .pane.vasen.files.liste selection clear 0 [llength $tiedostolista] setImg raise . lower .haku . } # ------------------ proc aloitaUusiHaku {} { global tiedostolista if { $tiedostolista != [] } { if {[muutosPeruminen 0]} {return} } haun_aloitus 0 } # ------------------ proc palaaNormaalitilaan {} { global dir fn newfile histCol if {[muutosPeruminen 0]} {return} set newfile "$dir$fn" if {[file isfile $newfile]} { avaaKuva 0 } else { avaaKuva 1 } } # ------------------ proc normaalitilaan {} { global tila set tila 0 .mbar.haku.m entryconfigure 7 -state disabled .nfo configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] .nfo.dir configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] .nfo.count configure -bg [.pane.oikea.napattava.inforivi.fname cget -bg] .pane.vasen.files.liste configure -bg white } # ----------------------------------------------------- # Ulkoisen ohjelman asettaminen ja kuvan avaaminen # ----------------------------------------------------- set asetaulkikkunaAvattu 0 set ulkoinenOhjelma "" # ------------------ proc avaaAsetaulkikkuna {} { global asetaulkikkunaAvattu if {$asetaulkikkunaAvattu} { return } set asetaulkikkunaAvattu 1 toplevel .asetaulk wm withdraw .asetaulk wm title .asetaulk "SKuvaInfo - Aseta ulkoinen ohjelma" wm iconname .asetaulk "SKuvaInfo - Aseta ulkoinen ohjelma" wm protocol .asetaulk WM_DELETE_WINDOW "wm withdraw .asetaulk" set n .asetaulk.asia pack [frame $n -borderwidth 4] -side top -fill both -expand true label $n.seli -text "Ulkoisen ohjelman kutsumuoto:" entry $n.ulkohj -width 90 -font {-family Courier -size 9} button $n.ohje -text Ohje -command "ohje 4" pack $n.seli $n.ulkohj $n.ohje -side left set n .asetaulk.painike pack [frame $n -borderwidth 2] -side top button $n.ok -text " Ok " -command "asetaUlkoinen" label $n.fill -text " " button $n.peru -text "Peruuta" -command "wm withdraw .asetaulk" pack $n.ok $n.fill $n.peru -side left } # ------------------ proc pyydaUlkoinen {} { global asetaulkikkunaAvattu ulkoinenOhjelma if {! $asetaulkikkunaAvattu} { avaaAsetaulkikkuna } set n .asetaulk.asia.ulkohj $n delete 0 end $n insert 0 $ulkoinenOhjelma wm state .asetaulk normal raise .asetaulk lower . .asetaulk focus -force .asetaulk } # ------------------ proc asetaUlkoinen {} { global ulkoinenOhjelma set n .asetaulk.asia.ulkohj set ulkoinenOhjelma [string trim [$n get]] if { $ulkoinenOhjelma != "" } { .mbar.file.m entryconfigure 5 -state normal } else { .mbar.file.m entryconfigure 5 -state disabled } wm withdraw .asetaulk } # ------------------ proc avaaUlkoisessa {} { global ulkoinenOhjelma dir fn # Kuvan nimessa tyhjeiden eteen takakautta; Win lisaksi kautat tuplatakakautoiksi set tclNimi "$dir$fn" if {[string index $dir 0] == "/" } { set kjNimi [string map {\ \\\ } $tclNimi] } else { set kjNimi [string map {/ \\\\ \ \\\ } $tclNimi] } if { ! [file exists $tclNimi] } { # kjNimi ei sovi seuraavaan, koska siina on tuplatakakautat tk_messageBox -icon warning -title "Ei kuvaa!" -message "$dir$fn: kuva kateissa!" -type ok return } # Seuraavalla ei aukea tyhjeita sisaltava tiedostonimi: # set komento [string map {%% $kjNimi} "exec $ulkoinenOhjelma &"] set komento [subst -nobackslashes [string map {%% $kjNimi} "exec $ulkoinenOhjelma &"]] if { [catch "$komento"] } { tk_messageBox -icon warning -type ok -title "Virhe" -message "Komennon suorituksessa tapahtui jokin virhe." } } # --------------------------------------------------------------- # --------------------------------------------------------------- # --------------------------------------------------------------- # --------------------------------------------------------------- # --------------------------------------------------------------- # Varsinainen toiminta alkaa: # --------------------------------------------------------------- # --------------------------------------------------------------- update lueHistoria set dir $kotiHak if {[file isfile $asetusTied]} { # On asetustiedosto set ekaKerta 0 set fileId [open $asetusTied "r"] set rivit [split [read $fileId] "\n"] close $fileId set dirnimi [string trim [lindex $rivit 0]] if {[llength $rivit] > 1} { set ulkoinenOhjelma [string trim [lindex $rivit 1]] if {$ulkoinenOhjelma != ""} { .mbar.file.m entryconfigure 5 -state normal } } if {[file isdirectory $dirnimi]} { set dir $dirnimi } # dir luettu asetustiedostosta tai kotihakemisto (jos asetustiedostossa ei kelvollisen hakemiston nimea) } else { set ekaKerta 1 set vastaus [tk_messageBox -title "Tervetuloa!" -message "Tervetuloa SKuvaInfon pariin!\n\nOhjelma on tehty rehellisin aikein, mutta sen toimivuudelle ei voida antaa takeita.\n\nJatketaanko?" -type okcancel] if {"{$vastaus}" == "{cancel}"} { file delete $ajoTied exit } } set fn "" set tiedostolista [] set kansiolista [] if {$argc == 1} { avaaKansio 0 set arg [lindex $argv 0 ] set newfile [string map {\\ /} $arg ] # .pane.oikea.napattava.teksti insert end $newfile if {! [file isfile $newfile]} { # Olisiko tullut Wine:n kautta levyasematunnuksella ? set newfile [string range $newfile 2 end] if {! [file isfile $newfile]} { tk_messageBox -icon warning -title "Ei kuvaa!" -message "$arg ei ole polkunimi kuvaan!" -type ok file delete $ajoTied exit } } set piste [string last "." $newfile] if {$piste<0} { set tyyppi outo } else { set tyyppi [string tolower [string range $newfile $piste end]] } if {$tyyppi != ".jpg" && $tyyppi != ".jpeg" && $tyyppi != ".png" && $tyyppi != ".gif" && $tyyppi != ".bmp"} { tk_messageBox -icon warning -title "Ei-tuettu tyyppi" -message "Kuvan $arg tyyppi ei ole tuettu.\nValitse kuva, jonka tyyppi on JPEG, PNG, GIF tai BMP." -type ok file delete $ajoTied exit } set tekstilahde " " if {[dict exists $historia [infonimi $newfile]]} { set tekstilahde [infonimi $newfile] } else { if {[dict exists $historia "viim"]} { set tekstilahde "viim" } } if {$tekstilahde != " "} { .pane.oikea.napattava.otsikko delete 0.1 end .pane.oikea.napattava.otsikko insert end [trimmaaEnd [dict get $historia $tekstilahde Otsikko]] .pane.oikea.napattava.teksti delete 0.1 end .pane.oikea.napattava.teksti insert end [trimmaaEnd [dict get $historia $tekstilahde Teksti]] } avaaKuva 0 } else { if {! $ekaKerta} { avaaKansio 0 } else { tk_messageBox -title "Aloitetaan!" -message "Aloita avaamalla jokin kuvatiedosto." -type ok avaaKansio 0 avaaKuva 1 } #Jos hakemistossa ei ole yhtaan kuvatiedostoa: if {[llength $tiedostolista] <=0} { tk_messageBox -title "Ei valittua kuvaa" -icon warning -message "Valitse kuva tai kansio, jossa on kuvia." -type ok .pane.oikea.bbar.monitoimi configure -state disable } else { setImg } }