mapivi097/html/light.css0000744000175000017500000000504410120125150015565 0ustar herrmannherrmannbody { background-color: #dddddd; } p,ul,ol { color: black; font-size: 80%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; text-align: justify; } h1, h2, h3, h4, h5, h6, big { font-family: "Trebuchet MS", Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } big { color: #454545; font-size: 130%; font-weight: bold; } h1 { color: #454545; font-size: 130%; font-weight: bold; padding-bottom: 0px; } h2 { color: #707070; font-size: 120%; font-weight: normal; border: 1px solid #cccccc; border-width: 0px 0px 1px 0px; padding-bottom: 0px; } h3 { color: #707070; font-size: 110%; font-weight: normal; padding-bottom: 0px; } .right { text-align: right; } .left { text-align: left; } .center { text-align: center; } .nav { color: #000000; font-weight: bold; text-decoration: none; font-size: 80%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } .title { color: #000000; font-weight: bold; font-style: italic; text-decoration: none; font-size: 130%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } .boxtitle { color: #000000; font-weight: bold; font-style: italic; text-decoration: none; font-size: 105%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } .box { background-color: #eeeeee } .boxhead { background-color: #aaaaaa } .small { color: #000000; font-size: 60%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } .footer { color: #555555; font-size: 60%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; text-align: center; } a { color: black; font-weight: bold; text-decoration: none; } a:link { text-decoration: none; } a:visited { text-decoration: none; } a:active { text-decoration: none; } a:hover { color: #ff3300; text-decoration: underline; } div.pic h1.headline { margin-top: 0px; margin-bottom: 2px; } div.pic h1.headline span.name { float: left; } div.pic h1.headline span.index { float: right; } div.pic p.pic { margin-top: 2px; margin-bottom: 2px; } div.pic p.caption { margin-top: 2px; } p.byline, p.location { font-style: italic; font-size: 67%; } p.byline { margin-bottom: 0pt; } p.location { margin-top: 0pt; } p.exif, p.iptc { color: #454545; } mapivi097/html/simple.html0000644000175000017500000000324710014462522016136 0ustar herrmannherrmann <!-- mapivi-galtitle -->

[home] / [galleries] /  / 

[Prev]  [Up]  [Next]

<!-- mapivi-alt -->

-
mapivi097/html/readme.txt0000644000175000017500000000077610014462522015761 0ustar herrmannherrmannThis directory contains two HTML page templates for mapivi and a style file: simple.html is a simple page template which will produce pure HTML pages light.html is a template with a clear style using tables. The colors can be changed by the style sheet light.css the file light.css should be located two directories below the album pages e.g.: /light.css /albums/albumOne/pic1.html /albums/albumOne/pic2.html /albums/albumOne/pic3.html mapivi097/html/light.html0000644000175000017500000001117410120125150015741 0ustar herrmannherrmann <!-- mapivi-galtitle --> - <!-- mapivi-title -->

 Index

/ 

<!-- mapivi-alt -->


-
mapivi097/html/fluid.css0000644000175000017500000000454110320620726015574 0ustar herrmannherrmann* { padding: 0; margin: 0; } body { color: #000000; background-color: #dddddd; font-size: 10pt; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } p,ul,ol { text-align: justify; } h1, h2, h3, h4, h5, h6 { font-family: "Trebuchet MS", Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } h1 { color: #454545; font-size: 160%; font-weight: bold; } h2 { color: #454545; font-size: 140%; font-weight: bold; } #head #path { color: #000000; font-weight: bold; text-decoration: none; font-size: 100%; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } a { color: inherit; text-decoration: inherit; font-weight: bold; } a img { border: 1px solid black; } a:link { color: #0000FF; text-decoration: underline; } a:visited { color: #000080; text-decoration: underline; } a:active { color: red; text-decoration: underline; } a:hover { color: red; text-decoration: underline; } #head, #foot { background: white; border: 1px solid black; margin: 1em; padding: 0.5em 1em 0.5em 1em; } #mainspacer { float: right; margin: 0 1em 1em 0.5em; padding-left: 2em; border-left: 2px solid #dddddd; } #main { float: right; background: white; border: 1px solid black; padding: 0.5em 1em 0.5em 1em; } .thumbs { margin: 1em 0.5em 1em 1em; } .thumb img { width: 22%; min-width: 6em; vertical-align: top; border: 1px solid black; margin: 0 0.5em 0.5em 0; } #head, #foot { clear: both; } #main #name { float: left; } #index { float: none; } #main #index { float: right; color: #454545; font-size: 140%; font-weight: bold; font-family: "Trebuchet MS", Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; } #main img { display: block; clear: both; border: none; padding-top: 0.5em; margin: 0 auto; } #main p + p { margin: 1ex 0 0 0; } #main #byline, #main #location { font-style: italic; font-size: 80%; } #main #location { margin-top: 0; } #main #exif, #main #iptc { color: #454545; } #foot { color: black; font-family: Verdana, "Lucida Sans", Arial, Geneva, Helvetica, Helv, "Myriad Web", Syntax, sans-serif; text-align: center; } #foot #copyright { float: left; } #foot #date { float: right; } #foot #hack { clear: both; } mapivi097/html/fluid.html0000644000175000017500000000435610320620772015755 0ustar herrmannherrmann <!-- mapivi-galtitle -->: <!-- mapivi-headline -->
/

<!-- mapivi-alt -->

<!-- mapivi-alt -->
mapivi097/pics/thumbExample.jpg0000644000175000017500000004456207750163735017134 0ustar herrmannherrmannJFIFHHF(c) 2003 Herrmann Urlaub auf dem Bauernhof Allgaeu Weiler-Simmerberg'ExifII* (12iTOSHIBA Exif JPEGTOSHIBAPDRM70 HHDigital Camera PDRM70 Ver1.302003:06:02 17:13:39"'d0210 08 @H |P0100d> 2003:06:02 17:13:392003:06:02 17:13:39H 5   R980100(HH    !$!$   }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzx! ?*xҷc Vj;$[@ 3Lo^kh <@^{WijkSϧ{e 'B8cQR85-Y;zDv.qWOF#ͳuc|ltvRF6GѿxjkWe"&kz_ B\*+4f= MaOm+mҴ+TVeCS9Ts[\[L洝h OZ|=sy{ w6nvRMLˍ99$Ze[-j$@ouަnlXʅ9b>lb)Jw=e$dTp{WC44Eg@efm7Y3T [:fdV{+S?Y0H9ɫ6lw&ưz˫Kõfl?ߊb wj.U>ZlhL6$>J;yIʟ^kK+5U۞5ZI.2c֣Ѣu;!Uq\lfR8XN}H%rxRG'IܬSpJ[Ӛn5Z|1O~y隔ew6 6dV87bTc%!)D?ƿ[[@5 3!~c*r7g5h+u_]N<͑  +s#c ]**RGGo'" lm؄?zׁV5܏dt@:U 3T\P`To:B3#F5{QkOӭf;|pRnVF2ĹSVx$;qjkJ{[I&iv(5sk)k| 8~ajKy5i*+# `T$^eT3o;kPY/=ĉ `eA_NJ1Or4%Cz r=Q-6j]ο^'Vn+ F2{I%{_e 8A%͚>Yo!; ckrTPO#+)˖_֦5RZ=NSpn0pc1a^-L3Aި%ݔ'?t%k=B[ :܆`aU9V mϛ`2TDOyۭ0;J; v4-/1nd 3;"'ռ1A, 5o31^ 빊!e>b,u6lm^ Y EԌ]S,B$N-TwVիi˧fcȋ} 7(PUx&;-98 g#zɻ5R,+i-3%#Amqq99Ԧ-0>6:H; kl$] P!7ʮt:~{k5{.oGMZBw储}I 'u}/+Ot/jv2[V0Wqb#ܚҍ9έv1Uϓ'k").),\hᲫ*'&)966l.dF !5d^\"I*MŴ~#qz (zנ]# gֳh'4b#+Sn#T{4id=Kƞ8ԭbK.$]Y a#(W#YXAqhk/X)$@.3Bb#'uc((FMB(uIne!,a$p7g=Nx8kGܼ{6fzG-4{>JԥH._23,1$ nܨFGVCl#H@ƃj"t8v&[(-Vv =ŽxG`ļ b*ż<)JoRw|GO+޳Ofm$<1n 8OӞkcdHv0#8qzNH89 ڤK|pr3.Qē}ؼC*@9G*|+zۡV[̑5xNK(9Dfr˒W<i{-]I}I n-@Y]ehi5 |?SKX-w{EҌl06~,G Z;k8`MM[7gP4x*rUkWrU~CðhFfayF9UNۻz溸0NU8$y.G:ίAo3o׷ẋ\Fk JU8aS="m'˱*\,;<r?:EC+hU8R9#p{qҾWmbFQFs۟Nz rb,ʹeLy9pP~T)ۀWs+r \uH 20峁럮=黭ؖ+$ڀB͂ݰ~D 2r 98tW,$z~YٲgR_ѭa%Rt:6wkرd6;t+$J̒EF'?5zW7I`jԋ]aeԺ*UC.*t{}jqMzfη.zNs5񿽓ʉC2t8װS7`bYHdWN;}vtl~0xq Ѥ1ubIZ֖>ԟ_̥nz>Y²eFI@9?C2$qK1 ,HOSVjqL K pPsREcqi$^IXry=4KrHi 3fヴӯC۷jcC,,RrH"5mZ$&0 v99QD0 J g9S+&Ymfݒ,8 sTgKp\ߕ?Z-~q#=I90<{JOA^RY91x\c4?0o#a]}94+nCI3BKm Nl䅇7QK)nF[cxO"T Fs.kl4 ,`zT i4e$ xq)j4Ѿۄ[z¹#1FZ6 s$oq[avd }8=O$qzǧ*b]J򤄒Hg= St&:c'<=^W+D r9#8s:7ꮵ Y#HXݓߌ}qr՜IVSO<E5mt 0DO<_֢Ws1l T%Xv#oUA`|%={ cPQIzRUɎC߮HI .ߔ>H5>Lƥƥ]dg?\Sg[spH'~?RlC    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222 "E !"12AQBaqR#br$3cs%5CSU%!1QAR"aq ?+xXLjhث NƂֹdS2Mߵ.GĖ*WG D74rIb(7򡑃OiK&gݸ~QZ(r4cڭbP{UsG Ej LTPhT\IoB䜚nQiA=yWz>!; CG,ZGݥ:To^<.M1onjWW*ki7[pUJc|i͸ M+-Aץ{UmH)9]S4e:tR;KhW?J;fFǕLSɥUʯ-FW$ Qh$  oٴs$|9wsF^Y&c+ {_ sݻJJ-242 mq땵g?w)B rI SYe[a"Xg?\o3J͂{(̥IsSl}(ѡzCR +T հsY*RRVI5N'$&ʫ)bVjf]Jn@ |ʠ04%bhij7`Rŵ+,4,9J2ZkYWfz6Q k|h,RBnHКe#Eo/giwgV+X)TޟW Nw. m)d@3EK3qN'%nʫQ/Xc*аڛ&AK MCS1&GV5ESJQZJ5]`:k5-6UP,LUZU28S: [Qa'Ic]N"h Uޓ;̓DI4ZuvcsAqSjıX  1=ET4qޟӅYNHR}*WʑɹsҗRv4i P}Y `*JejZVaտ&ițZ5IEGMuJeJ`ԮSɽQ ɜb6jt朄LirAǑUJ*U]JbR翺5^>uΏTgZdOY]?4pp1.~f֭թ|)NaC4BdčO^]9yk l!LAb>[DBhԑwS0:h*Th*T2cR19U)K$2smF>T8fs>@b8_v#u4fBWoT];_8q> g9_?- `5ӎDtWm$gj^Vb"RQ(bı~^U A82iy.sg̚7Yeuv첬q AG_vs./Yp@C6 :W:[1p ӵpt#cN#/f9Ax/sn.uՕaieV}ڎ=m}^Yq)H;.܉H F>]-H]]Wţ) cXf/?u6U;񇋈' Dļz~ڦ8VD?kS4`]Qf]MoݥeQB98իImOkor"hDf}}]Y]?fIpt-v TrKo 6sDVotcn#H.Gu4YuRm uK^ H)P"2s"\i8]Xv3;rJ&9 :WZMM73[[Uj2ak*]9-:J_´\^^l%6IVҺ|ZKBӄ,mn_W/`8lҽb>Z+cOξ 4"Z߼U}G~8/0^WH ` ˝=+]=LGL93ݨnt 3PwRPFz[sZ(h$Bh)%v:yJeOr(Jd"6[;gm@ZĉR]Cc;ЧHr$MmYYYP'¶22ԩR2;sޱ=FGzCVGzo[[2 іp&㸭ޔhXڝvN\51zOIa:,s2˾0Ep*w89&ld v`VRҩeC#1ȑi]Z|Z{.iY崙ilNK1>\oӏSWmy 2 /hHnTGPV2Wqxvں=*LEnO\͓IӷWQZɼK^qySFr;MA<0Y%eF,̽=ogg^H/o- ]8g2UoHOm%+ q{p9-+%]=*u!:HU-u|-'e_ۤ1\=ʌȀ*fmYbp ѫ? \q {eonPNsI5Ԅ`#ڐťPdԒG@=<9)D Օp'T9|hJw\Y̿y}#nܷlmJYvSZzH\2*{yީ>ׁZIs kN-$Չ"Ć̇rC5; ̝?*!tA1u<l-lc{U mJP6R>ʶ?_3{:%8"%W*9ex[gmP\acX*JsW*WKq{i_[#RY^#Z_ԉS*,UpVͥw篮Krl/\,سjuTG[m. |AYې5%I\mUowv7ë#(3`qQ/D5Κ_] ~/\p^)8C/Lu c?V\/66/z[Ofe7UPIh|u|>.K)"a&s)lieotfi<84~/uV9>|p7m"pUoYuW^{I"^#knVQ#u>-RiGOWK.mU%Hj6 ++|:^ž-cHddxK2G+`yyGYVybfNcnڼ"7+q].wx@uڎi֝BZ|{lKUR0c+n sXq;>dqGV]>Uϭ;S3E]\kޤ\:GOB3\v`и\ ?J5G(:U ;]$+kdszV7v1*z 0 7\Z۠V %bvZ&/jZ \N>V8'o5~խ[W4qnqh[Cpq7EKi=_B@!I]uq|RV.%¯-nxㄎcmumV٥ X;Pz>oW-+ksҺtk+[S췲$ ɒK#̊E_ҭUzW =2nV+PcR.4Y[FfHsMZzUKZx?[@ȱ{Ax-9XDƭUTV\ۤW&b|>KԶP++u,i1t}'I,7pB[V;a+kOR2Ol8kD ڴjUT*cƪY叹bחn,V[JCcEalt|[ki+ 9g$#ӐUbWV'䶑F=Cniqq 5Y;R[ȱ$]:~aow\=_gnz]^3IjvfFOIYt>x Ceg3,Su+PKi鯦-Û{%ebs¶ qYܨ__4,~(ُYjkha "ڷ[zWQChIߓ/'!}EM֣maH";QqPv]tAw'Z%VL]GΫSjih'Nw=jcA88Y ۬yNru3޾]<%zNcNf!7u.X{N| ou.H;FmqAg’@?g#֩i#f @mj +aΜp-ǧKtzzm'#ҍ2J[n9lH== GbOW8襳LƢPB`7m(g F 2})m"]Yخݪj f>%ebrGcQiO`R~艹zagQS΍87a==k z|u@Q; mѺA@ # gZΤf ܪ0POa\ A@XHbWY 5A9Ѻd_qǕlLtx-'H:\ JW;Ls$Jvj.f+(\v'aޔdfkȎiNpki8M}.\~tpr5.=<`F*Fe4q+Ķ'#տ~%.::vk:UX{QǓx޷.:"ȼj8 .ն5|gBIw9D5gUYkGqq^i"է2gNs*l;k?`I=# w#PnGεP7%l! @ӀFug(c/n=J|:lz [-XӧH`LG__ơU>c֧ ) $U$B$ߤb0 sTC~Xz9 (ܮ0?UWlmʽN_%82MGX n R['u 98*VI9ޝ;OllY+ά~og` &QNT7ڴU$NGM=+$ دle8??`VnZs ګV6z eZ" SY'In 5F>@/Ƙ1KmoTApMl#JTUbBN7 ϑ;J6T XFriҡ3>s.{gFD VL$7?JgN@EFcG@$>U1$a5\*d9L<9l:Nw+D:d@Tzp֛q>UzUu TZv\~ұeq RY|ޣeJsv#J;b08Hz**T/j\?<ԩL !g}?:7'rsR(msuxT?r Ҁj)d8Ak$v\( 1;e}R9IҁJ65@Kz#ԩL5'j( gc$tbO1c{3ldC@$_ثIfcq}9Hi%E ޭ$?y*Բvs/)fMwm@8 RUSsi+ꐆ(BŀX'51 ղ :[ q}⊛P=-~w~vº!B:uП¥!i -.@ES3w<O >usgdXBKIKrHBO"X%WdTE}]ۅ\u61 ,B(҇RځyuǙB/o;LynB4Dqt pT'Cm`nq  (~k1ynS;r-[~N~Q*D-_nBr4D:A[,f[i@W*0+EmOfR_zzN XАx'͹jbcFKJ[ɷ*YMʭ{ A#cq)SZB:b-ۆĞ鰻Z*^8:î J 9X+OZ0?OKna(\ *Q꾗߂U͹åOnrFvۏSqh&M?]TgKorx]zcE s aw?MOUPNl3?cy5&fVwpgGERUm,X;_/+4^Q\r2Smݞlq89jV*[9<&XMx]P(~LB$eIlvBX%H@ME1W Y-\ߩW&(uؖT4Q0T.BѭPջE҉~Xغ:77Sq}C@A#1l)\{ywĽ@IJ[7ғ)r0Uki>.ֽ1}2 k~==s4ʼX6; C s5nl)L,݃ E/a厍{/9wֽ1= kt=@vXV\KO{1 llZ#8-9vik^]5L0iD_ tf:c@qs*e}̻ *T\ scGN`Zۛ="Omapivi097/pics/exif.gif0000744000175000017500000000261307754145642015412 0ustar herrmannherrmannGIF89a  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!Created by Martin,] J =sY8gN HQ ':q)TIęC)ĊٳT^Ɣ Ԣ=rx2R`;@|څ !;w$:9QGA{ϝDXQ,^Ŝ=Kb\aǐE È M~|έC^;8M I\ú5z屆Gk\|jei߾>hq<>D%7&P%Θdic{J*#ti5%̠\j|RW<$pn"=6<$ЃF)hDC@6P+b WG ,Ѕ_]T$J"f1>x>pa 3a"i )౅7B Ъ FlTRJ*4 z|䆄d" jlD &6,䞜64l F<JLnl^\&bdzt|& .,4&B4\ t" D 2,&$Z\zl&><FDfd&ԢtB<l vt*,< NLԆ"RLd &$rt"6$NL^\&jl~&<&><t& T 24,"VTND l" jdT :<t F4rt~|><d L .4^\BDJLB<.,&.$$24܎ZT~|JL>4VT&d"&$fdljld쪬bd:,*$"$B4\ nlD :,l J<fd4*d b\*" L 6<nt&$z||&t"&$>DFLv|NT"< t&V\^d.4&$srN  yswwGTXbnn)nnb"TTXbnn)nbX"+nYpppYnb"T"+nYppY)bTT"pUUp)?XTTTXbpUUYn` IdYnX"TTT` dd$UpnaCf1m$UpnT""""T"a|v7wEp\|v^ xO[Un+X"X+X+XXZvj*[$,)Q6j=[Up)++b?)nn?b6^B*q*[$pQ7tAk&[UbnYYpn7ox=$,)w Bl[$p)nnYpUpYxqz.[$,w S*[U,Yggp[$Up4E.;.[$,)wB*eP[$pJR$[[wq;l;$pwko5[|tA=[U~w.y;[$,)wB*u8[$Uv1k*z [MEqye=,wBo]8[[fEj::qn[$wq=e[$p)wBo8[Mtoq::$[ME;=u&$,wB:0cUZ7&]B;zp$ME;zu&[$,)w*:f:u_ƾ;&]pw*xrvtu>vw;-jy&e$,)w*x06wk2UGfvs>W^A=&0e[$,wo.5Hwtl},CfE |z܄ "dlj D&,646 lDFdf&Ԥ &t T42,"TVDN  "ldj T<: t4Ftr|~<> d L4.\^DBLJTV&"d$&dflljddb,:$*$"4B \ln D,: lLF|vTN" <&t\Vd^4.$&srN  yswwG!, I8PTXTBTRypSIOPt!)D( ԀOdD5A`!Ã%hgQ"E˝*tYR@ pFU@d4:*\a7?V<ϝPyԨd&7VOE O<,0%,0`HI̩JwA:$ RNzjedJ'՟t#Xdy| AL ˖*p|.":Oj]vb1Jo4`";)#4 ep $^%Խ}@r4qu8FqPz,l[(oP#HA}f H #W(0 w! Ua^у 0c-"YuLvܱpy`Iw]Q @(&tap`:0UhqC# zABEti&8g(Ba l.t(x@Eq8b]ĨƬqXzGe^Y B’P"᭡ * đW;ot"JHU yXPnIqZQlg0 xpgp ԩ +Bq)FpS0pdJ.-z"FGk0s3̙hȞ`6Ј=+ 1%6xam*| |x<+`!y炍&Z0 L@C``F mh]0JSR" w"$AF'zS1\3d&pTq?@Da!UbLI>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!Created by Martin,] J`>y$OBO HQ ':r(dJ)MșC)Ċe\*V/cʌjH>L!Pkg/vuINNԃ+ht^=s'(V W1gʕX/W1$(8kc*éRBDQhS%VE=z3RBuCycȐkCTyuk.x>4BDŃKhN↶ 5Ԉ>\Rb"`'8=͟#(R: 8∓ΜWSN┳LcBlKZG=3ُI=3ُI < ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤ< ɟzH< ɟzH |lǤ|lǤi7M-Ԧq[BRҥ ^]XOm{~YG6am#4;^WV!1S'~ B!i=̿_/5?5?Cy Â:;mG>^$jWÁ|^#v?^$Afx<1`^"B>A%J|1`o^*D49||%K<1o}^ _W0||KĘxdW TL {K 0փ\^$.Rjx<2Ok_WQ.sxo Z̀}^ pAˣ^$6Znx<3`?嫿_W)] 2'~߃u/-]7RA!i.sx jр}^ !ˣ.c//]7R0σu/}!Aˣ^%\7Rpσu/vD6-sx7EsKMsK\aBR, [?&rx<5lʗ09l)H9\}vs}cGE5 U&~(8ꏠÎ?|U&.i?]q}cGAg+>)a m`Pa'⋫Ö?V>T}q±z")Bt 0ag⋷ÞT}6mƯz" L9QxtٷꏠæͿT}QАry0Efߌj>æͿT}QBZ)5/?6cW=Qxtٷꏠ2Аry0Ef>5eV?QE@`0aͧîU}vkʭ~"ɇ6/5eV?Qxuٯ*"|L9Q{v٧:ö?վ}P$L\~(|;l[GBxv٧:ІQ&~(|;l[GAf>(XCɇ6/4gV?Qxvٟ:%bEf*>3gV?QAsQ&~(|;WGAf*>(KCaþU~}gҫ~"Cɇ7=)vqeeTjFme5Jm*BTH6. XF(sOLIGtӽa:ԕF}kq}kq{ P?HÑbEw/aj8r,Hc [^:hr{xZ@[褛^;^:hrO%Nq2;$N!7[&ʷޟ?$v1+iBI`a,LrWV!Zsu6d3'Cy=Lgrۇ處jaąȾ2WMf:JqfH*'F_s.ʃI~?YYTUwAQ~B?{Q0IdJI,Ci3HNWw wfe}p%Mf4+5wKR+sKU|{Q̽=Yqj_kE=bza 8 1Q!axp4&4C0B4Z CKq80N$=4[7`T\jnn 5)Q|3VR.(l Z'Dy5D/{ Meq=13W"y[t;'[s'BM}Q.0qWh멉e`([C  HJ1"҄L twhN2;UU.! @$fMR;8}7xG )7: k9_uQ)"ҬR:$%GLs(:Eȱt-$;!F5 x) Ĭ,H+O3bli'CH 1A1CyÌ%m DHC Z R?n2qMnl?6 Jj]!R%Ut(%q"4jfK T\}Ljc&`ojxߨXG}F8uv=?y|H&gfG`-`eRi2Y+ZN]C?v.Y]⥩>b:%!',\̽Acy`)Yg+UjlM& -w!$Q1匌y;BXcs,QNaei8 $<㩷 MƗ0)BsN?4zDH}'PfEQ joFT,c"MԁlҨBkH%Li@XX\ Sְ2#Sr μuI]m6$Vt7d0iF sdT͡:}i(Sٰ&it}+Ŧ\<׾Z>ʴfV.Y_K(UbAXpׄ@,:Ǣ%JR%$j ` nmÕ(ZgMMHߢmneP(Y7p#NQI#$֭m'6I!KB$j"saI۽ xL.)͞a2TdTE hΖI3c̗io+ ~UI}"gsW))5ka~kAKga uzS.DkE, ]81pTw=&Sn"hѡV)ؖ^ -.mP7 R@";񒒺gei!0sBa  $8q " А4Bs,24Hd-ւ\C n$,i?(Dye2gq%#s/?}kq}kqfz;b^>pX]KZG=j'-#c~ZG*a>׎fV;`)765$Cb>3*Fqt,ZtzmEIMn')$(&:N;siY^:.^'2 Y#kCXJIh@ep²l&ZCHJQ f2EG\Q}zmX,JęܳKSmI,"11~i҆EV x8Ui'&?_g1ÓīLM4e IiYĨ9- k4(-3ZEzjG`e55OUȋM­y$l2yGs'v*r51@Ii#.??54d7/D&'tSw\~+ԥEsUZVJ7Wǭ)|b%ZDk J18fcJYPk  hZ+HXw$ .۳*tSa9JԚ\וYxJ-'rtXv2u|]!^ͭ6?ikr!H"a =;6K Q陦PJ=-/8rՙ$*YKQ B$l!n0v-5%jΠBrj8u]2ETZaքim醴kFAIVR͸oS{Jƴ{i.RuAsO*\yC2JmǫAhd.q{δ$vM t{2xQ+JBE\UIv, ͤbIX$j܆}\BfaIKV Zܭ9AʹDt vTbM+I&KU1^0LQ w2 %AM $ DSa:bZe :B ?BsmQU/;2FP[dkȟɐÃ+gC4IK k;RD}s/*rHlyj{N:Ԭ14}q)l)BFkN1ŨWY~IT*+V9A/YYMjfV T.3jnb>lx|<4vny R7HOrOu*Rܪ+,ij:M#\"QrRZ\RS2"Eq4:VBߔ7yu|s^KeԢPIP@vu!7eΒƫ҉RV'X<^m~ 5IpX]KZGj'-7zT9hЎ^7䆘o8yFald"mi 7KCH%q "DaCD%!<!Ba 5 8qϮQKjU&P؋Am{j5)ME9=9eL5.ihH;*iiPÎ;KJ̀R+*׫ )J؄3!YYKm<ꎁ#?xt7>yZ&ʸ ԣ ЄB[o0Zیd!Qrm\..6&n[%:+q;QYeomf11)5&魋&M4놐m꘡ zݘOJjUTpk'ByNu##ƊUR qٔU:Sp0)uZBYs&bJaC_\e?XyeN`Ùxml\BOIGuy&+*:PLNIgeYqYu.)Vى4!aSILԽ)*Cx8u>OMTIPH Gzx,_s\.~Xp~alsf[,%,shs)Y(-Q0TJ4놬]Z1-Yj)P6eUoUj̙j="a;!d VlN`2%9l"o :KiTKN9!2葛BFSswc᩸Pmnnohr|2 P-|`PG -{񈼮4~5MIMv\ZK!zkBt25Uv\B2C׸6sXԴ{>Ta׋z8FFP)̢ʔ-}9WnlEZ,/RcffraٴLRu V[H#1\mfrYa,){-T6lmV3I9JL].śeÔꔮT(o5eAe,Y&m-x@쉺r#5"WUS˛NFҕ N:tfJV]l?CWIsxfV@^BF-0˄ai}4r0ۧՌN)U di tTʊO=!NR$FdtT9/7Sxѧrs̲uz\,{ ( &9ER*؝[ Bւ eMm/{U+)$( U&]N)08)8xTjY͜9ٗUBASXT*ySJgIttۙM(a$I3 f ̺\ @XbYy;>eܤ.S{fˈ5[Sh.o 6s6PeUj,  T% hVR$xfxȉZd!aJOD#-";T:"s]jQӯܸIK|7 X{nz.ihJaoTR6)Qq8¹SS(o:TAZF9>tNrejl P NTԤ˷0uUӚZU-XocNMu4t,ĻlR]!`T#ci,i2;iK4Sݤ|Gmfe)HJrl]o{r qkB L"F/Q{7uIʥARn^%A:hJuЛN6x3g,yҷJSM$Y'^[Hi)#%BnUVէdu,lK*ֵ^{8J2 9YjuihIM٪tnm`JQLC#eJX`HHYVOҝ 6NYMgJ:1#ú3pЗb)je8<ӮL)Xvz%JvyGG*ڔ܁wIE-Yčz;y*$bhqK):dx8ym*U^nZ`4Ym,K9s8衧+GJcV$NREϪ@'F Fpl/nmS.2WZIyUjT/kym\g)$C;3%@v=LcGlYQfXk DWLMيW&2RBbJu68ln[CPB A F_s3VhHy BAma`m ht%6c B6HiBC-hB hB4B\;%0АxAp CК@f2gq%=٦S $БCe#zGaB/ s7n={B/ s7n9GlKZG+{ P?HÑbC߱?-QD[G#'Ŝg ̄NM몶erJ@ZހOdr櫕GRE6$ІEb"4Wj+s+X >+M薓k's+8|5gFԨ=@TY[TVp+8is ιs*1*& n]AD&nxX=Wɶ'c=XSꕘS&Zu!+C +AʄjoqW9fކ8)B&rʹi5RR!YÉ@qskmϔRS1V7P}7P1(scP72`}#*- ,Q\΄fiF&Wiʺtcb\vAjXo+Iry:b%Nn3NKhnv[q$aiB/b4Dc۫bќPZύKWdEUɱ~.+4pb),̺Z}yԆqp'8-WS5ݸGT4dw^WԞ6)@J~^%db8{mg^D.|鄚M%E1+NRݶ tLYG*/rIRGu)Bo%c(ǹBrbvZKw/Q|6!3.eOel9n5.8[e%ds}9ůP+BWHBn_UVFhKn-^ՔO8{b؝Z`zם[in`4I]"⛯T*xjQsHzJR}i)Qŕ3!6 <#ɔʈ:@QU] NUj I|Ϻ |\KjYi6/Ǐ . ˸H,,-b/p{yZ:RMRfp*m3YPBLGef'1+2bë Аs\hun<=n$l,9ie˶RÚ{^hךp+`n]q<ЎRjbٗe]wy@n c>(cUӟDk),η) $G2AӲ:-*%6'7%'r6iX֝6bYW3/?7G,M kܴH94W1+R*D2P})%,ɸ /u؎:[z9g̜Mҥu*q7+pK 'K -ܔSƝ- <ͤ )xZ7T̻_Z! kv >s^6lgtbՖ'mjuҔ=0KzZJADo49)=$G?qߩ[_1dRJɑl7)(˱~A_0LiՑb!YtÔIZm%ͺJ6 q]W7y"jMٟBBBqF5lLAf5(-r.]+! 'U%'C(xz܌˧E˪؈isRVhd"`QY j#qV מ J9|́{۳dE>T^AgܫIcYqJNi:gE*mC>ǷK ޹YTڥ's} ד.2s94 V/;2쬠[- @6`LJ)P Z iX-a1"a׈e8lϩf {&v-RK]%fT-KW'}aG^)R BJZHЏ4BPυ%2U-xߧ$9$nBQH th8IOKGؓbmJO kGo1VaYu+I:T$qjjŏF i3 %C%ƛZHqB[H.!-Xeí!6ZAdBZXi>aCBB5Hc'Q8̽d J=O~=?!mن!mنؗ9$W{~"Ć2c-QLֽFC:8O9ؽaL"F 144MDŽ!ndZT4nC,c!ptDzfaFF$ŹˑE9N[P,xhVa* _Sh+;- һ&2n NѪTOͰTijR>(/UYƝib9S-gSF4qLMKl Ԯ$A~ZaL̺i(X0U˗ HM"lT\ziiUx!Dr<;xD/R'+^̬nfh{rrse˛] 4o{_n;3)jIԅZUHmnUeθ*&H"+;dSU뛲tM,qz}V3243rO*Uv-\"]4. QnJu9_D vу3gMjTt6uynSb/s ˲WU"[te偷$|qҭ!}ț*GtZ 2ZL(,*phQu*jV%bwS t^3.@לD. tk{q썔m$#rWWl*MU@$E9&}E\( s8~v[qmvRDf < *ӯ7\B;&aL:u4Ɣw4L6HBTc'ju(Ú}Ldk0\—cu߈^!($mkmW4:Ek3X "ɷl#ln&RCa[NXkx%ǒn*)JE'=Q\V`L.) 8I$hÑ\-N=&ژanm 9@Rr%**\hGa%)KIZHPG>W܍)B1%=R)Ws>$6E;Ԓ#eP[a9u50I9N[_1Ŝjji2UE$ MEGK$%*yiBN)g(74oJR'+y wpR)KUNe$rE1JvLz/RZg0]q!U"mr9Gj3.s%"QIJwD|D *C1%RԤtυ8Ks2qkq9(ʶ4əiȿ](99VHa Jnl\UX7Q x:̨-nj!z -9Eޤ?l|qÚyjBTJK.Xhu /Rexj9u)I"qHΩWT}z9Tn8qzrUaLP !(KyPJ>s V1+Qϰ&fyYE$puQZrP]R zZ\ܣTs8R iEMYS֒,($9[bZ%H5ܪ*.[uDnH$)kLNS;uYBtup A%8΅k9{aa676*fjͺt-b`\pV>գVmhhL,UlVF -kNBJ$GY-)Ucˮ4ہKhsMmr|aʡ(6 A$-]nIN*'$Lf4'.Т9fh Si)R-nNך]Ɛr1>.4%aAF]rz*K7PBFd⇏be_0ĄdƘu*IK(KrTFnZ $Es-73R.SZ'F5Sj 9'CvIA\,.З2+q/r6i)@_qK,˱U堩9]iP`6n4.i)RSmRNQ<2S,^S`JMa5>䔣،;!G^eTl)z~IwN&óR#3mLYԴ2J76TW'Q-$"ި0O!Cf[ TuKY$ L(dK̰Jcdi]SK-2%%Fk2JuFJͰnLJ$YPW^RJ':t'Cb Ym`FU)SfS\J7sg-9[5znݏ% 3t9% $![@Hd+vU;ӕn gʜԕ&g,VYC139.Jy,*%&ui=%VRgGt:МqD#HM!a4 HKP䢮(D'8Np)ZBР I:ۏpM[F$%p !ӎ 78A.m :X Z$[2i?(yf~2gq%+~?Hx<_f>nz<_f>n`fz;b^>pX]KZGֽFC6|7j1|YnC a?eiKCm~ƬS)m%He)`Qߕ8/mF&ej2_+Zs nU#,9OHtoo4Dc$a qP5W&r)MIQӴE6ˏkR+azIASD=:'f*ܫԪFrmɅ$+4ZWpM奄,RNQ=2JrHS/k8;rVZMRt [n<8%7I=bTJRdp@k2U.7{ ':pbr nYLHmNGg2غ{SiצS-~ˤ[a{D`,AB Ib9JM/{E^W`,l>cRԆ <(m뉌i$asn0JUv%+%}SI mGU+RۅfP2)6^=2hQݤe팍]KaO$u;\Y&RCE*L_DZX!o*Uqn-a"1 g;_z*7<rk㻹[)u$$:gZmjZRQL,8\une 17  R>(I4Rd't%Z(tni8I "ITJUkk0\ASAT8VUjˮ.K,n ؗ4MBY̆] xۍr˨u\꘸Ka`r,Ggt9zrfN*I Z ܕ|c3TLÍ"mBzH]F(TU*išXS4&TyL<̻.]EWNzԩMͿJ:ܸSB@%P,O: } EV~s}%ơ,K唅 S0#f#fw[%7ə Uڎ>zROj AE*MIcԎ=}wLI҇bJU K ix)5)8+Fc%eiI,÷qJuVeq$ߎ~ZF)wO.sQ]cꉩQ-VӫSzrWOn7EA ô ~*'=|i#ͮ%;}L?iij)W֤؞'1 L(-9au ԛkdr,< kXi=i8$z@(nxØ)D6Vw6d9lsh78YfHħO%VoIuK6[7!&ױ3qY,͂G9b@uG>NS7iU4h:0RZRrRa*ed[P V+jYJȃ7ˡtjzrPoh(Kľg !D\ @:+YX/s:2.r0ꥅ"@[t8RlHJJ} 6ԃ# 눓eqUgǎT`MR֧ɢ\ (,A[TAݎ$w:ڝqIIUQ$ '*Ok2Z/9Fn+pd$ ei@㥉ԺTsR-tb߻Wg%>*ћ<8F[gYWt C=!iaSYi쵺R53bN9yDUO\%md9A 6 '))ʕ(SuR[ U֒TO*"ҔemJte΋r(%MbYT!R#(7F/)6զP cꉔPeXr3ΓRuw;uKoQ@sÉCJZ'U׸MƠv^(-y>ClSœl[C.#ﺹľR #]P9s&ջԁTհl陽}RjZC.i RZ! t `7O}N-LRl[J:6ъ[`M n*Rii#\>YCIGrĚJBz;»$ q= Tmђ$M'tR3ʈ+唢Jrm䎱i^ ̳qHJQ*TIBNIW4Y_f^m*DÉީ22QT|U,;@gӋ% 8 ؕZky6%q$( klͥŕO4SҖpZx*.K+OՕBZq;W9 BxkX :G-%vtm U' gzeCmY#Ť6~ʍN4se)"Vr.1U!m]+xY鉩7#*G$$CDeYS h]czF*AFjGyjKRYbUP%)*$ l ׎3HNL-*vQ M:!'V%èn^U)CSo"5IFO2RF@])xX\V5i;rNvBVp:5.e0Ҡe,Z;2{OKIjfAKͥwZ))T)V\*nePNB4l]݀#^(o-Jd[n] .rViBQ,$2H fK6٥cl>,W/8MO8$mwa<-)TStLxLiV 8N BKfMSX2IfPi:R)cs6$cr3&v/8Po ۛĠk `b=IvX0WVP{E֐Eޥϵ&RpO׍G*} "NZ(Kk)JHyG:ʒoe{VG^JrR.Fa责E9JbQLj~apmG8,4Tk|Tplpa%56rtbzCәZDeKiCmӘ-`ѹ6>>5̻:$dekzɌ:ajaZԥ5|f#dNsVۭ޺OrюaʂnU"ʐڟZϛspe\jl|['XMSs+t33ݨy{ܩl!ߤOpM"6&TU-'뎍jJoSRHD71!HQ! Ưr.GڇDMqݭMYTK)Kq*+Rn@ؒJVDig,)(6qW&ڞ:d`J 4*yVlJ& gAQBq\M4鷝Bba E)X&~;齵1i fòn;ćGI<. I^1!M\9CۗڏbF;ت'\JHK,ʆo!͝DkȈv"'@JXou UJu^|wՔݸŵ\i".i/V3 黍%ĭRb{coSkrUBf.o:=2\%ҰN2J$=aU;"J̼묩7EVRVx&(* ߥa+*ON^8]b"I+r2C9F}$Chhm qR+V@`2IѫqC$#1JHO*JMūoy*5ą0gSm fBF4&q TGe\BCsi]s wDUt٪Rrt 3*O*ug<`MZ* H2 : qTE#T+"IRqǘSUGBJTxભO5g PͻY'$$P\[ -p56Oj!?/5Jp Jn7jyGTS,:jܤwi-L^YuuDoLo BG@b81X֘ !ɓmM1Ya-0Twm) /S)ЊZW4K)Ai[vZ N}i jL'}¨mT܃r-<"A#\ªf2 ȴ橘qo :_/at9"VW&bX<80ڇ lKA 7#E_+O5,z =U-S "ɪ))D' Zʤ<VMŎ[ylV^Ji҄Yoon^6D"m٣.i[7wY #1%?|n=/&YE L9JS@ 7:q! Xn}KG $MgJ @BQښP8ܦƛed&H7y1̨RRs*܌κޕMuBAWS)44ze)S(nםj˛rMvlwYc"%:ꖇj$c}cuRFgD; J[H0RJJ^1JcLl**K^!F$ !v+rYqaխɁn4!NI'P#Us4:qfzCoIHJJS&gZ`HXBOќFvщ+-Ia+@;FS"ܰ@*xsAMF%Reؓ~d!kKa$$*g>A`I#5aIRs nZSnZeC-Q6%vI#]nHby9gSs{)^[*m:&V1[T*eoܲrHm5"\2¸٤ZFK-Ӿ`=%s2)JKr BwUqrl2'uxߐ[8m+s X3xW'1[kJ$ JHJRA@#6ƬՙJ/dO#ƴZ*S7Oq(nII5}Fj,(*Q2n#O.5c*w (Oq8b ec3`$.}m{pMQI"V˾gYHԛ'R bo5' RBA`,BU}z;5W49&M2r%WZ_e83^ǫKgSI*-F $ȵa)R-8/._TOZ!v6m/Ur8q&0.9֥(N ؟N~i\RRSL Z']mY-AP6̈꿴YӪbLT(GtUS(z fȶhr[]$2I]!ĽEse$[Z-+:/Փ>K)! G[KK&[_MLzMSgZmU.JPʗ`4yjL$ JSxXL{ם#> v_,2N2o+5}oo}_\iSJi uu'y.#x\'!?W%J%PI!o`8aHaM,%mU)*Mk1զy`f3wEb]Uɑ%rOw!Œ)#{aͭ\95TTsUGRjBfT^p@:L7@zgwzJQ>J:W| 6~ȵ69VXUnC[S]Yr؃aoxEJ\Rêp>JBni2t&],J2TrDrKE#V/,\Ao9GSbogMS5榻uP$7 yG3m {'Q9%.Z-Y[,MŗH7˱]5upj8NN*]"eo ^D)'WQcGKSS0, [QB6H)rc;G&\iA Ne &^/G^ 7XU6gRS8 $&,82u%wmc{M=h>wS.fIaKB_CQqe6 /ml?\tbCr%!B<k/ЋrF* f7!/;bgۙal̒60c TqO{8k ZPZp,\Y\53bZ2dIrET4qsrR2u*܍ ` ɩY!8fdҵ4JPl&33S7-j0eos5bUpdw(X#jraoN8{Bƍ.Nٝ{LdjddolUʅ*R} L)%E7BT8 I 3lI:Yf 01gQd;򁆩 Yi[im%qnr[ƿcm Ld^/ 8Fײڥ^b q杏-nm%-K A()32uhˋm֕5j_p!mن!mن٩ؗ9$W{~"Ć2ۊgHu RqYRꌽ66|Xa}aٯLPa94ͿRJ[l $v"!7^;vZw| 5iwf%J%NE *ItAV:)/x<CcI02Fʵgy8HQJÊH 퐐Ne)'PT qmL ?tDַ3$Qj-QJrxǜmP&#btMf&Ii Rka>VFTIA]j7F\T_JNExgP+ oT Q$~FS vض`8zרGO9fؘrZZU*ȷU`BB=$uEiCKzL i敻st%V:~xN] 1z\#c9\y +v8\Õ׍lϺ2,f6;QJBB<ϴ|CQ~HP%t ؃s^(Kf]BERӌuYN+QA: _[\!8-J9IJ7IԞ<aJ.,.y O"-ieI%[0蛂cf#A7Oa#n>վh6Z*yм/L *6 * MF+Mȧr$Q+K2ie <JH݌ HNGڍ)tIH6fڊyʺ M,4_IIª$TGo9K[RmV:gNAp aa[Q'*[ZԔI6Hou[Yjd'kt4]YU]ckF1uhKMCj]}-*e R./tEұ=a͙0!Y* kYޠɕQm԰"+2fewl.n_Qf{DGyݭ71<3nʏH R$(riSsMv]ʍƖ6ep] &*M[+D'k؂yNjg h,H 9Л]J^J<  u kb.<VZd_DܷQV9O4I~bzbDoCnK`(eDS75PD-STS ĎQ$EGD~?n.*Zf`-)QXJV``Qx*ZTgb0=ҙ_r4RГ9H5%XedU.3+/Riw.*e !g.W SkA(ljSۂTbna,n8w .ĒIpMQ Mӕ* -{E1*Խ[Ͳ5IIO+}˼FJyi2o)q)ӆ'Q~:)0GMRZsRr(),]\mhҮ (mS&RVz]!u!hZRRRJH#@AE:a.u[yZTPs6'7:EIAVDUSLT.QTe w[M?a-;.ASk@o}e~T4Z7.Ou3-K &$^J*Mp2iU ;|4 ohXa|QFt$;eݥ%.:@Eł7Hq*SJMNґz we\ hlH2JpO*ԣVst*̴ C.>K d8FzzKITݬ*>+a}Jyaw&VrK+uM)g̕cokOpױ򊔙bE\m NG2tHQ*:pJpg&mV$S6KkvUE:E{ *Tv-<,غ%7=qZg6M,=*-%A[;klEs!U,L6⛘e+BH7?Fc·TpgTK,m\xyT:AbU=\̤/=ԛH$dʒV!N> YR,540NI9J3e&shd3[8rPRj7mH&O bxcO&Y&ԣ|ε2NJ0h"bSeιkRGK]`ǜ*:+M~ r(Uԛ%F-Ƃ׷"M1½YyEMƵTl,[QVU:n׋ (4w_:"nԤTSi'BF^7i>gvZSsĔ-<틫T'qJin0T@H혞dJrzt-vOSLܓKWEPVYs  ^tik̅pA-nVN8f:{}\=8kelA0U5]=P.2[eQ⢐M+TДdrh}'O1P;;/MZRZU5 (n w(:WM%e$uVkvG*3ouى}Yu}T$!ѥ*)MD[5U;IfXWGy/4ۈ: T D>QmI:zfˇDaXq\qy8 [jRTqf#95 *ZaJ{_))ҞV{{.63Ą&I;+o%}h-8sD/l9[T&Y[ > ̡ &:cfԝ1aV}βe[NVʜZȾb]('|ew-Xv"SHlTJnaϯ%%CJj 5Iw#:iI M}!jB"] &$[)@ i䜎P-Z:4YzҢ f_OdmLfĨ#Q𽍣>ȆM%面Sd!˗l$((Ԡbli9>s2;/$ -ollXCE4FD).GP8h'KWݛis"ZU:fJCN!HQHU7o IK̸=e7 'SJһy´RjrHʕTҙ#vK<&ٕaj.JQ0ZY%g.9=H3JRec*frxٴ:^,J̲\ڈoe;n _܋Lڒ}sFkߗ,*mu++\>!6Yۜ" (=ܯNmaզB*LA6nhgo=TaJ 6 ׈Vy4fHZR3w܇w a:ae$2|q$W*z̰FQp<9uR4%ms) AkߢHZMKLQ/(tH##8ؗna$s)J)ʰoό TÉ''_cOi2sbyR@yRQԤgCĘtxQ{l3R,'0ZfY6HӀ{V*8"-0?1vױ-0?1v lvĽ|ȱ"ؗ9$1&kvnJHC %)*%T8.- p۠d.8]]~AZd<۔x *e%ߔV!h(yhZA\XNJ;i|Y+™V .<2a.ZEMNU-ث2IӌVxVFzJR}MÅI ^'LKιB\*ݡ$n Rx qA]HU6kRP`'8cT=Z{aˬSf/Dq uN` XNI\=zh,ɔf> JxY)JIm3rFPS1f&M˅ :hA_GVRME:#Cs%Õ e@'6"=Z¡.Pݍ*j }йsZ# R6&o]uƷE':Hy,T%sM %/E6vanUҫdWUVG3<$A9O2}juԠ8Q="ٽ׊J7,UFEm"&qRiX1hI:ٔ9 P2dZ.K@=]vJ']Ft2R #T1b,\ʛZQĶŬcA te6$ l"9 Tw>YWDo<"ttnHV+lDZIaVҤG7c"%!m%7m Ft˸8\SjJ9FkvšKhCSR\eJt$1z$iʣj$Hb"Wo_B U:#nj[)E \6`%P15A*J.$s ##T3Җ@mmk-M05'GB:~`&<\bW\6ʫ@:5ZYIOrm}8m q5a&d8t,l-ݙ,ξfuA>掴H_%+ XmgDXJ)/r7h4r$wӷ#`F:Dl9qk{ܨ!3O:xr֬ Y!ԓ Jn~ekIOdM@ܑq)ͩ@J7HbIڧ tt?R::?LJEpWa%CHvG1;*M3/p_kq|]qieNzJ:r7xDnEJ eFa+rV1!IqY:D^u:ʼnєo]o툍Y!)4gӧ/o1YuS2S'88'XQ):md:Z8adsF5mVe5I qg!^)̒unʗ]UңǙ#lb mmàgU*2z{#\)u%EA55SjQ%TfE:eT JʁH Ȕ ejR@I&,l ''PvO+G4bNNKC,BBMFЅ VYE+ٌ֔2eғ^+jMLG틾|ҧU24)yq@[?u#|$Ԓlf4b%Jk"w9pmx5Oj=6hJf&ue 7"-67HK֩+3- IbG!H%#2q6d8iK'PҒ-+Xm˜u2LR8j-̻(|ـ$ks&95bgJxBlڷ_i2͡OV%ʐ lXbM#>78$kTjOsf-M2]e-9;qqF8QԩmGRTOԡ&I)E6O*@9R.,-QoBPI-ݷ0Rsk\ ic~F#u7V/j+Um2H SV< 2#iIS).ˮK6E!ժLjH:?Iٚ4=\DYfRm,s8%wˡ𰧤Q f3vm Kڒ3m{_SܩȰ( R5ӎ+-$ˋ#גWнl6?:~6ySU̢PO@X$.=Nlb iT% n.-=抄ˇ3:U%)&{.qs4uN*YRdlJl`n-ϬF[xJxtHY\l \vXZJ0TEa(\T?IBֿ)9N DR֖fdlI-/An7PO#;NMA*OD;dicm3w,;SxYd6&׷Ui+y5](-(GWZT=̳ZEmv2Lct3% 2',2Fj!.RM6njo*rmJiHk-s$&cՅ<'SZhkq"jm6 )̔oˈ> DMڗq/+ݴ7]"uhuYF[l Pڇ՜l?Cu3(E2ӪN>N^ !HW l [2C,'w@uJEۗkNj>dn^[mVKӊ,#[ea~cǯc[ea~cdY{ P?HÑbEw/aj8r,Hc)mqC+Ih=DNDxF`M`Ƕ>Զ]-6f)N ]ת֧Jғs{^9rtY,NolM24OCQʹU~9Hq$+V.15 yt>cD~ة}GĆZnN)UCe%TVu7$*V~nFKNTjGRrQYP7$fڋaƄǯr>m΀as]N&18Ź]I9G*Zbɩʛkrm{cخ/7z%q(O[ N:x(M3)-· ܻ$s9BLVXJ^NjKyT` 6(BXICgYꞴ8l}rB׈HSdq-*Y4eJVE'3Ǖtn0fM8Ghx:)r9_jY(SFQTIM\vp]FS%Q|74ڙR) JUb$ 4z394g^%!m,HPl}ߊ8-edӕfIMDkm!+St '?8SV<-&fcx LrJUku[Wqop̨A*'y>N9Ne_RZaJRK*, N7\USm%%`8Tdcd:UUv?}xhg#Ir)EI&mO|UB̑)FRVkҎJ@贪 J3Vjj^cxJA3̗ x:jsBiYSJt ʄR4dF3pkakC,IJmʅ>eeE.\ !B {B%tagjOeҳaBat̨¦8tOl9^6kOî1mk6U@7OUʌ&p'6ns|}`JI9b]t]&YUK쬚J\C#69(nW Qi}d؝ZjSmbS]Gkıݚ7ʞL%j ͑.ֵu%Yo+V8)GbH3,Ґp>3 A':N[X\SEL٦_e!uhh<#z4$׬kuGT&] sB.Н{LMUDxL[~+>ЖR-.ٲJs>N'9+ :C\l-qe$T]50fna"ZZ3f:|)\haN nu cnI):70:Z׿>;tױ\S&;g) pqצ%LZmt ~1/´,H.jEY+t1p`G VԝJY iڳ) 8lEй¨lraZh;гa+J&}IS )y{Q(U.yn =-}3LX=YnpPPUq<`~ V%C6+:@>{G6 OasSPMo.%N%^<jJE3".6AmH6ZKr+:Z6:[-V&Rݍ)Nc"Z.$-Yt8ەŠ4TI~M$TDm9i!YsX6}O"1j ,M))iA )MonQǮ⪬ڕB&ׇf[b]'Ziu@)7Cլ6e$ 71.l [GW8TRأTf؞h(k7NdÜpXQ{q틹,~L2h<ߠr xlxƃTgϸ[C<b5 /E㟈㇂[b샯*PVrl_dcTq"kEFM !mن!mنeLvĽ|ȱ"ؗ9$1//=x9_ҘkAJN1 ln6WSte[vUƻ6LRR.pG4otT?lb+V)!,RFo5q֮z6uV"WZ)?cс$ ^TM4H?2,w&5uJg_cҖ-{3nш}{IS]NzS[(Z<][E3$|i#7T?h|$S*K$["H?PRlt[64ro8xLKBi!"k uL<yHdd-mlm"vIJHSV<4p,~-2M _s҅?sBࡪ3"RNV<ThfN%i{hiPxbmI쟘|FVJ 1O"HxpK$$ p'n9!J @~ \a >O ƪ2!w _x|PҕfmIk|Qd'tZ@Y}^:6w^7j' K-5U.@%ԋ x&uŔ>m'ŞC@~}w ˸c% Nnlmm(RTO qyڍg<5|ڒxNoH8*3+Ϥ @D((h{{(srx[-Gvvmf0:c(|H`eWAd@M$E~}(6~`OGXhkZ0-xyf>$JFvZ Kـ_;LokyL}Z˟޿բ9f>$Jp'NB2eҋD}[MI5~ڌաGa1h\9%_A-C ۳Z?i$c~ͦc_AAĉW"rZP8O,?m w XrBb6S`Ĭ,lBnz-*BokO¬3qm}QBiX͈" pdaĉYL$ېzFf"+^Y'~y70aPB~ͦ0'Z_вH|X ϼS- J<:FSt=%sZ};bcme9& _D}M@ =Z15-#%huj[.Z:H=#{8ila 'ոi׹Lk6X*a%@Mˡ9ou)DyPAO>e'~bPVZ25-6RJ7h =ʾ%C+ffxj R*)"ry6Fb6 #iaIV >M z<4䎸D꥛ۂHm&.p6Bb6i f)6>L^_šp`G];r@h=@Jl'XuEvJ^!'5&N¶lxTn!q܀\ҼI' r[GAHv6{zXG`P͜=3u엁[}Cd_Se*2>4n@4ZB$zJ mG>) dXi_vaxqNR#}GUM*޽EB`_pe\x H $- bH6 Z9I@$tH6oYXSE@n4H崠Y (4/9/Bg0<Ϫ }betV݌32mI @n6MΠj{/թ24hL =2}dzIU{r}rÚ{?BHڸP0'Z$62XmW"rm0\*fVKJE)ōi릻>3h _(BS|9w?iyƫ2M{܆aOZ@a}Z#«3ǹM7<^B/(%.)B2!a$9G"L4rw,rΨNTMX_?kj{aQ%*&3n|>ӌW܌զ8ݚH[RN썶j41,tRm$+ \h5fR7P *(rN$vm=I!Oa SuBTC¦0ߨԩ n-ӋuR@N"QQHLaiHaPCKdRokg]9ֲm9H-a Ԧoa R TVq_#hB%("KR.FhLS&w<.:PJx j].60?36:pnw-|.#["03s܃S*[3ZWz~Rio:t)vI'K c %UFJ#6,H E QqLQ+!mن!mن2z;b^>pOf[k:'O\W{n[bTR{*zr$<7'0yt?dc                                                 #e :r=Qt[ea~cǬ-#L/ s7n"ҘJ7'#jr\!fBrIAԓ&3<{ߥ~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥ~xʺǿPA~xʺǿPw<{ߥw<{ߥʌ*oM̹l>Z`Amapivi097/pics/add.gif0000744000175000017500000000266507754145641015215 0ustar herrmannherrmannGIF89a  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!Created by Martin,] jW&dJժ#Jh"JBut(ТKRA(QEb2XXȓH Zvk.PܑDjB^AKի3D^Ŝ=[˖b\aŐ(aB ߿KDM#@p"ÉSgɑ?sČT`HYRGASSyb˖UyޝǖG$ N!e-#T1FĨ:F"EI=z"9jd<#@7\R&T|ݢE,ydJ)SP# *͐:=:D"t2 =>ӎ:h㡇)(,4҈K3`3:c:`OX# 2䒼K0N2L5`$/Ĉ0ń)fD#O> 3aʢa"´4sO9ȩg$:8SN eX5D*8㨃=Li`b:J*Pcꪤ61obM=j뭸A :X+,VѤЃF) U" Ԋ(<++,P]] 9M3tX8B$ >WcN,K`x0T=GU4MTQM6n*\"T# 4Q@;mapivi097/pics/EmptyThumb.jpg0000744000175000017500000001012107754145642016561 0ustar herrmannherrmannJFIFHH+Created with The GIMP (c) 2003 M.HerrmannC   %# , #&')*)-0-(0%()(C   (((((((((((((((((((((((((((((((((((((((((((((((((((nn"N!1"AQadq25D#Br$T%&3467Rbct,!1A2"qQ ?t"8h((JA m]N>h%{nR7.k~RR;x%BT/`&fVGQ1R6 X R3<:iV% J$n<3A%xkIl*gڥ%JZew%v ߳1W5 *;oBIp󯆟݌aFVb2HRC2 N UM[[Nò== ) RO?=|}v WoRIk/qHq-)ZJR$H2eFZ9"]&*eZUYq`>;.ˌq\Jow1T)W&ݍ7sGvCn:6i)':~X[ehY@BTAWHq- IF[d4Qҗ4,Z麓{we%i=B~:iWeNGĞ:Caݾ?uI}֜CO[҇BR  ;f!Z3qA^Yl Z-_WW׷<6eJ`Z)H!%'6}Y݁R9l!#[ Ii -@l…t ,-ɐ@C+Ru.|ҧWuaOH%poUC[cg=*iTqĶR#Ē`I.RHe&^5\o|5 X'%vcZ!qŔ=iWP}[9u% 7P(q#@X [4+#Ĥ'=CgDH?׍!fJ+BdcOKRig8Բ<1$ mG[h)e%)}LjZK%BTwaTtȒ R{w lyuk|Xg i !$+byvct7}u?~$n)1nlyJJI "{p9iC`io{o}tx_GqԎW6Ē:ԐtV'&㘽ҖMik Iһ||zԙS-А!ZPt lUGq{97V‡Kn,,ե[wZsr1O{,?r2GO?21-+SQ8 !60E) PP9DwTtW'$0[Ď_+\XVD S\5_{{柟{d`V 柟{d`V,iPeԞu⢵"[mffb5JN-eWY}QxǗ22<ۋꐑ)h{s=`[SIt^lCLT@\rJR.HJݸ89Fy:Z 5XlH$8]*E9&΍ujWP 6V>7AOHyJYG\m^v`(+Kt]?! I;(-)вct?f${ls [QLyfZ)^߷>f)SMB\fBT\".xSEtAP!WQ Udz_áIuOo-fXz?mR^DrҒ?F_eӝiR-lx.r]jJӝU!6n{4ڑZ*~[qQ*fcom.4[5E%V}ؓxf2[ ;}[v3)r:+a6`c@h*Zdu攘41 FBʛ#q7M'%\9)GCMLIj`-;jJ x^ŀ&e 7ZMT-EwK *R+BBz}< ʐ-H8lwʻ6<kZ{9"g Dܲ8#ݲx-JE%yZH\"QEʺISE3n^Ewsc*柟{d`V 柟{d`Vs}sMXJy%.L *;_r:Қ)c $Y`TW(u+O\(e#6iu-E# NNU8g<Ȗ9@P!F6s; 7"TKS# lIo'U_apzְ6#;:jbg&=She4D݋k-}Il/q>Εٮ:&2{_ Tu@$vC.23S*D1[/ߎjjFJ[+r;`\m{ 'Ts轻ݎYK TTf)asyL-qB iN¥!| RVP Ob!H2ai#5J1dCûqQoչb|ʸ`~3f}E֋Dw%uAF.MOI*dے\q) j'vOtU}yfa";T^Ew'4+#U˞_=>Un1揧|/ŀ0^+OOR[ֿ(u7BFP[N_揧|/Ŏ4PF6I@4@yR\aNqEJmIJVu{ rN_揧|/ňN~SkwlH]Sdd,);(nŧN_揧|/ʼnfP)>@r| >C&ÒԈrb[I~xy c$L5_{{揧|/ł*G?]?ֿmapivi097/pics/MapiviIcon.gif0000644000175000017500000000706307754145642016520 0ustar herrmannherrmannGIF89a@@  db \$2t |,6LN,2dnԤ "l< &LN &|  l42ln쌖 L$&&Ԥ|~<>t\bdfLJ""DF|,6&""l"$*$*l4:TR켺  \Zdb T"  \ |LR,646$&4>DF,.$ln4tv,2tln <$&dblDBdf\^DFdT$&ttt×MP`MP^wd_ww&w`_Nw095qFw :ww!,@@Hp*LȰ‡ #HaD&:$Ƃ&'2cǏر˚.9vdi&ϙUDˁ+N tf̘"e,A4!F1T-@ --pe 2&݉Ö+}Q 1bn򢁂c 1)0Ev)jΫWcĸxd8* 1=zqr6 ^ U⠰1d1DlHwQb[Ppj_YժQDpP%)c;+Qm@}#Ni/@*']db[&(ȠcQ-L /Ľcb*AƂ :WAp ] rŁwB.6☋L8C!nQhcd9 wxpcxՑa*C1ʆ]!(w50c€1kڽrcā~=(ipC)tw9BG8܂*Ĕ!hɭr'9cg!A@+ovd2+O&_qqD*{%5԰RMtBL(jnͱƺq#&J JR,#X%(iBp {+yvDI?\ ANB0U 3g& y檊1r*h81 k}>D"f*A0 !/j\xOkb2a_~+(f,,'00'HbrO Fq3FTwu`>  )`'y ;p$z(O@,1 qzB N1&nj"p/ġk<ȋWǛ'w42(8 k RT\V F4? P(XC21D <YH"L5/Eb'0$& YE3YlM/dz>Oo|kXDvf001EI16HF2 j l P Ҍ9zOT"f6ʋV"J`3CŠ*ʦ9ġ= aէdžR*&Opa ()6OQq D,4BJ{Z/ H>eB*NЌVۄ,a4V\Jh ъkXb? E,ɰ Z,c8(1ĩaE \rЌ6)k>$ûVCT(aykM ?~A*)P5o<;N+LtuvЇPq(׷Ya02B1W{}.] 5/Ө"`SڥX:7<ُUEX· 5fy0cu7X;P*l5 (0A0fod #[+V:,C=2]z q@sh.6KKo.L|ʓ pAC _*8.iNwjd~N5Қ< 4F>KǃzE_qW`cjR l;m ┬H1:qف*r2怊9hfӍ%NgR ^I@;A"f΅,G?rClVT}.R0eMX^Wݒt^u~.EG?@|wwBԐ,({]+%$&(7<߱aҐ+x)}@&z8a." tZ{}x{(y;Xw2;mapivi097/pics/MiniPic.jpg0000744000175000017500000000277107754145642016027 0ustar herrmannherrmannJFIFHH(c) 2003 HerrmannC    C   /;" > !1AQ2aq"3#'5br' 1A!2b ?3U^E)mhT }ӇbCR̩X$ΔS%P%%*=9ufhl:Kb{mG1V< NVDHϏ|I, Ėxy) \% }IIѳfi 4)okvP2Z}v ~!V\HQO )BG'x> Wǜ&&b;s&K@ma+- lZH#}N*[ZDUbjAPyMZ c *O3$~8%\6PTd%kEуFm>p:h;BU)!m?*;A%X|0 ≠ވGKθKh:w;'G Ui)n[I賸 :uJÏI;v͔Ĝqt l^xtSaF[X|qh)爹|]ǛZ\qzwZ| r/~]ڿ*Vzf]ImOfR_zzNM aOrqUŦƍ"<mԳ̛Z-cct_Ywuj_2lz!m% aeJ<;o᳕snA0Sۅ89׈1{3l:>VsE>&qc&}J0M$-xv5B?⢂ϓAf>]iFZ/5gP.8@8mapivi097/pics/StopPic.gif0000744000175000017500000000221207754145643016034 0ustar herrmannherrmannGIF89a&&&nnn򾾞b^^66nnڪ~~fffjjj>>>FF悂JJRR掎VVVꖖZZ666^^ꚚꞞ&&bbꢢFFFvvvzzzzz22ZZZNNN>>222ff憆***憆ꦦꎎjj:::JJJ2..^^^rr**...::꒒~~~jjFBBBB~~JFFNJJBBBbbbRNN把:66^ZZ.**zz622BB!Created by Martin,;% %;6&9XX9&6?f 0;X@#'o2`#jX,  T  "M;%VdfM#K_W8::SWSDCK#dž+Es9U <8SS:D U9\΅/.'~ AĹPq v|D͈ M0c;"G#F\ʔ)O >0A") v\A`![tHPDyH DNp!ǀQx:Abm6$>1THfX!E )R&,eG)Hc 6  65/oXC`Cnu ɞYa$Nj' n(rլeүPsCDV= )08C@ l@ aRYQaH" C/g"*'o1dG8 GoqB'0*ׂ* dA!X(CA!KQyfBE @"Yܑ*pf C*p86I5QF!NQTTÜ 4DyC,@_|1;Z(ĂjA mfCVD jV:Ĥ(PPY>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!Created by Martin,] J =sY8gN HQ ':q)TIęC)ĊٳT^Ɣ Ԣ=rx2R`;@|څ !;w$:9QGA{ϝDXQ,^Ŝ=Kb\aǐE È M~^| ;f$r*ӨV5<\|jei۸=7A0!L]Sֵ|܂͉(O+9 8hcܘ7rc eX /i:^묡{J*cXf5% h|Rd<$pl"=f9 )`F$DJ"I7t" Ԋ(X•Q =tUv?^O8\ GHZ=B$xla 9.¬*p[!'QFM(alU#;񊒯\"T#SE;mapivi097/pics/edit.gif0000744000175000017500000000267507754145641015413 0ustar herrmannherrmannGIF89a  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~!Created 2003 by M.Herrmann,] J =sY8gN HQ ':q)TIęC)ĊٳT^Ɣ Ԣ=rx2R`;@|څ !;w$:9QGA{ϝDXQ,^Ŝ=Kb\aǐE +ZSŘ1p$*pG'f=f@pg`~.TH* 6Ƞ,h=] D"t衇 :]ݳ̇(ʒ02<# ,S̏@Y1ϰ?0+"L]P5t;Qa"``~7tO9aN##Λp9s8qrc eX /*蠄= F+SϤVj֔0CtI=_*WI$jWBfDA$rΫ~#] B@b%\zO%C~QE(a8?Å *pS+HF )ī 7RIKQ+|eTф7QE{<(+%(ĉ8r(EK}zN~E[-_#p܈L!8|( il PN@-$I2W45@`!½?נrk((\w"4oj(`Z51%ϏuXC"f/@Z~{Fd1Blf=im;kD"h- Nc`% ٥ qIzdv IENDB`mapivi097/icons/transform-rotate.png0000644000175000017500000000153710562755227020162 0ustar herrmannherrmannPNG  IHDRĴl;bKGD pHYs  tIME2#IDAT8ϋG?;;e6a%dIKF&v/ s6ܼr9 9 s+YD_`!jWuU5{}oƄQn-ɉ}IB7"7he;I"| 4pwzxnljg j ½IDqnD;հvg`4wnǏw2m۝k41}Z)&dɥVWd4CXX*Si`,aw,je z{kf{"|e~oDzCm`'0So55nlO0 Z4(J}Ѭqk-Emb5ԕ^AސcH$ RTHTh4koXPDV;KAlƃ|7䛯?CIT %3*s(cnsƘf+FYh/O$.~n<7W$֣DORt ?_K uOXOA?z[DNǀO2P^\ryT>l$c4NUjHM1h@vaFjO;ޓSu`gNJZFIENDB`mapivi097/icons/list-remove.png0000700000175000017500000000036710562753723017111 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs B(xtIME ;"\IDAT8푱 Pi:+#mF stԶ"DO!ʳ3w&H6暺`?S-FIENDB`mapivi097/icons/image-x-generic-bw.png0000700000175000017500000000076110737457470020214 0ustar herrmannherrmannPNG  IHDRabKGD pHYs B(xtIME1~IDAT8˝@IbFB,, {!w0 7!{ b6mbO$ffX |+x<)Έ(~!QGEq1f38~l4MXmH),QJ@)Ec m>Nt$Iv W9Ų,`hDe\W4M( \t:yRq<Y״Z-,0LDz/nZϵZMB4>7ԤʥOSL4-kuhpf.^x06 Îx""@0Sx}LQ*̝d t 6x=>褃bxuhEFo͎0,kf,BoZ;5e>Y& x' F.W f43=gOk40ĭCձž _M^l8l?3]X1/23ǕgƧg^hڷuS( wD-HU/<A2e^ۏ^,}?,az  ,Hc$UgnSui&vn{'v>Eq4Akw_?߼''k'W%߼[0j>AX-/?ԩT=eYcJ奎Go@W!'$_ԓSln\{&?3 DV%r=?JeFmXv@x\qqah=Ѿ2;}З|9r-k5tT2>hMA҄ǡ̖MD, z=*];[x 8wyIuI1MN<-I7, #?[FՕD(̗ˣRmcer-0{ W1oR ]!PՑl.UvjeIENDB`mapivi097/icons/list-add.png0000700000175000017500000000050310562753717016337 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs B(xtIME DxIDAT8͑``rҺ`6[;tqDdZ &g7Z,Vi1v`9=0+n/\ϵUR>.009xrbD["[-$mx\9XwV2@@PiAkeRjt&Rȿ&ROXNOӅ43kgO=TrK wIENDB`mapivi097/icons/folder-new.png0000644000175000017500000000117310562753637016714 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs B(xtIME UO-IDAT8˥=hSaޖ{SI۴$ V\JEAM]AP['qpE.@%-A-Bh!?!!AŇ܍L&s5hkU_z>MP\g/[}C(˧=}$?  il ci1 l22v\ޛБl*gH֡(UmSk繼Pa3. rf_>cvMl/~p0Urs0~d4Ydi1S(e`6H<%A4jF')εbm;M  T -v[7H0t]|TtZ|}OT#[mm:%b@VXF"R AbH 0"duE\6%,V4_=EP ԅ0Z`={QmAP pkk/Ggs]H"/\7ᚩIENDB`mapivi097/icons/system-log-out.png0000644000175000017500000000143710562753754017565 0ustar herrmannherrmannPNG  IHDRasBIT|d pHYs B(xtEXtSoftwarewww.inkscape.org<IDAT8uOhIz{ a/EAѫhPê( ,.WEP/DP$jwB&l@gd:=?z~_=2I~P"b,ϳgΟ0IC\&"f8IӔ ΣBkR f3iA$ ijpΡ@)1c/hmYW|0 raع[kADы<ؾvNk-ιNnA),!j"_3:mZkOe^t  .߻eO:mTG6x;Xn4>Mі֚nޤs'?Ct>($}}Rt گ[X](`sZqLѠ5?"XDP| o^bXD! .MuJe6JV`r77ܰ,.,Rj!l~\D$//񺺞~a`hbb ˗XֿץZ6>c0QzS†> ϣ&jYٻw@`xGV%Y\`Mxs-곀|mk,+#Za7u9 ?=]eIENDB`mapivi097/icons/x-office-calendar.png0000644000175000017500000000113410562760162020105 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs B(xtIME 2MIDAT8˕OkQ3o1 af! o .RH#*"L FPh&H_jUiV pj'ӒE1BgX=7^p\Uv\[fnTWf@h6u%wmǵRJ9޼}B8*R*)ez?<<`i9[[ߨjF?7^izd2Oo4I2dc+ R)opi|2eaYi" x]ױg](!87gx8_@)RjgAsdx8WgrAӿj;d.σ{w dWhprů55-[ܝ [ ɬ}a89jA¡&6u^Y4MM98y 5:/Ma p(^5 Z `?wnAu=?.dU/m &LO]8WyIENDB`mapivi097/icons/media-floppy.png0000700000175000017500000000142310757353421017220 0ustar herrmannherrmannPNG  IHDRĴl;sBIT|dtEXtSoftwarewww.inkscape.org<IDAT8kTWg F.,DRpcە躡֕.FPpQ RUJh7̦B @&{3V|k9xs_1p̮~%+.g@A 5~uסν[`3~cOn|ɩ|x [I9W(RK{i`w15kqqq4;>]Dži}0mHN2P%!;? jܽ8TɕT-nEJ S63WjN] efgg)˒((r4.#~5zsiR{*7)ՑB Cbf)qE+pM(˲`@#!bM1 WnM47ۦg$@&WcM(zز {1n/GOj !OBGHᣱA ^0A5 sγ ^8 Sq%Ml)`(Huݺ(F?s|H*ɶ^ʽ NeGX3c4g[s{;rd2c{f|;]6œ#S&1)6,Fo&' dfzs AsIENDB`mapivi097/icons/go-first.png0000700000175000017500000000123210562753666016373 0ustar herrmannherrmannPNG  IHDRasBIT|dtEXtSoftwarewww.inkscape.org<,IDAT8}SMHTQ=߽3F 1AMEAPTA e&$H\A mfA`4(E ӦLќ7ɑ7snwsOX&1n }c|8I{5Ԗ#oN`rGX`X,[x{΃8\'i:6a k1=5+=k[be4b{JKH%qZۧ.w] n߶f !  \4 d pzP}nοg+W5$zZ+Y..B*-` J kL2vPU+"m`Z+mM[yس׏G;b3+_ n.Hqhρ^ sNҎ~,,廻;~|.17]5 %N}8y/}7" R6ɷʹ;}~]MX`=шd<45"0a?_Zp4IENDB`mapivi097/icons/edit-copy.png0000644000175000017500000000076210562753600016540 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs  tIME /4IDAT8˕KKQ#3cڀ ZuBEvDDD616e007itFGoy;$3,F(Ͻmwa(z&vj5BЄ'sj^wcfnyu$IBTGE@QNV9TlGr(( ,˞H$?dYv pPRšz-,EA08vaSiJ%K дc,61Ӷ(XY^ePT䮳6֣yyrl;KUUn(zi.y}*($bBYIENDB`mapivi097/icons/dialog-information.png0000644000175000017500000000153710562762473020436 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs  tIME 2:P5tEXtComment(c) 2004 Jakub Steiner Created with The GIMPًoIDAT8˕KHTqƿ;:G&YjfR>E"ġ%ԤlbpaE1EM%It&JJ͊4Lqtwo5~s~s8T\L)%) 1ek^v}STޔ0bmeZqU7S{z?\!&,zIW׈%ooߓc,RFg}ZUYEӣm%Y{[n=v_0kEI珖D N Jhs;u&%srm'$=Wn/@ ,C-f PPn(.*rraB+YWUH43 sW߽%::6ilZN̾24PU}z YXXx(7VL6^|IENDB`mapivi097/icons/applications-internet.png0000644000175000017500000000154010562754102021150 0ustar herrmannherrmannPNG  IHDRabKGD pHYs B(xtIME ;=ClIDAT8˥;l[uׯ85v$"U " NB "10x@( * i}@gt~:t>%^4G(ʺi; 1\;bZu!eqa)癙ܩߥ\NKo}?bOӹ̟L dA#kgn?u- ɗ?xY|'w^)rdz S&D 2h7ZY~ߟ?l_Avoyh;kmcAv&I*ca)'Pz\^ u MB#+GңLYj1`lx,\dHr6y=hnpi1^hTŘءc5|6G3y4DU&ĵllAh{h8#L2L9lQ>^]ff&~>!տwfC;Zd#4:Ɩ66I'U2ST\(Vw [GدZOP$gxHR3NfW薷Z{108a[vgbۜN1 u +l|R뇲'뇃X<*S$VrnW=&z[,rg`ҡՓPÖ1ΰw6+&rssNs! { `t>_%?TK_IENDB`mapivi097/icons/edit-paste.png0000644000175000017500000000106110562753605016700 0ustar herrmannherrmannPNG  IHDRa pHYs  tIME IDAT8˕kSQ4$1Ԕ "\\jbpv!8EmA84K.8)RHB^olF91/m ~=?T*{ϝ~I\.konΚ+*+v< |`_)h/Y2g .9.Ҵ0f LD9̤γ׫VTS yf,y_ϲxAPTB"Jqm.f!1 ނD"03sl08[y=j(߼ )>\qKa{UEEȝ<9DAU21 (mnh>A_4!5纀VҨ)onP^CDz\Z14I3XpcZ7l/D#팦$1fSU;`\13TKOxiIENDB`mapivi097/icons/dialog-error.png0000700000175000017500000000121510562753560017221 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs  tIME 2SIDAT8˝OQm 壾Mh ĔD2iҁ";2tf#@XD0hc$-M[(=}KOrs9nTR<ƽ,e`z!~; -L&a|*3ef39x7Lr{UE XCwOMRSWt2^,F{sm4@UAEAi|?öj2CX[C*zbŅ1S)>olPkf-`~2rguPqTqy<`>?>|DE+OoA5?JDQ`zpT?P&×AĽQ7<7UD (Y "":'V][x%u7:NCPcG" lZlg w(CO4Fz`VW*H$p }0vrjܺLv_“QEEpM::_΋nOGfXvwIENDB`mapivi097/icons/go-next.png0000700000175000017500000000124410562753700016212 0ustar herrmannherrmannPNG  IHDRasBIT|dtEXtSoftwarewww.inkscape.org<6IDAT8KHTaFR^D hFh"[FBr6B+7(rEb>p-f)7",3x_3ԁ1|tSSRƣqwp5Xb55|P4B5M5TZ4DThk&/}/Hh@[d޷=9%Z 3Ïo>W~7ߊ*qBfyxE |ͲQE&NgRg2{v[c ;֦[aHR,(ĥ\6J>iTw=6DrQcJK6 hDčآŃCro::毫<MqIʥ"3d"rIP\fU[,X6n0y}V34ݑApw־D$I v(x/7br]Hė4ʀ+m$yZ$QO&ژ LhbN80@D<ޙw2>s79(" q0ȭXt}rL&zee` DQJx+V5`rGArPpylxo#Eԉ} 6.@o{`rO^Z&`lZ[[[TCz ;fhOIENDB`mapivi097/icons/edit-find.png0000700000175000017500000000115110562753614016475 0ustar herrmannherrmannPNG  IHDRabKGD4g pHYs  tIME %/IDAT8˝MkQ;$MfJR ]hE Uw&o$ADtYwUM;AT(VP5G'M23EHIBRgw=GvM;N!#Lv B]wf2f_Kдkw߾J9zjmŋi+dk&nߌĢ5(4]#Ns ^R>q>sƕ]$ ORpsӶQ %#6Kot Kz Xd4,U~_e% EJvK0n \$[5ܪ-]pi-Nlc5ߣ-F}=kr+Bt4M¹|'+7*|\YT[z,?",+| 0p8TNVdT앬/dߧ>xtXtk뗧d3 ;e+D, XLxx3}Z=B)pS @0y.?iv2̥gn:RHaf'us1RC}X?<5_8 &3 \ _KM`e "(DZah}H,C+ \t]D#1Y~uڜ>{_w"a/_8hyʛ,‡ʧIENDB`mapivi097/icons/accessories-text-editor.png0000700000175000017500000000107610562753530021406 0ustar herrmannherrmannPNG  IHDRabKGD pHYs  tIME 7);RHIDAT8˥MhA3ݣH"-)X+xEж'< "~1[M\bӍLlZx0Cmj+ ofރ a]VzxG/fw؎XM9WOJݬ;-T@YXݓ zV_LKNJ7qĉ?}MeM}'O2t3@zz}KAI{|-Mu=۶m;R>n&X^Q@dct| UsEΟ0 M ҽ \y7}7FdY~C;>Yz=iv4nK!?y%;nL&q]7\OPV<G;+H%H`YeExA,CkMVCk5Bl:ud})0oZy IENDB`mapivi097/icons/emblem-favorite.png0000644000175000017500000000123410562757015017720 0ustar herrmannherrmannPNG  IHDRabKGDC pHYs B(xtIME *&'))IDAT8ˍKTacƚѤr4J7EDq'"?v e &"ZDE`i"C0Hb3:9sՙ{^%ˑyyb@b1l-"b@;?wF_i aP7j\MۣhCxe a ܪȍ}qŀ͝v]Pt]+ tUC٭-G}c;1ЯhNb20l~O#(;s :FۗL8Fj9wWp7kg \A,k:2Í͸V1K#V*U (THOgH!]Y-=sU|ϗ~,(عE=šlP),$ouېV̉IDec$ % %}{ZGGjxft'b.qpˌOi5[ŀ2}3N5 dV5TӰ~oR(ܻ#SG!-ǯ;n vPTMz{x0Nl?o{ tNIENDB`mapivi097/icons/go-previous.png0000700000175000017500000000121710562753705017115 0ustar herrmannherrmannPNG  IHDRasBIT|dtEXtSoftwarewww.inkscape.org<!IDAT8OHqǿof~;RblB n["VLD"%t-z;$% n$W"KPl0wz{RJ7+[Z+a X&殅 e>V8!Bj++`&CSs3NgLquQ<m JJg~~S'\bqqw`M&h|:6:7o^gIfJSO&N3==E8?\ -G\\/fWo#KkDfN) $rWJy^7=TbB}OR@]A0 ]={R !B|G)ET*W3H)?TRJffqF::QASzܗHW/[!ąoqūP*-;QR6P.c!Ą2?byK k8%8F1ayK,\FqߋE>qf;ɥIENDB`mapivi097/icons/image-x-generic.png0000644000175000017500000000105610562762017017603 0ustar herrmannherrmannPNG  IHDRabKGD pHYs B(xtIME 6IDAT8˝MkA4ݘॅ\ĢSɃ@g(1 z @ ՞TD*C"&nٙab !{fgDQ[3ZyBQ3ZjQ31nKVWpf,µM4(HakM0؂33sZ$(l~{?CR@4yò,.1SrzoD'S@)_@JNh'-\̟.@:} b}x{_ʧ|=({hmh9%_}z=oj%1@usIo?GN7.nքaQN&x3iv$ĉqǨLdk&|[Z? Ƚk^CrB0EJXᖋBIENDB`mapivi097/icons/user-desktop.png0000700000175000017500000000132210562753772017264 0ustar herrmannherrmannPNG  IHDRabKGD pHYs  tIME* >L_IDAT8˥]LQ?O0f.ͬ4.p Hfdi sm#̺p) /),o1/KHդqQqasn=9s̢eTW3}v^?oky@N?,[WbEƇwc;@TaCƘd3 Φjio:~,Q@ʣl+)f+_{FBr_1_Rnعu151={~CbBca9'l,^1u;+9Qs 'Fq]q{vctuǙ3wXb~8 (CK pDiɉtuǙIݵL)e&)((fknr ;rEwQ@4.7o]?b0[IENDB`mapivi097/icons/printer.png0000644000175000017500000000074110562754434016331 0ustar herrmannherrmannPNG  IHDRabKGD pHYs  d_tIME5 znIDAT8˥N"Q[!z̊"10bިi$;#c7joo[[W*LX,~hLV9:"T.3<{*VkQDVe<ϮP('ι 1tz/֒^L&Lj}Y]R%I @U Ðh`0`8z4M^_;xLT" C4]R2, "L h2N18g[H|.qu Z+1bED.fxq DU9x9o~hAIENDB`mapivi097/icons/help-browser.png0000644000175000017500000000164410562754045017260 0ustar herrmannherrmannPNG  IHDRasBIT|dtEXtSoftwarewww.inkscape.org<6IDAT8m[lTeZQN6NSMS.F-Ą+IL'Ai$A  G#ՠiZۂcb-P{ivCK엝W^YKSJqcok u@p~Dָq_PErWw>ξ'B;tdz x;B-/=윊p=FO0kJxƵO@m {0tr߇.R:˖0$i`Yi {FR<ځc[2<G$d F`Jiym7TDb$[ccu< u7AR4d,+hDXDJ tdDi١:J& i.E%)"$ ֘k*F$1={s #B vA(Fk˥]SH$1Qq՟ N,A0ǟPߍ,Som7?5;Xcz x(UX !?pY# . `uG9.=hmVcqZg po&'TpuXMUa?)}[PNeڧt5ɹ={V7c3Xu,O# : 6ĥ,-(靳㓱tw$Z 4nUxEG:=x{ `@fM{Uv"3C0c\@nFȂTbTZL\>{tWwvYk-0U4lQ4l69n7J]HaN3E.En ͽZ65$ݖ/܏nխϯ;v?$#P6$E/K^5IENDB`mapivi097/icons/transform-scale.png0000644000175000017500000000160610562755362017750 0ustar herrmannherrmannPNG  IHDRĴl;bKGD pHYs  tIMEIDAT8˵Oh\U߹֢d&1--]\$܄]*T *n 0 (X `( P2XɟNRZ'iw$D{}>.ev ֛07~@W\3a&X_[?æ$ A qd 4Ol/?AqU%4 ~;`3/ 'fN7:/?1Wy~g‰ѽر}CcHJ%~#nlB30?й'0&=uHSr]arqyt:IH!@$d=`!\,W] R]JTrX?0'z$lW 珟t{|Sof~@P86seekqi}˕Lνc|yxyLƁ:0<5Zt3).e&+- Ibu)`gsf.U<|vp^$!/㳟GTl6SSft[[og@x`p.Σ6-,Uyqf!P gKxww$JX}h9i $B~}S`$pa9!92|6­:pMc-gA|/V_ߖiU~k}$}*q> ,]1(_26U(5 EIENDB`mapivi097/icons/camera-photo.png0000700000175000017500000000154010562753546017217 0ustar herrmannherrmannPNG  IHDRabKGD pHYs  tIME ' BPnE5tEXtComment(c) 2004 Jakub Steiner Created with The GIMPًoIDAT8ˍKogo<_8QQXd%BU7]U]Y/@4R+H]ݠX-Q)$U&!8c$cFV;G#x\bvvY^lK~^ϑ뺃׽0Ľ{+loo +ZH) KK?0==e8ÇB1kݒR2 @/'ǻͷ_MzDPW^&MS^ wn8 ck{T5,捛aDQWh?866]ı-$!ocuuK>f)~k>;7K?l`"%Zm퐣$r#@4)~1Ÿh{+h|“'O#nzQqiuC&ΰc;E~8ei nSSSR23Z/z`[Yq$"sss3>>NXDA@Wh ,}&J%&'') Th$G RB\>::֕iT+ыcf0 9XBr"2>06א:%Z,1`o %nFa~N(/;+tHRa %Nʿ4J'{( LA0: ԬN Gl6y75 irtI4Mk @ҾB0L8;77TIENDB`mapivi097/icons/view-fullscreen.png0000644000175000017500000000121210562761535017752 0ustar herrmannherrmannPNG  IHDRabKGD pHYs  tIME 5wߚ5tEXtComment(c) 2004 Jakub Steiner Created with The GIMPًoIDAT8˝;hQ5i%Hq *v*_P*AppH`APVQtPq -%-EjMSMLuؼrsϹȉEo4g Xm֜XԵ%'ýHp".qSK$~QM :yCυoePO9/hYk>H0=@{g<wdvBV))`= 0.7.5\n"; usage(); exit(); } my $top = MainWindow->new; $top->title("MaPiVi Plugin file list"); my $file = glob("~/tmp/filelist"); labeledEntryButton($top,"top",24,"path/name of file list","Set",\$file); my $f1 = $top->Frame()->pack(-anchor => 'w'); my $separator = "\n"; $f1->Label(-text => "separator")->pack(-side => 'left'); $f1->Optionmenu(-options => [ ['newline' => "\n"],['newline and quotas' => "\"\n\""],['comma', ','],['comma and space', ', '],['comma and newline', ",\n"]], -variable => \$separator, -textvariable => \$separator)->pack(-side => 'left'); my $write_xnview_slideshow = 0; $top->Checkbutton(-variable => \$write_xnview_slideshow, -text => "Write XnView slide show file (*.sld)", -command => sub { # change to separator needed from XnView $separator = "\"\n\""; # add right file extension *.sld $file .= '.sld' if ( $file !~ m/.*\.sld/); } )->pack(-anchor => 'w'); my $f2 = $top->Frame()->pack(-anchor => 'w'); $f2->Button(-text => "export file list", -command => \&export)->pack(-side => 'left'); $f2->Button(-text => "exit plugin", -command => \&exit)->pack(-side => 'left'); $top->MainLoop; sub export { if (-f $file) { my $rc = $top->messageBox(-icon => 'warning', -message => "file $file exist. Ok to overwrite?", -title => "Plugin", -type => "OKCancel"); return if ($rc !~ m/Ok/i); } if (!open(FILE, ">$file")) { print "could not open $file for write access!: $!\n"; return; } if ($write_xnview_slideshow) { print FILE "$xnview_slideshow_header\n"; } print FILE '"' if ($separator eq "\"\n\""); for (0 .. $nr-1) { $separator = "\"\n" if (($_ == $nr-1) and ($separator eq "\"\n\"")); print FILE $ARGV[$_].$separator; } close FILE; print "Plugin finished successfully!\n"; exit(); } ############################################################## # usage ############################################################## sub usage { my $prog = basename($0); print "\nUsage: $prog file1 [file2] [file3] [...]\n\n"; print "This is a example plugin for mapivi (see http://mapivi.de.vu)\n"; print "It will just write a file list (the selected pictures from mapivi)\n"; print "Author: Martin Herrmann \n"; print "License: GNU General Public License, version 2\n"; } ############################################################## # labeledEntryButton - build a frame containing a labeled entry # and a button with a file selector ############################################################## sub labeledEntryButton { # input values my ($parentWidget, $position, $width, $label, $buttext, $varRef, $dir) = @_; my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef); setFileButton($frame,"right",$buttext,$label,$varRef, $dir); return $frame; } ############################################################## # labeledEntry - build a frame containing a labeled entry ############################################################## sub labeledEntry { # input values my ($parentWidget, $position, $width, $label, $varRef) = @_; my $frame = $parentWidget->Frame(-relief=>"groove", -bd => 2)->pack(-side => $position, -fill => "x", -padx => 3, -pady => 3); $frame->Label(-text => $label, -width => $width, -anchor => "w", )->pack(-side => "left", -padx => 3); my $entry = $frame->Entry(-textvariable => $varRef, -width => $width, )->pack(-side => "left", -fill => "x", -expand => "1", -padx => 1); $entry->xview("end"); $entry->icursor("end"); return $frame; } ############################################################## # setFileButton - open a file selector and set file name ############################################################## sub setFileButton { # input values my ($parentWidget, $position, $butlabel, $fileselLabel, $varRef, $dir) = @_; # $dir is optional, if defined and true a dir will be selected instead of a file $parentWidget->Button(-text => $butlabel, -command => sub { my $fileSelect = $top->FileSelect(-title => $fileselLabel, -directory => dirname($$varRef), -width => 30, -height => 30); my $file = $fileSelect->Show; if (defined $file and $file ne "") { if (-f $file) { $$varRef = $file; } } }, )->pack(-side => $position); } # Tell Emacs that this is really a perl script # Local Variables: # mode:perl # End: mapivi097/PlugIns/checkDir-plugin.txt0000644000175000017500000000016710014462503020142 0ustar herrmannherrmanncheckDir-plugin + check directory + 0 + this plugin will check the current directory for empty files and broken links mapivi097/PlugIns/test-plugin0000755000175000017500000000204110334167672016601 0ustar herrmannherrmann#!/usr/bin/perl -w # include perl packages use strict; use warnings; use diagnostics; use File::Basename; my $nr = @ARGV; if ($nr < 1) { print "Error: $0 called with just $nr arguments\n"; usage(); exit(); } my $dir = $ARGV[0]; if (-d $dir) { print "Error: first argument ($dir) is a valid directory.\nThis Mapivi Plug-In is developed for Mapivi version >= 0.7.5\n"; usage(); exit(); } for (0 .. ($nr-1)) { print "picture $_: $ARGV[$_]\n"; } exit(); ############################################################## # usage ############################################################## sub usage { my $prog = basename($0); print "\nUsage: $prog file1 [file2] [file3] [...]\n\n"; print "This is a test plugin for mapivi (see http://mapivi.de.vu)\n"; print "It will just print out the files received from mapivi\n"; print "Author: Martin Herrmann \n"; print "License: GNU General Public License, version 2\n"; } # Tell Emacs that this is really a perl script # Local Variables: # mode:perl # End: mapivi097/PlugIns/Join-RGB0000755000175000017500000000623210334171562015634 0ustar herrmannherrmann#!/usr/bin/perl -w # include perl packages use strict; use warnings; use diagnostics; use Tk; use Tk::FileSelect; use File::Basename; my $nr = @ARGV; if ($nr != 3) { print "Error: $0 called with wrong number of arguments (should be 3).\n"; usage(); exit(); } my $red = ""; my $green = ""; my $blue = ""; foreach (0 .. $nr-1) { my $pic = $ARGV[$_]; if ($pic =~ m/.*red.*/i) { $red = $pic; } if ($pic =~ m/.*green.*/i) { $green = $pic; } if ($pic =~ m/.*blue.*/i) { $blue = $pic; } } if ($red eq "") { print "$0 called with no red channel!\n"; usage(); exit(); } if ($green eq "") { print "$0 called with no green channel!\n"; usage(); exit(); } if ($blue eq "") { print "$0 called with no blue channel!\n"; usage(); exit(); } my $dir = dirname($red); if (!-d $dir) { print "$dir is no valid directory\n"; usage(); exit(); } my $top = MainWindow->new; $top->title("MaPiVi Plugin RGB Seperator"); $top->Label(-text => "Create a", )->pack(); $top->Button(-text => "RGB picture", -command => sub { export(); })->pack(); $top->Label(-text => "picture of the three selected channel pictures", )->pack(); $top->Button(-text => "exit plugin", -command => \&exit)->pack(); $top->MainLoop; sub export { my $rgb = $red; $rgb =~ s/(.*)(red)(\.jp(g|eg))/$1RGB$3/i; print "rgb outoput file = $rgb\n"; if (-f "$rgb") { my $rc = $top->messageBox(-icon => 'warning', -message => "output file $rgb exist. Ok to overwrite?", -title => "Plugin", -type => "OKCancel"); return if ($rc !~ m/Ok/i); } if (-f "$rgb.ppm") { my $rc = $top->messageBox(-icon => 'warning', -message => "temp file $rgb.ppm exist. Ok to overwrite?", -title => "Plugin", -type => "OKCancel"); return if ($rc !~ m/Ok/i); } my $command = "composite -compose copyred $red $green $rgb.ppm"; (system "$command") == 0 or print "Error: $command failed: $!\n"; $command = "composite -quality 95 -compose copyblue $blue $rgb.ppm $rgb"; (system "$command") == 0 or print "Error: $command failed: $!\n"; if (-f "$rgb.ppm") { if ( unlink("$rgb.ppm") != 1) { # unlink returns the number of successfull removed files $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$rgb.ppm\": $!", -title => "Error", -type => "OK"); print "Plugin $0 finished with errors!\n"; exit(); } } print "Plugin $0 finished successfully!\n"; exit(); } ############################################################## # usage ############################################################## sub usage { my $prog = basename($0); print "\nUsage: $prog file1-Red.jpg file2-Green.jpg file3-Blue.jpg\n\n"; print "This is a plugin for mapivi (see http://mapivi.de.vu)\n"; print "It will join the three selected RGB channel pictures from mapivi\n"; print "into one RGB picture\n"; print "The file names must include the corresponding color\n"; print "(red, green, blue; in upper or lower case)\n"; print "Author: Martin Herrmann \n"; print "License: GNU General Public License, version 2\n"; } # Tell Emacs that this is really a perl script # Local Variables: # mode:perl # End: mapivi097/PlugIns/checkDir-plugin0000755000175000017500000001252310334171017017330 0ustar herrmannherrmann#!/usr/bin/perl -w # include perl packages use strict; use warnings; use diagnostics; use Tk; use Tk::FileSelect; use File::Basename; use Cwd; my $nr = @ARGV; my $verbose = 0; if ($nr < 1) { warn "$0 called with just $nr+1 arguments\n"; usage(); exit(); } my $dir = $ARGV[0]; if (-f $dir) { $dir = dirname($dir); } my $top = MainWindow->new; $top->title("MaPiVi Plugin check dir"); my @emptyFiles = getEmptyFiles ($dir); my @brokenLinks = getBrokenLinks($dir); $top->Label(-text => "There are ". scalar @emptyFiles." empty files and ".scalar @brokenLinks." broken links in $dir")->pack(); my $ce = 0; my $cb = 0; if (@emptyFiles > 0) { $top->Button(-text => "remove empty files", -command => sub { foreach (@emptyFiles) { if ( unlink("$dir/$_") != 1) { # unlink returns the number of successfull removed files $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$_\": $!", -title => "Error", -type => "OK"); } else { $ce++; } } print "removed $ce empty files\n"; })->pack(); } if (@brokenLinks > 0) { $top->Button(-text => "remove broken links", -command => sub { foreach (@brokenLinks) { if ( unlink("$dir/$_") != 1) { # unlink returns the number of successfull removed files $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$_\": $!", -title => "Error", -type => "OK"); } else { $cb++; } } print "removed $ce broken links\n"; })->pack(); } $top->Button(-text => "Exit", -command => \&exit)->pack(); $top->MainLoop; ############################################################## # usage ############################################################## sub usage { my $prog = basename($0); print "\nUsage: $prog directory|file\n\n"; print "This is a example plugin for mapivi (see http://mapivi.de.vu)\n"; print "It will check, if there are some empty files or\n"; print "broken links in the given directory and ask to\n"; print "remove them.\n"; print "Author: Martin Herrmann \n"; print "License: GNU General Public License, version 2\n"; } ############################################################## # getEmptyFiles - returns a list of empty files ############################################################## sub getEmptyFiles { my $dir = shift; print " getEmptyFiles: in $dir\n" if $verbose; my @fileDirList = readDir($dir); my @fileList; foreach (@fileDirList) { # put only files which are empty into the filelist push @fileList, $_ if (-z "$dir/$_"); } return @fileList; } ############################################################## # getBrokenLinks - returns a list of broken links ############################################################## sub getBrokenLinks { my $dir = shift; print " getBrokenLinks: in $dir\n" if $verbose; my @fileDirList = readDir($dir); my @fileList; foreach (@fileDirList) { if (-l "$dir/$_") { my $real = getLinkTarget("$dir/$_"); print "$_ links to $real\n" if $verbose; if (!-f $real) { print "$real does not exists!\n" if $verbose; # put only files which are empty into the filelist push @fileList, $_; } } } return @fileList; } ############################################################## # readDir - reads the contents of the given directory ############################################################## sub readDir { my $dir = shift; if (! -d $dir) { warn "readDir: $dir is no dir!: $!"; return 0; } my @fileDirList; # open the directory if (!opendir ACTDIR, "$dir") { warn "Can't open directory $dir: $!"; return 0; } # show no files starting with a '.', but '..' @fileDirList = grep /^(\.\.)|^[^\.]+.*$/, readdir ACTDIR; closedir ACTDIR; return @fileDirList; } ############################################################## # getLinkTarget - returns the file a link is pointing to # input (directory, link) or (dirlink) where # dirlink consists of directory and link # works with relative and absolute links ############################################################## sub getLinkTarget { my ($dir, $link); if (@_ == 2) { $dir = shift; $link = shift; } elsif (@_ == 1) { $dir = dirname($_[0]); $link = basename($_[0]); } else { warn "getLinkTarget: wrong # of parameters!"; return ""; } # change first to the start dir (to handle relative links) return "" if !changeDir($dir); my $linktargetfile = readlink $link; my $linktargetdir = dirname $linktargetfile; # change to link target, this should now work for relative and absolute links return "" if !changeDir($linktargetdir); # get the current dir my $cwd = cwd(); $linktargetfile = $cwd."/".basename($linktargetfile); return $linktargetfile; } ############################################################## # changeDir ############################################################## sub changeDir { my $newDir = shift; return 0 unless defined $newDir; if ( !chdir $newDir ) { my $dialog = $top->Dialog( -title => "Changing to $newDir directory failed", -text => "Can't change to $newDir directory: $!", -buttons => ["OK"]); $dialog->Show(); warn "Can't change to $newDir directory: $!"; return 0; } return 1; } # Tell Emacs that this is really a perl script # Local Variables: # mode:perl # End: mapivi097/PlugIns/Channel-Separator.txt0000644000175000017500000000027010336156250020441 0ustar herrmannherrmannChannel-Separator + separate channels (RGB, CMY, etc) + 1 + this plugin will split the red, gree, blue, matte, opacity, cyan, ... channels of all selected pictures to separate files mapivi097/PlugIns/Channel-Separator0000755000175000017500000000464010336156226017636 0ustar herrmannherrmann#!/usr/bin/perl -w # include perl packages use strict; use warnings; use diagnostics; use Tk; use Tk::FileSelect; use File::Basename; my $nr = @ARGV; if ($nr < 1) { print "Error: $0 called with just $nr arguments\n"; usage(); exit(); } my $dir = $ARGV[0]; if (-d $dir) { print "Error: first argument ($dir) is a valid directory.\nThis Mapivi Plug-In is developed for Mapivi version >= 0.7.5\n"; usage(); exit(); } my $top = MainWindow->new; $top->title("MaPiVi Plugin RGB Separator"); $top->Label(-text => "Create a", )->pack(); $top->Button(-text => "red, green and blue (RGB)", -command => sub { my @list = qw/Red Green Blue/; export(@list); })->pack(); $top->Button(-text => "cyan, magenta and yellow (CMY)", -command => sub { my @list = qw/Cyan Magenta Yellow/; export(@list); })->pack(); $top->Button(-text => "matte, opacity and black", -command => sub { my @list = qw/Matte Opacity Black/; export(@list); })->pack(); $top->Label(-text => "channel picture of the $nr selected pictures", )->pack(); $top->Button(-text => "exit plugin", -command => \&exit)->pack(); $top->MainLoop; sub export { my @list = @_; for (0 .. $nr-1) { my $dpic = $ARGV[$_]; next if (!-f $dpic); print "processing $dpic ($_/$nr) ...\n"; foreach my $color (@list) { my $rgb = $dpic; $rgb =~ s/(.*)(\.jp(g|eg))/$1-$color$2/i; print "rgb = $rgb\n"; if (-f $rgb) { my $rc = $top->messageBox(-icon => 'warning', -message => "file $rgb exist. Ok to overwrite?", -title => "Plugin", -type => "OKCancel"); next if ($rc !~ m/Ok/i); } my $command = "convert -quality 95 -channel $color \"$dpic\" \"$rgb\" "; (system "$command") == 0 or print "Error: $command failed: $!\n"; } } print "Plugin finished successfully!\n"; exit(); } ############################################################## # usage ############################################################## sub usage { my $prog = basename($0); print "\nUsage: $prog file1 [file2] [file3] [...]\n\n"; print "This is a plugin for mapivi (see http://mapivi.de.vu)\n"; print "It will split the selected pictures from mapivi\n"; print "into RGB or other channel pictures\n"; print "Author: Martin Herrmann \n"; print "License: GNU General Public License, version 2\n"; } # Tell Emacs that this is really a perl script # Local Variables: # mode:perl # End: mapivi097/PlugIns/test-plugin.txt0000644000175000017500000000013710014462503017402 0ustar herrmannherrmanntest-plugin + Test PlugIn + 0 + this plugin will show the file names of all selected pictures mapivi097/COPYING0000644000175000017500000004311410120125123014032 0ustar herrmannherrmann GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. mapivi097/INSTALL0000755000175000017500000002713510757361474014073 0ustar herrmannherrmann ########################################################################## # # Mapivi - Martin's Picture Viewer # ########################################################################## Picture Viewer and Organizer for UNIX/X11, Mac OS X, Windows written in Perl/Tk. Mapivi supports adding, viewing and editing of JPEG meta informations like: EXIF, IPTC/IIM and JPEG comments. File INSTALL last modified: 21.02.2008 Mapivi latest version can be found at: http://mapivi.de.vu and http://sourceforge.net/projects/mapivi (download) ########################################################################## # # Requirements # ########################################################################## You need: o a computer running UNIX (Linux, Solaris, Mac OS X) and X11 or Windows (mapivi also works at least with Windows 2000 and WinXP, but maybe also with Windows 98) and for the perl distribution (recommended for non-Windows computers): o Perl 5.005 or better o Perl/Tk 800.015 or better o jpegtran to do the loss-less rotation. They are included e.g. in the The Independent JPEG Group's JPEG software release 6b (this program is part of most Linux distributions as part of the libjpg package) o jhead - for auto rotation of pictures homepage: http://www.sentex.net/~mwandel/jhead/ o the command line tools convert, mogrify and composite (or combine) from Image Magick (this is also part of most Linux distributions) see http://www.imagemagick.org o Perl module Image::MetaData::JPEG o Perl module Image::Info o Perl/Tk module Tk::JPEG (not needed if you have Perl/Tk 804.025 or newer) o optional: Perl module Proc::ProcessTable o optional: gimp-remote (for UNIX etc.) or gimp-win-remote (for Windows) You will find all the perl modules at http://search.cpan.org/ for the Windows distribution (mapiviXXX_Win32.zip) you need: o jpegtran to do the loss-less rotation. They are included e.g. in the The Independent JPEG Group's JPEG software release 6b (this program is part of most Linux distributions as part of the libjpg package) o jhead - for auto rotation of pictures homepage: http://www.sentex.net/~mwandel/jhead/ o the command line tools convert, mogrify and composite (or combine) from Image Magick (this is also part of most Linux distributions) see http://www.imagemagick.org o optional: gimp-remote (for UNIX etc.) or gimp-win-remote (for Windows) ########################################################################## # # Installation of Perl modules # ########################################################################## To install a Perl module you may either try cpan (a) or for Windows ppm (b) or do a manual (c) install. (a) Cpan will download a module (and all modules it depends on), build and install it. All you have to do is open a shell and type: cpan module_name Example to install the Perl module Image::Info: cpan Image::Info You may need root permissions for this step, try e.g. sudo cpan Image::Info (b) ppm is the Perl Package Manager for Windows it will download a module (and all modules it depends on), build and install it. All you have to do is open a DOS box (cmd) and type: ppm install module_name Example to install the Perl module Image::Info: ppm install Image::Info (c) For a manual install you must download the Perl module at e.g. http://search.cpan.org/, unzip and unpack it. The module can now be built using this sequence of commands: perl Makefile.PL make make test To install the module, run the command below: make install You may need root permissions for this step, try e.g. sudo make install ########################################################################## # # Installation of Perl distribution for UNIX # ########################################################################## File name mapiviXXX.tgz (or mapiviXXX.tar.bz2) in short: unzip, unpack, change to the mapivi directory and run mapivi with: perl mapivi in long: ("-> " is the command line prompt) unzip the archive (XXXX is the version number): -> gunzip mapiviXXXX.tgz or -> bunzip mapiviXXXX.tar.bz extract the tar-ball: -> tar xvf mapiviXXXX.tar go into the directory -> cd mapiviXXXX/ (where ever you extracted mapivi to ...) run mapivi -> perl mapivi (you only have to do this the first time for the mapivi install process) later Mapivi is started like this: -> mapivi Hint: For Ubuntu users there is some more help available here: http://ubuntuforums.org/showthread.php?t=130912&highlight=mapivi ########################################################################## # # Installation of Linux executable distribution # ########################################################################## File name mapiviXXX_Linux.exe.bz2 1. Unzip the package to a new folder anywhere using bunzip2 (e.g. to ~/progs/mapivi) 2. Download and install jhead and jpegtran, if not already installed. 3. Start MapiviXXX_Linux.exe with a double click in your file manager or in a shell (if this doesn't work you may need to adjust the file permissions: chmod a+x ~/mapivi/MapiviXXX_Linux.exe). That's all. ########################################################################## # # Installation of Perl distribution for Mac OS X # ########################################################################## File name mapiviXXX.tgz (or mapiviXXX.tar.bz2) [Unfortunately, I did not keep track of all the things I had to install to make mapivi work. If you are the next person to install mapivi on Mac OS X, please make a list and tell Martin. -- Dan Eble] Follow installation instructions for UNIX. macosx-preview Mapivi comes with a shell script, macosx-preview, which opens the Preview application to serve the "open picture in external viewer" feature. To use this feature, make sure the script is in a directory that is in the PATH, or instead open the mapivi options (Ctrl-o), go to the Advanced tab, and change the setting to include the full path to macosx-preview. The macosx-preview script attempts to use full-screen view, but this requires the feature "access for assistive devices". To enable this feature, run System Preferences, select the Universal Access pane, and check the box labeled "Enable access for assistive devices". ########################################################################## # # Installation of Windows executable distribution # ########################################################################## File name mapiviXXX_Win32.zip 1. Unzip the package to a new folder anywhere (e.g. C:\Program files\Mapivi) 2. Download and install ImageMagick, jhead and jpegtran. 3. Start MapiviXXX_Win32.exe with a double click or in a dos box. That's all. ########################################################################## # # Installation of Perl distribution for Windows # ########################################################################## File name: mapiviXXX.tgz (or mapiviXXX.tar.bz2) Installation order: 1. Active State Perl 2. Perl module String::IO 3. Perl module Image::Info 4. Perl module Image::MetaData::JPEG 5. Perl module Tk::JPEG (needed only for Perl/Tk versions < 804.025) 6. ImageMagick, jhead, jpegpixi, ... 7. Mapivi Install perl e.g. the Active State Perl (www.activestate.com) Try also to get the needed perl modules from there. Install Image magick, jhead etc. Suggestion: Create a new directory e.g. C:\Programs\Graphics and install all backend tools in this directory. Don't forget to add this directory to the PATH variable (System->Environment variables->Path). unzip, unpack mapivi (e.g. with winzip) change to the mapivi directory in a DOS-box and run mapivi with: perl mapivi I recommend renaming mapivi to mapivi.pl (or mapivi.wpl), so the windows explorer is able to recognize it as a perl file. After renaming it's possible to start it with a double click, or via the start menu or the quick launch bar. You may also change the default perl icon to the MapiviIcon32.ico icon (see directory .../mapiviXXXX/pics/). If you have problems with Win Xp and Tk::JPEG, maybe this link is a help for you: http://perlmonks.thepen.com/195691.html Hint: If you have problems with convert from ImageMagick, this may be due to the fact, that there is a windows program with the same name. Workaround: the path to the ImageMagick convert tool must be in front of the windows convert tool in the PATH variable. ################################# Perl Installation Update for Win32 (Nov 2004): Install perl e.g. the Active State Perl (www.activestate.com download here: http://www.activestate.com/Products/Download/Download.plex?id=ActivePerl) e.g. ActivePerl 5.8.3 build 809 (I usually use the file with the MSI suffix) Open a DOS box, start ppm (enter ppm and press return) and download the actual Perl/Tk 804.027: ppm> repository add BdP http://www.bribes.org/perl/ppm ppm> install http://www.bribes.org/perl/ppm/Tk.ppd -force This new version already includes Tk::JPEG Now you just need to install Image-Info and Image-MetaData-JPEG: ppm> install Image-Info ppm> install Image-MetaData-JPEG ########################################################################## # # Installation of other Mapivi files and PlugIns # ########################################################################## Most of the files provided in the Mapivi Perl package should be copied to the configuration folder of Mapivi (UNIX: ~/.maprogs/mapivi/PlugIns, Windows: C:\Documents and Setting\\Application Data\maprogs\mapivi). Mapivi will run without this step, but it will provide more features and look better if you do! :) Copy the files Changes.txt, FAQ, License,txt, Tips.txt to the configuration folder. Copy all pictures from the subfolder pics (like EmptyThumb.jpg, logo.jpg, MiniPic.jpg, add.gif) to the configuration folder (no subfolder here). Copy the complete icon folder (containing edit-copy.png, folder.png, go-next.png, ...) to the configuration folder. Copy the complete PlugIns folder (containing Channel-Separator, Join-RGB, ...) to the configuration folder. Plug-Ins are executable applications which are stored in the Mapivi configuration sub folder PlugIns (UNIX: ~/.maprogs/mapivi/PlugIns, windows see above and add \PlugIns). They are called by Mapivi with the selected pictures (each with complete path) as arguments. The example PlugIns contained in the Mapivi distributions are written in Perl. To get them running on your system it may be necessary to adjust the first line of each PlugIn (e.g. filelist-plugin). The first line must contain the chars #! and the full path to your perl executable. Example: #!/usr/bin/perl (To get the full path of perl try: which perl in your shell.) ########################################################################## # # Help # ########################################################################## You will find a lot of help to Perl and Perl/Tk in this newsgroup: news:comp.lang.perl.tk The newsgroup may be searched using this link at google.com: http://groups.google.com/groups?hl=en&group=comp.lang.perl.tk If this won't help, try to start mapivi from perl and read the output carefully -> perl mapivi You may also set the $verbose variable to 1 to get more information. To do this, press Ctrl-v while running mapivi or by opening mapivi in a text editor and searching for this line: my $verbose = 0; # boolean (1 = print debug infos, 0 = be quiet) and changing it to: my $verbose = 1; # boolean (1 = print debug infos, 0 = be quiet) then save mapivi and restart it: -> perl mapivi Send me an email if it you have problems, questions, feature requests, patches or comments: Martin-Herrmann@gmx.de (german or english spoken) mapivi097/Changes.txt0000755000175000017500000015256310757363376015162 0ustar herrmannherrmann2008/02 mapivi version 0.9.7 + added 2008 copyright info 2008/02 mapivi version 0.9.6 + added location window to search for and to add location informations (based on IPTC tags Country, Province/State, City, Sublocation) + revised the import dialog: removed mount/unmount + revised the import dialog: moved some options to a foldable frame + revised the import dialog: added an option to add a high rating to locked (write-protected) pictures + embedded a new Mapivi icon + added common key bindings to the dirtree and the picture frame + included patch to correct timezone calculation in case of migration over 24 hour border (Thanks Rene!) + included patch adding a third IPTC dialog layout (without categories) (Thanks Rene!) + show changed IPTC caption in main window if edited in IPTC dialog + added an ignore filter in search for duplicates + improved search for duplicates window 2008/02 mapivi version 0.9.5 + improved usability in crop dialog (better mouse handling, 1/3-grid) + added evolution and mozilla-thunderbird as possible email clients + IPTC caption is now editable in main window (key: F4) + added support for RAW files (files are moved, copied rename along with their JPEG file) + added searching for duplicates by same creation date + improved and reordered several menus and added all layouts as menu entries + improved usability in change EXIF date/time dialog + usage of a proportional font in the keyword search (cloud tag) for better font sizing + increased number of maximal shown thumbnails from 1000 to 10000 + bug fix in IPTC dialog when editing several pictures with different settings + bug fix in search duplicated by file size + usage of nstore instead of store enables usage of search database across different OS 2007/07 mapivi version 0.9.4 + Support for XMP sidecar files and WAV files (copy, move, rename them with JPEG file) + some experiments with encoded file and folder names (see Encode::encode) + replace some non-printable chars in IPTC data + Adaptations for keywords added from Picasa + improved user feedback (progressbar) when editing IPTC of several pictures + some work on fullscreen mode in main window and when pic is displayed in own window (key: F11) + new key (m) in search window to show selected picture in main window + the options window is smaller to fit on small screens, it may be closed with Ctrl-x (OK) or ESC (Cancel) 2007/05 mapivi version 0.9.3 + when editing IPTC info of multiple pictures the dialog shows all common tags and keywords + added several lossless JPEG operations: add border, add relative border, add border aspect ratio, add watermark, ... + added icons to all menues (they are stored in configdir/icons) + added Image::ExifTool as an optional module + if ExifTool is available some XMP operations are supported (see Menu:Edit->XMP info ...) + more search options in the cloud tag: date range and rating range + keyword window may now be docked to the left or right side of the main window + TOP50 of most popular pictures has been replaced by TOP100 of best rated pictures (see special searches) + number of digits in the filename in the light box are calculated by the number of pictures (thanks to Yann Michel) + some parts of the old filename (e.g. the number) can now be reused in Smart rename (thanks to Thierry Daucourt) + better and more checks when adding new keywords to the hierarchy + decoration dialog offers the ImageMagick fonts now + progress dialog calculates the estimated total time for an operation + some experiments with encoded file and folder names (see Encode::encode) + renamed directory to folder 2006/12 mapivi version 0.9.2 + new command line option -i to start with import wizard + new option to start import wizard at startup when a memory card is inserted + modified some default options + Mapivi now saves the last selected picture (optional) + code cleanup + support of three different date formats (yyyy-mm-dd, dd.mm.yyyy, mm/dd/yyyy) see line 6000 + check new keywords and categories for unsupported chars (slash and backslash) + support to delete multiple keywords/categories from the catalog at once + better progress info for tasks with undefined length + smart rename adds now a 3 digit number instead of a 2 digit number when needed + added some balloon help in the option window + some experiments with ExifTool (not yet active) 2006/10 mapivi version 0.9.1 + several improvements for adding new keywords, e.g. new keywords may now also be ignored - the ignore list is saved in file keywords_ignore + the number of keywords in the keyword browser can be limited to the 100 most popular + more information in the keyword browser, e.g. number of displayed and available keywords + the warning after changing an existing rating/urgency can be switched off + some more speed improvements when reading in a directory a second time by using file and pixel size information from the database + bug fix: when using the IPTC edit dialog the rating/urgency is now handled correct + improved folder selection dialog for "add to database ..." and "build thumbnail database ..." + new popup menu in thumbnail preview window (also used when showing pictures from keyword browser): open picture folder in main window + show at least the complete path and file name in balloon if picture is not available 2006/10 mapivi version 0.9.0 + new feature to browse the pictures by keyword/tag clouds (menu: Search->browse database by keyword ...) + mapivi detects new IPTC keywords in pictures and asks to add them to the keyword catalog (try Menu: Search->add to database ...) + integrated a new color chooser (Tk::ColorChooser is no longer needed) + added a color picker (color pipette) to choose a color of a picture, the picked color may be used to e.g. add an adequate frame color + search for duplicate pictures may now be restricted to selected directories + search for pictures with a certain pixel size is now supported + new function to add an inner frame when using the montage/index print function + add join button and mode in category window + new preset when changing picture size (PAL: 720x576 pixel) + added Mapivi icon image to all windows + removed unused function exportIPTC() to XML + small bug fixes and improvements 2006/09 mapivi version 0.8.3 + new feature: timeline; showing distribution of pictures over month and year (new way to access your pictures and better info about database content) + sort by EXIF date, file date, file size and urgency are much faster now, as they use info from database + it is now possible to restore pictures from the trash as the original folder info is saved + montage/index print is now also available in the light table + bug fix: when a folder is removed all pictures are now also removed from the database + search duplicates: it is now possible to ignore links + search window: new menu item to remove items from the database + changed key bindings: key-F5: smart update, key-u: update thumbnail list + pressing the middle mouse button to view a picture no longer changes the selection + search window: added dummy frame for further extensions + several GUI improvements 2006/08 mapivi version 0.8.2 + speed improvement up to 10 times when reading in a directory a second time + smart update of directory (much faster especially in big directories) + added basic support for PNG pictures + improved IPTC dialog (simple and professional layout) + improved directory diff: more functions, other layout + keyword window and light table save their size and position on the desktop + new feature to remove image meta info when resizing a picture + better logical ordering and consistency when displaying IPTC infos + show pic in own window is able to display several pictures + more and better infos when importing slideshow files + new aspect ratio 5:4 (for PAL video) + better layout of overlay meta info + improved grayscale function + new additional builtin histogram function + added more variables in the smart rename function + add pictures from a thumbnail window to the light table + improved search dialog: entering of date ranges + fixed bug in light table resize under windows + fixed bug in light table move thumb and scroll 2006/01 mapivi version 0.8.1 + fixed a bug with the default thumbnail EmptyThumb.jpg (thanks to Christian Franke) 2006/01 mapivi version 0.8.0 + Mapivi has a nicer and more modern look + improved menu layout + more color options plus presets + keywords and categories may now be added in join mode: e.g. Family.Herrmann.Martin + grayscaled (black/white) pics using a channel mixer with a lot of useful filter presets + more functions and menues in the light table window + added options when saving xnview slideshows (e.g. support relative paths) + more menu items and key shortcuts in the search window (e.g. keywords and rating) + save and restore size of search window + reduced thumbnail generation options + TOP50 displays thumbnails now + a lot of bug fixes and improvements 2005/11 mapivi version 0.7.5 + new: added a light table, to sort out and rearrange picture collections, albums, slideshows it is possible to save these slideshows as XnView compatible *.sld file lists + improved the search window (cleanup, more help, better layout) + made more file operations work in the search window (e.g. backup, rename, build web pages) + added possibility to sort and search pictures by popularity (number of views) + added TOP50 of most popular pictures (see menu: Extra->show TOP50) + added -size to convert arguments which speeds up the resizing (idea: Dan Eble) + experimental: menu: Extra->show picture view list (to show slide show lists in main window) + changed the PlugIn arguments from (dir file, file, ..) to (file, file, ..) (each with full path) + reworked all PlugIns accordingly + show file size difference in Bytes in the directory difference window + removed gimmicks like background thumbnails + improved thumbnail options window + new key bindings (e.g. Ctrl-k for categories) + code cleanup and minor bug fixes 2005/11 mapivi version 0.7.4 + build web pages: escape special HTML characters (Dan Eble) + build web pages: first page is called index.html (easier access) (Dan Eble) + new feature: track popularity of pictures (count how often a picture has been viewed within mapivi) + improved handling of linked files and modification time checking (Dan Eble) + better EXIF support for Canon cameras (Dan Eble) + cleanup and rearrangement of the IPTC dialog (not finished) (Dan Eble and Martin) + picture balloon messages are in better shape now + code cleanup and minor bug fixes 2005/09 mapivi version 0.7.3 + import EXIF date, time, owner in IPTC + search just in IPTC keywords + add asymmetric borders around pictures + show or edit IPTC and copy to print also in search window available + more options in directory checklist + better? folder selection for windows + backup is shown immediately + adjustable separator when joining comments + user is asked before a backup file is renamed + easier search patterns ((,),[,],{,},+,... may be used now) + support for new gimp-win-remote (GIMP >= 2.2), old one is no longer supported, but code still available + slideshow displays just the selected pictures + exiftool experiments + code cleanup and bug fixes 2005/03 mapivi Version 0.7.2 + new feature to add comments while importing pictures + new feature to add IPTC templates while importing pictures + swapped IPTC and EXIF column in search window too 2005/03 mapivi Version 0.7.1 + mapivi supports and needs module Image::MetaData::JPEG in version 0.14 or better => no more memory leaks when cataloging pictures + autocompletion in most of the entry fields (e.g. in the IPTC editor) to add a new value you must leave the entry with tab or enter key! see also menu:Extra->edit entry history + new feature: add lossless border to JPEG pictures (see menu: Extra->add lossless border) + crop dialog nearly completly rewritten, frame is now drawn using the mouse directly + fixed bug when adding IPTC info to a single picture + improved font selection (new dialog) + new option to overlay the picture with it's meta data + better keyboard support + simply add/remove keywords to comments of one or many JPEG pictures + the setting all/last in keyword and category dialog will be saved + removed the Stop button from the main window (subs: stopButStart, -Stop, -End, -Check) + swapped IPTC and EXIF column in thumbnail table + middle mouse button click in dir tree opens thumbnail preview window of selected directory + bug fixes in: checkCachedPics() and selectThumb() + added more support for non-JPEG pictures, but still a lot work to do + improved display in directory checklist (red for unavailable directories) + resizable columns in search dialog + improved empty-trash functionality + renamed the String, And and Or-Search to exactly, all and any + several improvements and bug fixes 2005/01 mapivi Version 0.7.0 + directory checklist, helps to keep track in which dir the pics are sorted, commented, rated, ... + hierarchical IPTC keywords and categories with easy edit functionality (also for comments) please rename your existing keywords and categories files in the config dir to see the new examples + IPTC keywords and categories are also available as extra dialogs, simply double click on an item to insert it in all selected pictures (use right button to open the edit menu in these dialogs) + copy, save and restore EXIF data stuff is working again in this version + more data in the search database: file size, pixel size, modification time + improved search dialog (show file attributes, urgency search, display EXIF and histogram, sort found pics) + bug fix in search: only the first line of multiline comments and IPTC infos was searched + better memory management (remove thumbs objects after searching) + new keys: to show histogram jump to next selected pic + faster histogram for those with limited ImageMagick installations (no LZW) + show [raw] in the size column if there is a raw (*.nef, *.crw) pic available + show directory sizes including all subdirs in a grphical way + improved comment dialog + new function: empty trash + show file date in balloon popups + removed warning for thumb caption none + corrections, improvements and bug fixes 2004/12 mapivi Version 0.6.2 + Warning: copy, save and restore EXIF data stuff is not working in this version! + Warning: old IPTC templates can no longer be used! + Warning: existing stored EXIF files can no longer be used! + Warning: non-JPEGS are no longer copied, renamed or moved with their JPEG pic! + copy and paste IPTC infos between pictures + new HTML template tags: file-no-suffix, iptc-headline, iptc-caption, comment + edit IPTC info now also in search dialog window + move pics now also in search dialog window and in duplicates window + selectable font family, color and shadow and better layout in add copyright info + editing IPTC infos of multiple files is better supported now (working with Image::MetaData::JPEG) + show the transfer rate when importing pictures + bug fix: flash usage in EXIF data was sometimes wrong + libexif and exif are no longer needed thanks to Image::MetaData::JPEG + replaced jhead by Image::MetaData::JPEG where ever possible + Show ISO setting also for Nikon D70 (it's hidden in the MakerNotes) + startet to support other picture file formats than JPEG (see e.g. is_a_JPEG) + solved some focus problems when clicking on dialogs + added version check for module Image::MetaData::JPEG 2004/10 mapivi Version 0.6.1 + new function to add fuzzy borders to pictures (see menu Extra) + indexPrint() now uses a lossless file format when more than one convertion is done + new option when importing pics: delete Canons *.ctg files thanks to Dan Eble + better Mac OS X support thanks to Dan Eble + improved user info for not available external programs + corrections, improvements and bug fixes (thanks to Martin Sarsale) 2004/10 mapivi Version 0.6.0 + new more compact layout (filename below thumbnail; optional) thanks to Dan Eble + big internal change of the hlist usage: the entrypath now represents the path and filename + better layout, balloon infos and a delete function in display directory (showThumbList()) + better auto rename function: the first picture of a set will now also have an number (-00) + bug fix: mapivi did not work if Image::IPTCInfo was not available + the offset to GMT is now added in the IPTC dialog when using the EXIF time + default settings for Windows and Mac OS X for the external viewer + better user info in case of errors: the errors are collected and displayed after a batch job + added mapivi icons to most of the windows + enhanced the myButtonDialog to replace the myEntryDialog in many cases + added a test suite for regression test of the non-GUI parts + more function prototypes + some first researches to support UTF8 encoding in comments + bug fixes, code cleanup und minor improvements 2004/09 mapivi Version 0.5.9 + new function to convert JPEGs to other formats (GIF, PNG, TIFF) (feature request from Stephan Helma) + new and very fast function to convert pictures to grayscale using jpegtran + better layout of the IPTC dialog thanks to Dan Eble + the section color is configurable thanks to Dan Eble + new possibility when dragging pictures to the dir tree: link file. Thanks to Dan Eble + do not link to a link bug fix by Dan Eble + cleaned-up the directory hot list management (btw, the file ~/.maprogs/mapivi/dirs is no longer needed) + semi transparent box around the crop frame in crop window + lossless cropping is done in 8 or 16 pixel steps + the urgency scale is now well aligned for all Tk versions and has more colors + new key: Ctrl-F10 to remove the IPTC urgency flag + select and show the actual directory in the dir tree should work now + bug fix in the short IPTC output and the IPTC urgency setting + the picture in the image processing window may be dragged now (panning) + some bug fixes and some first steps to support more image formats than just JPEG 2004/09 mapivi Version 0.5.8 + interface of deletePics(), crop() and copyPics() and other functions changed, they are now usabel from any window + improved web gallery generation (e.g. better use of IPTC infos) thanks to Dan Eble + the search database is saved per default now + it's now possible to edit comments of pics in the search window + minor changes and bugfixes 2004/09 mapivi Version 0.5.7 + show memory usage of mapivi in Help->About if Proc::ProcessTable is available + removed preload pic function - it was not very helpfull + improved the handling of cached pictures (they are now adressed by name, not by index) + showPics() argument also changed from the index to the path and file name + new function in dirtree context menu: calculate directory size + new option in build thumbs in all subdirs: update or rebuild + better update of the search database when moving, renaming, ... pics 2004/09 mapivi Version 0.5.6 + all (?) functions use the new progresswin dialog + bugfix: show [s] in EXIF column, even if there is no EXIF in the pic + show changed comments and EXIF infos above the actual picture + windows only: show an info when there is no directory requester + enabled search function to search for pictures without comments, EXIF or IPTC infos + added hint howto search for empty comments etc. as balloon info in the exclude pattern entry 2004/08 mapivi Version 0.5.5 + new window to show just thumbnails in columns and rows (try key in dirtree) + a lot of functions use the new progresswin dialog + showThumbs() new approach: use the information of the search database + speed up of many functions (by trying to load the MetaData only once and using the FASTREADONLY option) + corrected the wrong layout of the crop dialog under windows + the name of Image::MetaInfo has changed to Image::MetaData (V0.11) + use Image::MetaData for all EXIF functions + no more use of Win32::FileOp, because it simply didn't work + bugfix: the delete to trash function in the search meta dialog removed the pics instead of moving them to the trash + take OS X into account (OS name of Mac OS X is darwin) 2004/07 mapivi Version 0.5.4 + search: added the creation time to the database and search win + search: searching of dirs is possible + search: local search (below a given dir) is possible + search: speed-up and better messages if nothing was found + To use the new features a database rebuild is recommended + improved progressWin with a stop watch and estimated time to go + more use of progressWin + better info in buildDatabase() + started a sort function in the search window 2004/07 mapivi Version 0.5.3 + started to use function prototypes + new functions progressWin, to show a progress bar while working + cutString will accept negative length values + mouse wheel works in some more widgets even for Tk older as 804 + buildThumbsRecursive works on the selected directory + new function centerWindow + buildDatabase has a new fast update mode, where only new pics are added (no update of all existing pics) + some improvements in searchMetaInfo 2004/07 mapivi Version 0.5.2 + added a lot of constants to replace the cryptic 1 or 0 arguments + changed pixels per byte to bits per pixel (which is more common) 2004/07 mapivi Version 0.5.1 + new column in main table: directory + getPics() may add the path to the filelist + sortPics() works on a array ref now + checkLinks() works listbox specific now + the IPTC urgency is handled as a seperate tag in the search DB (more to follow) + the EXIF functions (remove, copy, ...) no longer destroy the comments + removed more than 2000 useless double quotes + removed useless braces + replaced double quotes with single quotes (still not finished) + use of constants + double quotes in comments will be replaced by single quotes + new sub: trimComment() + sendTo(): do not remove the compressed pics afer 5 secs 2004/06 mapivi Version 0.5.0 + more than 300 changes in this version + using new module Image::MetaInfo::JPEG from Stefano Bettelli - wrjpgcom and temp file are no more needed - easiers and faster comment handling - pixel size available for all pics + using Text::Wrap to format the text in the listbox + pictures may be compressed (in size and quality) befor sending via email + more perl like for loops e.g. (0 .. 10) + seperated getPics() and sortPics() function + the checkDialog() is applied in more places + time measurment in the showThumbs() sub + started to redesign functions to be listbox independent + new subs: cutString, getMetaInfo, updateOneRow, replaceComment, myReplaceDialog, showSegments, checkDatabase + search and replace comments (works in dirs and search findings) + check database: search Database (comments and IPTC) for strange chars + solved a win32 grab problem + better and more configurable EXIF output + cleaned up the different getIPTC subs + change font without need to restart + bug fixes, code cleanup + mouse wheel works in some more widgets even for Tk older as 804 + windows like serach patterns in edit database (added new search patterns) 2004/05 mapivi Version 0.4.1 + added use bytes and use locale for better locale support + send pics via email (works currently only with thunderbird mail client) + the EXIF date may also be changed in year steps + compare two directories containing JPEG pics by file name, size, pixels, comments, EXIF, IPTC + some little layout improvements and new key bindings + go to pic / select pics (try key Ctrl-g) + removed the use of KDEsite (drag and drop) for Tk >= 804 + some addaptions (e.g. dirtree) to Tk >= 804 + sort pics by EXIF tag: artist + display of EXIF tag: artist in thumbnail table + sort pics by IPTC tag: byline + ask before opening of more than 10 windows (for EXIF, comments, thumbs or IPTC info) + fixed some zoom bugs + more menu functions and key in the search and duplicates windows + edit a pic in GIMP even without gimp-remote 2004/03 mapivi Version 0.4.0 + thumbnails may also be stored in a central place (thumbnail database) -> viewing read only dirs (CDROM) is possible now + new function to clean thumbnail database + improved edit database (it is searchable now) + improved duplicate search (by file name, by file size, context menu) + improved search: exclude pattern, urgency (lower, bigger), context menu, just count option + show histogram of a picture + improved import wizard: log window, import pictures from subdirs, save original name ... + improved IPTC editing (e.g. more and better ballon help, correct syntax) + middle mouse button selects and open picture + do not start in fullscreen mode + show the thumbnail when editing comments + the coordinates are now correct when pics are centered (introduced in 0.3.6) + option for external viewer handling picture list 2004/02 mapivi Version 0.3.9 + added IPTC template support (save, merge) + it possible to remove the IPTC urgency flag via menu or dialog + sorting of the pictures for meta data is much faster now + smarter reselection after delete + removed a little bug in the search database (dot dirs) + some more windows are decorated with icons e.g. Help->About + some litte bug fixes and improvements 2004/02 mapivi Version 0.3.8 + show image infos (using identify from ImageMagick) + several dialogs also show the thumbnail now (e.g. EXIF info and add comment) + changed the order of the fullscreen mode calls + some litte bug fixes and improvements 2004/01 mapivi Version 0.3.7 + some editoral changes in the perldoc part of mapivi + little layout changes (enlarged the canvas some pixels) + removed bug with big pictures centering (introduced in 0.3.6) + removed bug not storing IPTC infos in the database (introduced in 0.3.1!) + improved handling and display of exotic EXIF data 2004/01 mapivi Version 0.3.6 + the config directory of the windows version has moved to $ENV{APPDATA}/maprogs/mapivi + improved program execution in windows (no more dos-box pop-ups) + open a picture in gimp even in windows (needs gimp-win-remote) + EXIF thumbnail actions: set, (re)build, rotate (needs libexif/exif) + the adjuster settings (frame width) are saved now + a lot of new small features (e.g. beep when loop to the first pic) + more zoom levels + adjust EXIF date relative (e.g. +/- 1 hour) + better fullscreen support (try key F11) + picture is centered in picture frame (canvas) + clear the EXIF rotation tag + small bug fixes + more infos in menu Help->About 2003/12 mapivi Version 0.3.5 + splash screen while loading + new modern look with small widget borders + copy to print directory support (help burning CDs/uploading pics to print) + the open pic in ext viewer should now work on windows too + assigned key: v + redo last selection + new function to add drop shadows to pictures + the app to set the desktop background is now configurable + mapivi will clean up dirs, when they are empty + it's possible to see if a picture has an ebbeded EXIF thumb (optional) + more intelligent display of picture comments + better fallback solution, when Tk::ColorChooser is not available + find duplicates started a new improved interface (not finished!) 2003/11 mapivi Version 0.3.4 + import wizard: mount, copy, interpolate, rotate, rename pictures in one step + support for jpegpixi to remove dead pixels nearly lossless + optional display of the mouse coordinates in a picture (e.g. to locate dead pixels) + build a difference picture of two pictures + complex borders (up to four frames) + display the rating/urgency of the current pic in the status bar + improved user interface and more key bindings + the current dir is also displayed in the balloon of the status bar label + the middle mouse button will open the selected pic in a new window (also in the search window!) + new menu: Search + the directory specific menu commands try to be more intelligent when choosing the right dir + code cleanup and bug fixes + better support for Windows (when using file dialogs) + new function to delete a directory (a summary will be shown first) + improved crop dialog (portrait/landscape switch, more infos) + when building web galleries it's now possible to leave the pics untouched + new variables for the web templates: mapivi-date and mapivi-time + new plugin: split a picture in seperate channels (RGB, CMY, ...) + new plugin: join RGB channels to a picture + new plugin: check a directory for broken links and empty files 2003/10 mapivi Version 0.3.3 + mouse wheel support in the dirtree and thumbnail listboxes + a make-new-directory-button was added to the directory browser window + better handling of write protected pictures + keyword support when adding JPEG comments (just one click to insert often used words) + new function to create symbolic links (not available in the Windows version) + complex borders (up to three frames) + umlaut convertion is optional now + improved handling of the tab key (to switch focus between widgets, scrollbars are ignored now) + a logo may now also be added into the picture border + improved error handling when writing IPTC infos + faster reaction, when deleting all pics of a directory + renamed filter to image processing 2003/09 mapivi Version 0.3.2 + new function labeledscale saved about 470 lines and 14kB + adjustable font size in index prints + interface to external picture viewer + Middle mouse button: display selected picture in a new window + the file size of the selected pictures is displayed in the status bar + it's now possible to add a copyright info in the new border of a picture + improved overwrite requester with thumbnails, file size and date + bug fixes and improvements 2003/08 mapivi Version 0.3.1 + drag-and-drop support: - copy/move pictures by drag/drop them from the listbox into the dirtree (this works at least on solaris) - open pictures or directories by dragging them from e.g. the desktop into the mapivi window (this works at least on MS windows) + import of Postscript (*.ps) files + the font family used by mapivi is configurable + build web pages: new element HTMLFooter (holds e.g. your email adress) + build web pages: improved dialog + improved search: Comments, EXIF, IPTC and filename may be joined now + the number of lines and the line length of comments and IPTC infos in the thumbnail table are adjustable + the dir hot list is now also available in the file menu and via the key + the search data base file is renamed from dirInfo to SearchDataBase + the extended selection via the anchor and Shift-B1 in the thumbnail table was a litte bit broken, this is fixed now + the actual thumb in the thumbnail table is moved, so that the next (and the prvious) thumb is also visible + added feeback when deleting pictures 2003/08 mapivi Version 0.3.0 + import of PPM files + thumbnail limit for directories with a huge number of pictures + new in filter dialog: Level + now optional: check and warn for linked files + index prints with adjustable border size + the actual dir label is now clickable (-> a simple dir requester will pop up) + new button ".." to jump to the parent directory + clean up in the status bar: there is just the stop button left + new function to show the backup file key: + bugfix in deletePreloadList + new function: invert selection + bugfix: when working with linked files (update of thumbs works now) + improved string formating (for thumbnail table) + code cleanup and improvements + the actual selection of pictures is no longer lost, after an action (e.g. rotation) + added an unsharp mask option in rotateAny() + menu rework finished: nearly no more double entries, all single source now + new function: rename actual directory + bigger preview thumb in filter dialog + improved the layout of the crop dialog window + the buildDatabase function may be stopped now 2003/08 mapivi Version 0.2.9 + added a FAQ (also visible in the help menu) + IPTC urgency support, set and diplay the priority of a picture - via menu or Ctrl-Fx keys - the search dialog also supprots the urgency now - is possible to sort by urgency + all IPTC attributes are now saved in the database + new function to remove the IPTC info of pictures + bugfix in the edit IPTC of multiple pictures sub + the file date is displayed + auto wizard when removing a certain comment in multiple pics + support of lossless flip transformation (horizontal and vertical) + improved rotate dialog with artificial horizont to ease the alignment of a picture + an unsharp mask filter is now implemented in the filter dialog + the resize filter is choosable + improved batch renaming, key + improved crop dialog + the file name is used as a second sort criteria + mapivi icon also when running under windows + new update, only for the actual picture: key + improved handling of the preloaded pictures + code cleanup 2003/07 mapivi Version 0.2.8 + completly new zoom concept: 23 appropriate (and fast) zoom levels with smaller steps than before for autozoom and normal zoom (keys: + and - or new picture menu Zoom) + added Gamma correction (see menu->options->advanced) + improvements in buildDatabase(): better user info and working break button + new: cleanDir() cleans a directory from all the stuff added by mapivi (thumbnails, ...) works recursive, but will ask first + allow big comments in html export (1000 chars) + mySelListBoxDialog: Double clicking on items is supported + the ShowHiddenDir flag is now also used in the dirDialog() + bugfix: removed a unconditioned chdir (dirtree) in dirDialog() (thanks to Kish!) + bugfix in filter: the gamma value was only applied when the Sharpness value was != 1.0 + some menu reorganisation + corrected the titles of a lot of dialogs + increased sliderlength from 10 to 30 + added a new layout (20% dirs 80% picture) + code cleanup 2003/07 mapivi Version 0.2.7 + the layout of the mapivi window is completly configurable now try the F1-F4, the F6-F11 and the l-key + the exact layout of the two adjusters (width in letters) is no longer saved, but the overall layout + fixed a bu with different itemStyle versions (-bg -> -background) + removed warning, when there is no plugin directory + the rotate dialog is able to do individual or common rotation (doforall-flag) + start of menu reorganisation/reuse of common parts + the height of the comment text box is configurable (options->advanced) + improved the installation process (some text files will be copied to the config dir) + code improvement and bug fixes 2003/07 mapivi Version 0.2.6 + picture rotation by any angle (and with preview) is now possible + the problems with preloading pictures and fast cycling should be solved now + mapivi now handles different DirTree.pm versions correctly (chdir vs. set_dir method problem) + the comment and the EXIF frame above the picture frame may now be enables and disabled without restarting mapivi + now all buttons are in the aqua look + new keys and + added a restart mapivi function (File-menu) + some bugfixes 2003/07 mapivi Version 0.2.5 + jpegEXIForient is no longer needed, because the actual jhead version is able to do automatic lossless rotation + the preloading of pics works better now, because we block the space-key until the (pre)load is done viewing pics forward and backward (with or without preload) seems to be stable now. + more balloon help in the options dialog + comments will be added to pictures created/processed by mapivi (e.g. the complete filter setting so it's possible to reproduce a certain result) - this feature is optional (see options dialog) 2003/07 mapivi Version 0.2.4 + big redesign of the IPTC dialog (much easier to work with now + added balloon help) + user predefined IPTC keywords and categories + it is possible to search for duplicate pictures in the database (by file name) + the crop preview size is 75 percent of the screensize + the search dialog has a stop-button now + it possible to copy the EXIF date to the IPTC date created field + all (at least I hope) batch actions can be canceled using the stop button + the canvas has a context menu now (to reload the actual picture from file) + the UNIX commando touch is no longer needed (using perl replacement utime) + adding a decoration is also possible in the filter dialog + the preview size in the filter dialog is adjustable + it is possible to hide some (mostly unreadable) informations in the EXIF info display + or menu: Extra->window list shows a window list of all mapivi windows + using execute (Tk::IO) instead of system + minor bug fixes 2003/06 mapivi Version 0.2.3 + the thumb table columns are now resize- and clickable (optional module Tk::ResizeButton) + there is a color chooser (optional module Tk::ColorChooser) + using better dir dialog for windows getOpenFile (choose a file to select a dir!) + using better dir dialog for windows (optional Win32::FileOp) not tested yet! + try to determine the home dir under windows not really tested yet! + there is a stop button (currently only in sub changeSizeQuality) to quit from batch processing + more options: Set the colors of the thumb table, the background of the index prints, the aspect factor + nicer layout of the status bar + display the last pic until the next pic is loaded (before there was a big gap between) + fixed bug in cleanSubDirs: the thumbs of delete pictures were not removed!!! + added aspect ratios: 7:5 and 16:9 and X:Y + fixed bug with disapearing mapivi icon + menu clean up + more key bindings in the dialogs (ESC and Ctrl-q) + new sub execute() (uses Tk::IO if possible, mapivi stays responsive) + replace german umlaute in search pattern 2003/05 mapivi Version 0.2.2 + make screenshot function (single window or desktop), needs xwd, which should be available in nearly all UNIX enviroments + gamma correction is available in the filter window + lossless cropping in any aspect ratio, size and offset, needs jpregtran with crop patch, trys to be intelligent when cropping several pictures of different sizes + removed the old crop functions + use a picture as root background (only with X11 at the moment, needs wmsetbg) + resorted some menu entries + using two more (optional) backend progs: xwd and wmsetbg + bug fixes 2003/05 mapivi Version 0.2.1 + minor improvements (rename backup- and non-JPEG-pics) + some bug fixes + code cleanup + menu cleanup + new key bindings (e.g. Key-R) 2003/05 mapivi Version 0.2.0 + it's time to switch to 0.2.0!!! 2003/05 mapivi Version 0.1.55 + new: slideshow + new default colors (gray) + display actual date in a balloon over the clock + more key bindings + display backup info [bak] in size column + add a decoration to pics: border and/or a copyright info (text or picture), also available in the make HTML window + join multiple JPEG comments to one (some progs are only able to display the first one) + trim option for jpegtran to avoid border strip (optional) + copy, move, delete, rename non-JPEG and backup files + more screen friendly layout of the filter window + added a JPEG quality scale in the make index window 2003/05 mapivi Version 0.1.54 + ask only once per session and directory to convert non JPEGS + bugfixes (delete hash keys instead of undef ing them) + replacing newlines with spaces in the database for better search results + lossless automatic image rotation using the EXIF Orientation Tag + added a dialog to sub cleanDatabase() to select the ignore paths + new option in the search window: search only complete words 2003/05 mapivi Version 0.1.53 + display the aspect ratio of an image (currently only 4:3 and 3:2) + select all backup files (menu) + new sort type: random + show the new size after rotating a picture + lossless cropping to 3:2 format with preview (needs patched jpegtran) + improved change size/quality with pic-to-email preset and backup option 2003/04 mapivi Version 0.1.52 + code cleanup + improved search functionality: - search in comments, EXIF and IPTC info - different search modes (String, And, Or) - windows like search pattern (with ? and *) - read in meta infos of several directories at once (build database) - better memory handling - better dialog, more balloon help 2003/04 mapivi Version 0.1.51 + code cleanup + more comments + improved clearDirInfo(): ignore certain paths (for removable media) + improved search dialog 2003/04 mapivi Version 0.1.50 + case sensitive/insensitive search + improved list of search results with thumbnails, name, comment + search dialog: open dir, jump to picture on left button press 2003/04 mapivi Version 0.1.49 + show a balloon info with comment, EXIF, etc over the actual picture (optional) + search meta info searches the file names too (optional) + new key Ctrl-s (search meta info) + automatic PlugIn installation + removing of outdated saved EXIF infos + nicer, more colorful thumbnail table using item styles + improved handling of non-JPEGs + a picture with saved EXIF info will be marked with [s] in the exif column + better info when restoring EXIF infos + function to remove the saved EXIF info files + function to clean the dir info (comments of all pictures, cleanDirInfo()) + minor improvements 2003/04 mapivi Version 0.1.48 + new context menu in the directory tree frame showing a two list: - the most often visited directories (quick list) - the history of the last visited directories + new option to check for non JPEG pictures with an automatic conversion to JPEG + the number of non JPEG files is displayed on the right side of the actual direcrory there is a button labeled i to display infos (name and size) about them + more and changed key bindings + after an update, delete or resort the actual picture is displayed again + better navigation in the dir tree (trying to show all sub dirs when opening a dir) + slightly improved IPTC display + possibilty to insert a complete file in the JPEG comment + simple plugin interface see menu PlugIns and Help->Tips 2003/03 mapivi Version 0.1.47 + internal change: using Adjuster instead of packAdjust + crop picture (this is experimental stuff, still problems when zooming) + some new keys: f, F5 see menu Help->Keys + do not show a picture if the canvas is very small + improved IPTC info display (more infos in the thumbnail view) + user info when sorting pictures + sorting pictures by camera model + improved EXIF info display, better and more infos (contrast, white balance, metering, ...) + export IPTC info to a XML file + editing IPTC infos of multiple pictures + new menu Help->Tips + improved zooming 2003/02 mapivi Version 0.1.46 + removed the program combine from exprogs hash + new option: add or remove the EXIF infos in the html pictures + new option: ask before making a dir + new option: warn before resize + new function: removeFile() + display the picture size in megapixel (mp) + code cleanup + EXIF: display the focal length in 35mm film if available + EXIF: shorter display of various cameras and program modes + some experimental stuff with the layout: try key-l 2003/02 mapivi Version 0.1.45 + new key bindings a, z, Ctrl-e see menu->help->keys + EXIF data display: do not display unprintable data (e.g in Makernote) + new functions: EXIF save, EXIF restore + new function: edit in GIMP (EXIF data will be saved first) + new function: make index print (see Extra menu) + add IPTC info (optional) when building web pages + the add EXIF and Comment switches in the web page dialog really work + new page in the options dialog + some bug fixes 2003/02 mapivi Version 0.1.44 + sort reverse + export a file list of the selected pictures in the displayed order + code cleanup + build thumbs recursive works again + better display of IPTC infos + works for multiple pictures now + make dir with (appropriate) permissions + deletePics ask to rename the backup file (if available) + filterPic is able to process multiple files (with the first as preview) so batch conversion is possible 2003/02 mapivi Version 0.1.43 + more information is saved (directories, filters, comments) + added some options in the options dialog (colors for mapivi window, show clock, ...) + added a thumbnail preview and some options in the options->thumbnail dialog + german umlaute in picture comments are replaced for better portability + optional clock in the status bar + the filter function has much more options now (sharpness, brightness, saturation, hue, filters) and a double preview (a part of the picture in 100% zoom and the thumbnail) + code cleanup, using new subs: getAllSizeInfo, showText, mycopy + the showEXIFthumb function now accepts more than one picture at once + removed seperation of comments in showComments + added License and History in the Help-menu + better user information while executing background commands (= show a busy mouse pointer :) 2003/01 mapivi Version 0.1.42 + insert the file name in the comment (usefull bevore renaming) + code cleanup + some new subs for common used functions (e.g. getRealFile, checkLinks) + removed setJPEGComment now using addComment + jump to the right picture after deleting and making a backup file 2003/01 mapivi Version 0.1.41 + adjustments to run under Windows 2003/01 mapivi Version 0.1.40 + Max trash size - show a warning if trash is full + pixel per byte as a indicator of the compressing ratio + Picture buttons in the main window + user info while loadingthumbnails every 0.5 seconds + new sort criterias: Number of pixels and pixel per byte + the text dialog can be closed with Control-x + menu adjustments + remove unknown keys in the config file + better info when building web pages 2003/01 mapivi Version 0.1.39 + search in picture comments of all dirs visited + copy comments from one picture to another + more info (comments and thumbnail) when copying EXIF info + autozoom to fit big pictures into the window + use embedded EXIF thumbnails as mapivi thumbnails + more options for the generation of web albums + the web dialogs now open on the right place + more configuration options + new menu help-keys to show all key bindings + popup help for nearly all configs in the options dialog + more logical layout in the options dialog + code cleanup 2002/12 mapivi Version 0.1.38 + myEntryDialog can display a optional Picture (e.g. the picture to rename) + mapivi is now able to export a html web page of the selected pictures the web pages can contain the JPEG comments and the EXIF data most of the subs are taken from mapiwe (Martins pictures to Web) + option dialog has a new layout 2002/12 mapivi Version 0.1.37 + configurable file name format when renaming to EXIF date + display the number of selected pictures + mapivi is much faster now because we alter the thumbnail list direct and do not reread all infos + piclist is only used at startup, using infos from the thumbnail list instead + displaying the picture width and height in the thumbnail list + sort pictures by: EXIF-date, -aperture, -exposure time + code cleanup 2002/12 mapivi Version 0.1.36 + key binding r for renamePic + subs getSize and getFileSize + intelligent file name selection in myEntryDialog + sub applyFilter to do some image manipulation + rebuildThumbs, renamePic and deletePics are much faster, because update thumbs is not called anymore + renamePic checks for the right suffix + using Tk methodes FullScreen and packPropagate instead of geometry 2002/10 mapivi Version 0.1.34 + delete to trash + show/hide hidden directories c ignore empty files + check always before using a extern program + make backup c move thumbs only if move was successfull 2002/10 mapivi Version 0.1.33 c using DateTimeOriginal instead of DateTime because this seems to be more accurate + remove of EXIF thumbs possible + change the EXIF date/time stamp 2002/10 mapivi Version 0.1.32 + copyright notice at startup c rework in getEXIFThumb + sub showEXIFThumb + key t to show embedded thumbnail + sub copyEXIFData 2002/10 mapivi Version 0.1.31 + Menu Help->system info: show which external progs are available + Menu Options: adjustable font size c default number of background jobs limited to 1 + Menu Options: show thumbs / default thumbs + Menu Options: show/hide EXIF/Comment frame in picture view + sub checkGeometry: helps avoiding crahses when the screen size changes + sub checkAdjusterGeometry: helps avoiding crazy layouts + information about the number of thumbnails to generate + more key bindings (see menu, or try the keys C,E,I,S,Enter) + mapivi now installs itself, simply start it with > perl mapivi . it will set the first line, create the config dir and copy the the needed files c better handling of long time exposures > 1 sec c better display of Bias value + Menu: Edit->EXIF->remove EXIF date + Menu: Edit->EXIF->extract EXIF thumbnail + Menu: View->open picture in own new window c sub toggleHeaders adjusts the width of the columns: fast switching between display modes c rebuild thumbs works only on the selected pictures now + Menu Edit->change size/quality: alter the size and/or the quality (and file size) of a picture mapivi version 0.1.30 date: 2002/10 solved newline probleme in JPEG comment (sub formatString) EXIF data: using ApertureValue if FNumber is not available EXIF data: corrct display of exposure times longer than 1 second EXIF data: using ShutterSpeedValue if ExposureTime is not available sub displayEXIFData works for multiple pictures now new: sub showComment to show JPEG comments of (multiple) pictures mapivi version 0.1.29 date: 2002/10 mapivi saves the last opened dir for the next start possibilty to select a font (in the perl file) for all widgets When the window is closed, quitMain gets called before exit support of JPEG suffix .jpg and .jpeg (added by Hans-Peter Rangol) layout changes in some windows (e.g. close button moved up) for a better support of small displays new: function change Quality (added by Hans-Peter Rangol) new: showPicInOwnWin shows the next picture of a dir by pressing the space key (q and ESC to close) mapivi version 0.1.28 date: 2002/10 It is now possible to sort the pictures by name, size or date Added maker and model of the photo to the EXIF description edit and remove JPEG comment now work for multiple pictures at once new function: make dir more concise context menu (with cascade menues) mapivi version 0.1.27 date: 2002/10 progress bar moved to another place minor code cleanup mapivi version 0.1.26 date: 2002/09 MaxPreloadPics is now configurable use of DateTimeOriginal if the other EXIF dates are not valid rename to EXIF date uses the file date if no EXIF dates available formate the comments in the balloon to a line length of 70 chars more infos in the help->About mapivi version 0.1.25 date: 2002/09 added a menu bar added a Help->About added a configuration dialog (Options) removed the Time::Hires stuff all functions can now be activiated via the menues it possible to add/edit the IPTC/IIM information of a JPEG pic added a confirmation dialog to rebuildThumbs() the JPEG comment is cutted down to 800 chars in the balloon output mapivi version 0.1.24 date: 2002/09 The IPTC comments now have a nicer layout The thumbnail view is now formated in about 4 lines to suppress a too wide layout new function formatString for a short 4 line output of comments in the thumbnail view The EXIF data is now displayed in more detail, mapivi can now handle arrays and arrays of arrays and arrays of hashes comments can now contain double quotes bugfix: it was possible to overwrite an existing file, when renaming an other file some small bugfixes and improvements mapivi version 0.1.23 date: 2002/09 added a dirtree to the main window handling (save, load) of multi column comments some little bugfixes and improvements mapivi version 0.1.22 date: 2002/09 it is now possible to view the IPTC comments of a picture the caption/abstract is displayed in the thumbnail view and the full IPTC comment can be displayed in a window mapivi version 0.1.21 date: 2002/08 the comment and EXIF columns are now optional (see menu) Delete key to remove the selected pictures Bugfix: no wrong display of thumbnails when background processes are still running when changing to another dir new: the EXIF display and rename is now more robust (if now DateTime available, it will use DateTimeDigitized, ...) removed the eval calls in getShortEXIFData, which makes everything a bit saver new sub touch() bugfix: after deleting a picture the next pic is shown (not the first in the dir like before) mapivi version 0.1.20 date: 2002/08 chnaged the default config (showPic and preloadPic are now on) removed a print statement mapivi version 0.1.19 date: 2002/08 moved the gifs to /home/herrmann/.maprogs/mapivi switched from DirSelect to Tk::DirTree mapivi version 0.1.18 date: 2002/08 some little changes in the description new sub firstStart() mapivi version 0.1.17 date: 2002/08 bugfix: added hash to store all thumb photo object they are now all deleted when we open a new dir mapivi version 0.1.16 date: 2002/08 added lossless rotation with jpegtran mapivi version 0.1.15 date: 2002/08 show multiple pictures each in one window with balloon info (double-click) Some more key shortcuts Display if files are links in the thumbnail view new menu order mapivi version 0.1.14 date: 2002/08 snapshot a lot of nice things are working now edit multiple comments save geometry and adjuster position etc. mapivi version 0.1.13 date: 2002/08 added global config hash with save and load to file function it is now possible to start mapivi without a file or dir mapivi version 0.1.12 date: 2002/08 remove all comments rename to EXIF date mapivi version 0.1.11 date: 2002/08 new colors and thumb background pic looks pretty nice now! :) some bug fixes some new features mapivi version 0.1.10 date: 2002/08 zoom functionality (first test) rebuild thumbs add comment to multiple pictures etc mapivi version 0.1.9 date: 2002/07 handling of links in some functions not finished yet mapivi version 0.1.8 date: 2002/07 mapivi version 0.1.7 date: 2002/06 icon buttons show/do not show pics more comments in the code some clean up mapivi version 0.1.6 date: 2002/06 added a pod for perldoc mapivi version 0.1.5 date: 2002/06 works with time measurement and memory freeing for pics (not for thumbs by now) mapivi version 0.1.4 date: 2002/06 just a checkin mapivi version 0.1.3 date: 2002/06 a lot of changes mapivi version 0.1.2 date: 2002/05 with thumbnail display list mapivi version 0.1.1 date: 2002/05 Initial revision mapivi097/Tips.txt0000755000175000017500000001466410523255575014520 0ustar herrmannherrmann Here you will find various tips about mapivi and picture processing (last update: 04.11.2006) View a picture Whenever you see a thumbnail of a picture (main window, search window, ...) you may use the middle mouse button to open it in a new window. Just click on the picture to close the window. (If you use the middle mouse button in the directory tree a new window containing all pictures in thumbnail size will pop up.) Functions/Menues All functions of mapivi may be accessed via the menues. Some have also shortcuts (keys). All menus start with a dotted line. If you select this line you are able to place and use the menu anywhere on the desktop. A lot of the functions are also accessable via context menus: press the right mouse button while the mouse is e.g. on a thumbnail, picture or directory to activate it. There is also a context menu other windows and frames e.g. in the right directory frame (also activated with the right mouse button). It contains a list of the most used directories (hotlist) and a list of the last used directories (history list). Release the right mouse button over a directory to open it. Selection To select one picture, simply click on it in the thumbnail frame. To select several pictures, try one of this: 1. Press the left mouse button over a thumbnail and keep holding it down, now move up or down to select more pictures. 2. Click on one thumbnail, scroll up or down and press SHIFT and click again on a thumbnail -> all thumbnails between the two will also be selected. 3. Click on one thumbnail, press and hold the CTRL key and click on several other thumbnails, just the clicked thumbnails are selected. 4. Press CTRL-A to select all thumbnails and remove some of this selection by pressing CTRL and left mouse button together. 5. Use "select all backups" or "invert selection" from the context menu. Most of the functions of Mapivi will work with a single selection as well with a selection set. Layout You can move the adjusters (the vertical lines with a blob at the lower end between the frames) with your mouse pointer (while pressing the left mouse button). If drag is done with Shift button down, then the changes are made in "real time" so that text-flow effects can be seen. Try the l-Key to toggle between some predefined layouts. The keys F1 - F4 toggle some bars and info boxes. The keys F6 - F10 can be used to switch to a certain predefined layout (I recommend F7 to choose a new directory, F8 to view the thumbnails with meta info and F9 to view the pictures with a small thumbnail column at the left. Picture processing Unlike other picture editors (like e.g. The GIMP) there is no "Save" or "Save as" function. That's because Mapivi manipulates the files directly, not just the copy of the picture in the RAM. So be careful and always use the "Create backup" option. So you have at least one Undo-Level. If you delete a picture and a backup file is available, Mapivi will ask to rename the backup file. Picture compression and size To take a picture with a digital camera I recommend to use this camera settings: JPEG higest resolution and best quality or RAW/TIFF format (RAW can not be displayed by mapivi, sorry!). While processing the image with e.g. The GIMP I recomment using the lossless file format like XCF (which preserves layers and even undo information!) or TIFF if you have to save the results in-between. If your Input is JPEG, your Output is JPEG and you are going to edit the picture in one step there is no need to save it in a lossless format (like TIFF or PNG). To archive a picture in JPEG format I am using 95% Quality (more just increases the file size, not the quality). To present a picture on a web site or to send it via email use a resolution eqal or less than 1000x800 and a quality of about 80%. This should end up in a handy file size of less than 200kB. PlugIns Since mapivi V0.1.48 there is a simple PlugIns interface. A PlugIn is any executable program (written in C or Perl or ...) which can handle command line options. Mapivi will call the plugin with a list of all selected file names (all with full path) as arguments (hint: Mapivi versions < 0.7.5 used other arguments). The PlugIn will be accessible within mapivi if the executable is copied to the PlugIns directory in the mapivi config directory (usually: ~/.maprogs/mapivi/PlugIns). In this directory there also has to be another file with the same file name but the suffix ".txt". This is a simple ASCII file containing 4 informations needed from mapivi: 1. the file name of the PlugIn (string) 2. the menu entry text (string) 3. does mapivi need to update the displayed pictures after the execution (boolean) 4. a short description of the PlugIn (about 10-15 words) (string). The informations have to be seperated with this string: " + " (space plus space). This is an example: filelist-plugin + write file list + 0 + this plugin will write the names of all selected pictures to a file Table display The symbol [s] in the EXIF column means, that a backup of the picture EXIF data is stored. The symbol [t] in the EXIF column means, that an EXIF thumbnail is available The symbol [bak] in the size column means, that a backup of the picture exists. The symbol [x:y] in the size column means, that the aspect ratio of the picture is x/y. MP means mega pixels - the resolution of the picture in mega pixel(width x height) b/p means bit per pixel - picture compression: a higher value means better quality Working fast Some examples: Add keywords to several pictures: Select all pictures in a folder showing your dog (see Selection above) - open keyword window, double click on your dogs name Add a copyright notice to the comments of all pictures in the current directory: - selects all pictures - add a comment - insert copyright (or press the button or type it) - close window and write the copyright info Rename the selected pictures according to their EXIF date picture P2011.JPG will be renamed to e.g. 20030612-120303.jpg = - rename to EXIF date - accept the name format Fullscreen mode To toggle the fullscreen mode on and off use key . To the get rid of the window border, open the options dialog , go to the Advanced pad and enable "Remove the window border in fullscreen mode". Try it, it may not work on all operating systems and all window managers. If you discover some problems disable the option. Drop me an email if something is not working as expected. Martin Herrmann mapivi097/mapivi0000755000175000017500000412603210757362330014242 0ustar herrmannherrmann#!/usr/bin/perl # the line above could be the first line for a typical UNIX systems # you can find perl on your system by using "which perl" in the shell # to build an exectuable for windows use this PAR call: # pp -M Tk::DragDrop::Win32Site -o mapivi.exe mapivi # to build an exectuable for Linux use this PAR call: # pp -M Tk::DragDrop::XDNDSite -M Tk::DragDrop::SunSite -M PerlIO -o mapivi.exe mapivi # include perl packages use strict; use Encode::Unicode; # needed according to the PAR FAQ (for perl apps on Microsoft Windows) use warnings; #use diagnostics; # pod (to view the formated document try "perldoc mapivi" in the shell =head1 NAME MaPiVi - Picture Viewer and Organizer MaPiVi means Martin's Picture Viewer =head1 DESCRIPTION JPEG picture viewer / image management system with meta info support written in Perl/Tk for UNIX, Mac OS X and Windows. I wrote mapivi just for me, because I needed a image viewer which is also able to display and edit meta infos of JPEG pictures, like EXIF, JPEG comments and IPTC/IIM infos. As hobby photographer I am mostly interested in the EXIF infos (like timestamp, camera model, focal length, exposure time, aperture, etc.) and the possibility to add and edit IPTC infos and JPEG comments. But I also want to rename pictures according to their internal date/time and to do lossless rotation, lossless cropping and other stuff. mapivi can be found here: http://mapivi.de.vu (link to the mapivi site) or if this won't work: http://herrmanns-stern.de (real site) http://sourceforge.net/projects/mapivi (download) I would be happy to receive some feedback (e.g. on which os mapivi works), bugfixes, patches or suggestions about mapivi. Copyright (c) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Martin Herrmann All rights reserved. Feel free to redistribute. Enjoy! =head1 USAGE mapivi [-i ] [file|folder] to display a certain picture use: mapivi picture.jpg mapivi will generate and display all pictures in the folder as thumbnails. The given picture will be displayed in original size or zoomed to fit the window (picture frame). to view a folder containing pictures use: mapivi ~/pics/ mapivi will generate and display all pictures in the given folder as thumbnails. to start mapivi with the import wizard mapivi -i =head1 KEYS mapivi is controlled by the following keys: see also menu Help->Keys (the list is generated from the source code and is always actual.) =over 4 =item Space, Page-Down Show the next picture in folder =item BackSpace, Page-Up Show the previous picture in folder =item Escape Iconify MaPiVi (Boss-Key :) =item Cursor-up, -down, -left, -right Scroll the picture, if it's bigger than the Canvas =item Shift-Cursor-up, -down, -left, -right Move to the border of the picture, if it's bigger than the Canvas =item q Quit MaPiVi For all other key bindings, see the menu Help->Keys =back =head1 MOUSE Try the right mouse button in the thumbnail picture list for a popup menu to copy, move, rename, rotate or delete pictures, to open a new folder, to add or remove comments or to exit MaPiVi. Use the buttons to add, edit or remove JPG comments, or to display all EXIF infos. If you hold the mouse over the buttons or labels a help message will pop up (or at least at most of them :). =cut # boolean, if we run on Windows this variable is set to 1 my $EvilOS = 0; $EvilOS = 1 if ($^O =~ m/win/i); my $MacOSX = 0; # boolean, if we run on Mac OS X this is 1 if ($^O =~ m/darwin/i) { # Mac OS X is not evil, but unfortunately contains the string "win"! $MacOSX = 1; $EvilOS = 0; } my $home = glob("~"); use Env; if ($EvilOS) { $home = $ENV{HOME} if defined $ENV{HOME}; $home = $ENV{HOMEDRIVE}.$ENV{HOMEPATH} if (!-d $home and (defined $ENV{HOMEDRIVE} and defined $ENV{HOMEPATH})); $home = "C:/" if (!-d $home); die "mapivi can not find a home dir" if (!-d $home); } my $maprogsdir = "$home/.maprogs"; # the main config dir for my programms if (($EvilOS) and (defined $ENV{APPDATA}) and ($maprogsdir ne $ENV{APPDATA}."/maprogs")) { # migration from the old config dir to the new only for windows if (-d "$maprogsdir/mapivi") { my $olddir = "$maprogsdir/mapivi"; my $newdir = $ENV{APPDATA}."/maprogs/mapivi"; warn "\nMapivi 0.3.6: Error!\n\nYou still have the old Mapivi config folder:\n$olddir,\n\n1) please create a new folder for the configuration here:\n $newdir,\n2) copy all folders and files from the old folder to the new one\n3) delete the old folder and then\n4) restart Mapivi.\n\nKindly excuse this inconvenience! (will exit in 30 seconds)\n"; sleep 30; exit; } } # for windows we use this path $maprogsdir = $ENV{APPDATA}."/maprogs" if defined $ENV{APPDATA}; my $configdir = "$maprogsdir/mapivi"; # the configuration dir my $icon_path = "$configdir/icons"; # the icon dir my $splashAvail = (eval "require Tk::Splash") ? 1 : 0 ; my $splash; my $logo = "$configdir/logo.jpg"; if ($splashAvail and -f $logo) { # Splash->Show parameters: $image, $width, $height, $title, $overrideredirect $splash = Tk::Splash->Show($logo, 844, 259, "", 1); } use File::Basename; use POSIX qw(ceil); use Cwd qw(cwd abs_path); my $verbose = 0; # boolean (1 = print debug infos, 0 = be quiet) # get version from RCS version my @RCSVersion = split / /, '$Revision: 9.7 $'; my $version = "0.".$RCSVersion[1]; $main::VERSION = $version; my $mapiviInfo = "mapivi"; showCopyright(); #use Encode qw(is_utf8 encode decode); use Encode; #use encoding "utf8" #use utf8; use Getopt::Std; our($opt_i); $Getopt::Std::STANDARD_HELP_VERSION = 1; use File::Copy; use File::Find; use File::Path; # for rmtree, mkpath use Text::Wrap; use Tk; use Tk::JPEG; use Tk::PNG; use Tk::HList; use Tk::ItemStyle; use Tk::ROText; use Tk::ProgressBar; use Tk::IO; use Tk::ErrorDialog; use Tk::Balloon; use Tk::DirTree; use Tk::Font; use Tk::Pane; use Tk::Tiler; use Tk::NoteBook; use Tk::FileSelect; use Image::Info qw(image_info dim); use Storable qw(nstore retrieve dclone); use Tk::Adjuster; use Tk::DragDrop; use Tk::DropSite; use Tk::Compound; # for icons in the menues #use Image::ExifTool; # this will be used in future to provide a multilanguage mapivi # keywords: i18n, gettext #use Locale::TextDomain ('mapivi', $configdir."/locale"); #use POSIX qw(locale_h); #setlocale (LC_MESSAGES, ''); use Image::MetaData::JPEG; # disable warnings from this module $Image::MetaData::JPEG::show_warnings = 0; # todo: use metadatawarn to switch this my $metadataVersionNeeded = 0.14; my $metadataVersion = $Image::MetaData::JPEG::VERSION; $metadataVersion =~ s/[a-zA-Z]//g; die "Aborting, because Mapivi needs at least version $metadataVersionNeeded of perl module Image::MetaData::JPEG!\n(installed version: $metadataVersion)\n" if ($metadataVersion < $metadataVersionNeeded); use Time::Local; # timelocal() #use Tk::Date; # not in the Tk distro # This should prevent opening DOS boxes on windows when doing background tasks, but does not work. ToDo #my $win32Avail = (eval "require Win32") ? 1 : 0; #SetChildShowWindow() if ($EvilOS and $win32Avail); # optional modules # seems not to work so I comment it out for a future test #my $win32FOAvail = (eval "require Win32::FileOp") ? 1 : 0; my $win32FOAvail = 0; my $exiftoolAvail = (eval "require Image::ExifTool") ? 1 : 0; my $resizeAvail = (eval "require Tk::ResizeButton") ? 1 : 0; my $filespecAvail = (eval "require File::Spec") ? 1 : 0; use constant Win32ProcAvail => eval { require Win32::Process; 1 }; use constant MatchEntryAvail => eval { require Tk::MatchEntry; 1 }; #use Time::HiRes qw(gettimeofday tv_interval); # needed just for debugging #my $hiresstart; # constants use constant WITH_PATH => 1; use constant JUST_FILE => 0; use constant LONG => 1; use constant SHORT => 0; use constant WRAP => 1; use constant NO_WRAP => 0; use constant FORMAT => 1; use constant NO_FORMAT => 0; use constant NUMERIC => 1; use constant STRING => 0; use constant WAIT => 1; use constant NO_WAIT => 0; use constant TOUCH => 1; use constant NO_TOUCH => 0; use constant OVERWRITE => 1; use constant ASK_OVERWRITE => 0; use constant ASK => 1; use constant NO_ASK => 0; use constant PREVIEW => 1; use constant NO_PREVIEW => 0; use constant SHOW => 1; use constant NO_SHOW => 0; use constant COPY => 0; use constant BACKUP => 1; use constant TRASH => 0; use constant REMOVE => 1; use constant OK => 1; use constant CANCEL => 0; use constant ADD => 1; use constant RESET => 0; use constant PIXEL => 0; use constant ASPECT_RATIO => 1; use constant RELATIVE => 2; use constant SINGLE => 0; use constant MULTIPLE => 1; use constant COPY => 0; use constant MOVE => 1; use constant RENAME => 2; # function prototypes sub progressWinInit($$); sub progressWinCheck($); sub progressWinUpdate($$$$); sub progressWinEnd($); sub updateOneRow($$); sub insertPic($$$); sub checkDateFormat($); sub checkGeometry($); sub checkTempFile($); sub checkWriteable($); sub getRealFile($); sub getThumbFileName($); sub addComment($); sub addCommentToPic($$$); sub buildBackupName($); sub makeBackup($); sub getIPTCByLine($); sub doubleList($$$$); sub overwrite($$); sub copyPicsDialog($$); sub getDirDialog($); sub is_a_JPEG($); sub setProperty($$$); sub formatString($$$); # globals my @dirHist; # folder history - stores the last folders visited my @cachedPics; # a list of all cached pictures my @savedselection; my @savedselection2; # search database: hash to store all the data of all pictures in the visited folders (comments, EXIF, IPTC) my %searchDB; # folder checklist: hash to store properties of folders (key: dir value: hash SORT, META, PRIO, COMM) my %dirProperties; # hash to store all loaded photo objects (real size or zoomed) key = path/file name, value = photo object my %photos; # hash to store all loaded thumbnail photo objects key = path/file name, value = photo object my %thumbs; my %searchthumbs;# hash containing all thumbnails of the search dialog, for memory clean up my %light_table_thumbs;# hash containing all thumbnails of the light table, for memory clean up my %thumbDBhash; # store the thumb dirs for one session: dir -> thumbdir my %dirHotlist; # often visited dirs # minimum set of the hot dirs foreach my $dir ("/", $home, cwd()) { $dirHotlist{$dir} = 1 unless (defined $dirHotlist{$dir}); } my %quickSortHash; my %quickSortHashSize; my %quickSortHashPixel; my %quickSortHashBitsPixel; my $quickSortSwitch = 0; my $actpic = ""; # the path and file name of the actual picture my $actdir = ""; # the actual folder my $widthheight = ""; my $loadtime = ""; my $size = ""; my $zoomFactorStr = ""; my $urgencyStr = "-"; my $urgencyScale = 0; my $nrof = ""; my $exif = ""; my $userinfo = ""; my $otherFiles = ""; my $proccount = 0; my $nrToConvert = 0; my $maxCommentLength = 2**16 - 3; # a comment block may have max 64kB my $trashdir = "$configdir/trash"; # the trashcan my $plugindir = "$configdir/PlugIns"; # the mapivi plugin dir my $iptcdir = "$configdir/IPTC_templates"; # the IPTC templates folder my $configFile = "$configdir/mapivirc"; # the configuration file my $file_Entry_values = "$configdir/Entry_values"; my $exifdirname = ".exif"; # the subdir to store exif infos my $thumbdirname = ".thumbs"; # the subdir to store thumbnails my $xvpicsdirname = ".xvpics"; # a subdir from GIMP we usualy ignore my $thumbExample = "$configdir/thumbExample.jpg"; my $nonJPEGsuffixes = "gif|png|tif|tiff|bmp|ppm|ps"; # xcf works, but makes problems with layers my $cameraJunkSuffixes = "ctg"; # uninteresting files created by cameras my $copyright_year = (localtime(time()))[5] + 1900; # the actual year, for the copyright notice my $HTMLPicDir = "pics"; # this is the name of the subdir for pics when building html pages my $HTMLThumbDir = "thumbs"; # this is the name of the subdir for thumbs when building HTML pages my $slideshow = 0; # start/stop flag for slideshow my $showPicInAction = 0; # bool = 1 while loading picture my $mapiviURL = "http://mapivi.de.vu"; my %topFullSceenConf; my $topFullScreen = 0; my %winapps; # used for sub findApp() my $defaultthumbP; my $clocktimer; my $time; my $date; my $clockL; my $scsw; my $wizW; my $impW; my $interpW; my $fuzzybw; # fuzzy border dialod window my $ll_b_w; # lossless border dialog window my $ll_r_w; # lossless relative border dialog window my $ll_a_w; # lossless aspect ratio border dialog window my $ll_w_w; # lossless watermark dialog window my $bpw; # border preview window my $ow; # options window, see sub options() my $sw; # the search window, see searchMetaInfo() my $dpw; # the dir properties window, see showDirProperties() my $dsw; # the dir size window my $ltw; # the light table window for slideshows my @light_table_list; # the light table slideshow pic list my $ddw; # dirDiffWindow widget my $catw; # the IPTC categories window, see editIPTCCategories() my $keyw; # the IPTC keywords window, see editIPTCKeywords() my $locw; # the location window, see search_by_location() my $keycw; # the comment keywords window, see editCommentKeywords() my $dupw; # the duplicate search window, see sub finddups() my $filterW; # the filter window my $menubar; # handle for menubar of main window my $balloon; # balloon handle my $dirMenu; # context menu for dirs my $thumbMenu; # context menu for thumbnails my $picMenu; # context menu for picture my $copyEXIFDataSource; # global variable of sub copyEXIFData() my $copyCommentSource; # global variable of sub copyComment() my $iptcCopy; # global hash ref for copyIPTC() my ($idx, $idy); # coordinates of actual item when clicked on or moved my ($width, $height); my %nonJPEGdirNoAskAgain; # hash to store the dirs with non-JPEG files not to convert (valid for one session) #my $stopButStop = 0; # stop actual action if 1 my $cleanDirNoAsk = 0; # needed in sub cleanDir() my $cleanDirLevel = 0; # needed in sub cleanDir() my $keyXBut; # close button of IPTC keyword window # some example hierarchical categories my @precats = sort qw(Nature Nature/Flower Nature/Landscape Nature/Macro Nature/Animal Nature/Animal/Fish Nature/Animal/Cat Nature/Animal/Insect Nature/Animal/Insect/Ant People People/Portrait People/Wedding Architecture Architecture/Tower Architecture/Bridge Architecture/Church Technology Technology/Car Technology/Train Technology/Computer); # overwrite them, when some stored categories are available @precats = readArrayFromFile("$configdir/categories") if (-f "$configdir/categories"); uniqueArray(\@precats); # remove double entries foreach (@precats) { $_ =~ s|^/||; } # cut leading slash @precats = qw(Nature) unless (@precats); # add a starting point if array is empty # some example hierarchical keywords my @prekeys = qw(Family Family/Einstein Family/Einstein/Albert Family/Einstein/Hermann Family/Einstein/Pauline Family/Planck Family/Planck/Max Family/Planck/Johann Family/Planck/Marie Family/Planck/Karl Family/Planck/Grete Family/Planck/Emma Family/Planck/Erwin Family/Planck/Hermann Friend Friend/Bundy Friend/Bundy/Al Friend/Bundy/Bud Friend/Bundy/Kelly Friend/Bundy/Peggy); # overwrite them, when some stored keywords are available @prekeys = readArrayFromFile("$configdir/keywords") if (-f "$configdir/keywords"); uniqueArray(\@prekeys); # remove double entries foreach (@prekeys) { $_ =~ s|^/||; } # cut leading slash @prekeys = qw(Family) unless (@prekeys); # add a starting point if array is empty # global hash for new keywords found in displayed pictures my %new_keywords; # global hash to store keywords, which should be ignored (e.g. nature.animal.dog) my %ignore_keywords; # external programs used by mapivi my %exprogs = qw/convert 0 composite 0 jhead 0 jpegtran 0 jpegpixi 0 mogrify 0 gimp-remote 0 gimp-win-remote 0 montage 0 xwd 0 identify 0 thunderbird 0 mozilla-thunderbird 0 exiftool 0/; # short comment about the usage of the external programs my %exprogscom = ( "convert" => "build thumbnails", "composite" => "combine pictures e.g. thumbnails with a background", "jhead" => "handle EXIF infos and embedded thumbnail pictures", "jpegtran" => "do lossless rotation of pictures", "jpegpixi" => "do nearly lossless interpolation (remove dead pixels)", "mogrify" => "change the size/quality of pictures", "montage" => "combine pictures to e.g. index prints", "gimp-remote" => "edit pictures with The GIMP (only UNIX)", "gimp-win-remote"=> "edit pictures with The GIMP (only windows)", "xwd" => "make a screenshot of a window or desktop", "identify" => "describe the format and characteristics of a picture", "thunderbird" => "send pictures via email", "mozilla-thunderbird" => "send pictures via email", "exiftool" => "Read/write meta information in image files", ); # where to find the external programs (resources) my %exprogsres = ( "convert" => "Image Magick http://www.imagemagick.org", "composite" => "Image Magick http://www.imagemagick.org", "jhead" => "http://www.sentex.net/~mwandel/jhead/", "jpegtran" => "libjpeg http://www.ijg.org", "jpegpixi" => "http://www.zero-based.org/software/jpegpixi/", "mogrify" => "Image Magick http://www.imagemagick.org", "montage" => "Image Magick http://www.imagemagick.org", "gimp-remote" => "The GIMP http://www.gimp.org", "gimp-win-remote"=> "gimp-win-remote http://sourceforge.net/projects/gimp-win-remote/", "identify" => "Image Magick http://www.imagemagick.org", "thunderbird" => "http://www.mozilla.org/projects/thunderbird/", "mozilla-thunderbird" => "http://www.mozilla.org/projects/thunderbird/", "exiftool" => "http://owl.phy.queensu.ca/~phil/exiftool/", ); # hash to replace (german) umlaute by corresponding letters my %umlaute = qw( ae Ae oe Oe ue Ue ss); my $umlaute = join "", keys(%umlaute); # stolen from Image::ExifTool (thanks to Phil Harvey) my %iptcCharset = ( "\x1b%G" => 'UTF8', # don't translate these (at least until we handle ISO 2022 shift codes) # because the sets are only designated and not invoked # "\x1b,A" => 'Latin', # G0 = ISO 8859-1 (similar to Latin1, but codes 0x80-0x9f are missing) # "\x1b-A" => 'Latin', # G1 " # "\x1b.A" => 'Latin', # G2 # "\x1b/A" => 'Latin', # G3 ); # hash to replace (german) umlaute by corresponding HTML-tags my %umlauteHTML = qw( ä Ä ö Ö ü Ü ß); my $umlauteHTML = join "", keys(%umlauteHTML); # hash to escape special HTML characters my %htmlChars = ( "<" => "<", ">" => ">", "&" => "&", "\"" => """, "'" => "'", ); my $htmlChars = join "", keys(%htmlChars); # config hash # insert here all default configurations # these configurations will be overwritten by $configFile # at startup my %config = ( "Geometry" => "790x560+1+1", # fit on a 800x600 screen "SearchGeometry" => "790x560+1+1", # fit on a 800x600 screen "KeyGeometry" => "250x500+50+50", # fit on a 800x600 screen "LocGeometry" => "250x500+50+50", # fit on a 800x600 screen "LtwGeometry" => "700x500+10+10", # fit on a 800x600 screen "FontSize" => 12, "FontFamily" => "itc avant garde", "PropFontSize" => 12, "PropFontFamily" => "helvetica", "ColorFG" => "black", "ColorBG" => "#efefef", "ColorMenuBG" => "LightGoldenrod3", "ColorMenuFG" => "black", "ColorBG2" => "#e5e5e5", "ColorBGCanvas" => "#efefef", "ColorHlBG" => "#eeeeee", "ColorActBG" => "LightGoldenrod1", "ColorEntry" => "gray90", "ColorSel" => "LightGoldenrod2", "ColorSelBut" => "red3", "ColorSelFG" => "black", "ColorName" => "black", "ColorComm" => "black", "ColorIPTC" => "black", "ColorEXIF" => "black", "ColorFile" => "black", "ColorDir" => "black", "ColorThumbBG" => "azure3", "ColorProgress" => "#106dba", "ColorPicker" => "#efefef", # last color selected with color picker "DefaultThumb" => "$configdir/EmptyThumb.jpg", "Copyright" => "copyright (c) $copyright_year Herrmann", "Comment" => "This picture was taken in south africa ...", "MaxProcs" => 1, "MaxCachedPics" => 3, "NrOfRuns" => 0, # count how often mapivi was started "ShowPic" => 1, # boolean (1 = show pic, 0 = do not show pic) "ShowThumbs" => 1, # boolean (1 = show thumbs, 0 = show default thumb) "UseDefaultThumb" => 1, # boolean (1 = show def thumb if no thumb is shown, 0 = show nothing at all) "ThumbCapt" => "none", # thumbnail caption "ThumbCaptFontSize" => 10, "ShowDirTree" => 1, # boolean (1 = show dir tree, 0 = hide) "ShowInfoFrame" => 1, # boolean (1 = show info frame, 0 = hide) "ShowThumbFrame" => 1, # boolean (1 = show thumb frame, 0 = hide) "ShowPicFrame" => 1, # boolean (1 = show pic frame, 0 = hide) "ShowComment" => 1, # boolean (1 = show comment, 0 = hide comment in thumbnail view) "ShowCommentField"=> 0, # boolean (1 = show comment, 0 = hide comment in picture view) "ShowCaptionField"=> 0, # boolean (1 = show IPTC captiob, 0 = hide caption in picture view) "ShowEXIF" => 1, # boolean (1 = show EXIF, 0 = hide EXIF in thumbnail view) "ShowEXIFField" => 0, # boolean (1 = show EXIF, 0 = hide EXIF in picture view) "ShowIPTC" => 1, # boolean (1 = show IPTC, 0 = hide IPTC in thumbnail view) "ShowFile" => 1, # boolean (1 = show Size, 0 = hide Size in thumbnail view) "ShowDirectory" => 1, # boolean (1 = show directory, 0 = hide dir in thumbnail view) "ShowMenu" => 1, # boolean (1 = show menu, 0 = hide the menu bar) "ShowHiddenDirs" => 0, # boolean (1 = show hidden dirs (starting with .), 0 = hide them) "Overrideredirect"=> 0, # boolean (1 = no window frame, 0 = window frame) "PicQuality" => 95, # quality of jpg picture (in %) "PicSharpen" => 5, # sharpness of picture "PicBlur" => 0, # blur the pictur "PicGamma" => 1.0,# gamma value of picture "PicBrightness" => 100,# Brightnes of picture (in %) "PicSaturation" => 100,# Saturation of picture (in %) "PicHue" => 100,# Hue of picture (in %) "PicStrip" => 0, # boolean (1 = strip all meta info when resizing pic) "ThumbQuality" => 85, # quality of thumbnail jpg picture "SortBy" => "name", "SortReverse" => 0, "LastDir" => $home, "FileNameFormat" => "%y%m%d-%h%M%s", # the actual file name format when renaming "FileNameFormatDef"=> "%y%m%d-%h%M%s", # the default file name format when renaming "ThumbSharpen" => 1, "ThumbSize" => 100, "ThumbBorder" => 4, "HTMLaddComment" => 1, "HTMLaddEXIF" => 1, "HTMLaddIPTC" => 1, "HTMLcols" => 2, "HTMLTargetDir" => $home, "HTMLGalleryIndex"=> "../galleries.html", "HTMLGalleryTitle"=> "My gallery", "HTMLHomepage" => "../../index.shtml", "HTMLTemplate" => "$configdir/pagetemplate.html", "HTMLFooter" => "© Martin Herrmann <Martin-Herrmann\@gmx.de>", "HTMLBGcolor" => "white", "HTMLPicSize" => 600, "HTMLPicSharpen" => 1, "HTMLPicCopyright"=> 0, # bool - add a visible copyright info into the picture "HTMLPicQuality" => 80, # quality of html jpg pictures "HTMLPicEXIF" => 1, # bool - 1 = copy the EXIF infos to the converted HTML pics "HTMLnoPicChange" => 0, # bool - 1 = no pic changes (no resize etc ...) "AutoZoom" => 1, # boolean - zoom big pictures to fill the canvas "UseEXIFThumb" => 0, # boolean - use EXIF Thumbnails if available "AskGenerateThumb"=> 1, # ask before generating thumbnails "AskDeleteThumb" => 1, # ask before deleting thumbnails "AskMakeDir" => 1, # ask before makeing a directory (e.g. .thumbs or .exif) "MaxTrashSize" => 50, # MB - a warning will appear if the trash contains more than this "BitsPixel" => 0, # boolean - show bits per pixel info "AspectRatio" => 1, # boolean - show image aspect ratio e.g. 4:3 or 3:2 "NameComment" => 0, # boolean - 1 = add file name to comment, when importing pics "NameComRmSuffix" => 1, # boolean - 1 = remove file suffix when adding filename to comment "ShowClock" => 1, # boolean - 1 = show actual time "SaveDatabase" => 1, # boolean - 1 = save dir info to a file "UseThumbShadow" => 0, "MakeBackup" => 1, # make a backup of the original file, before appling a filter "PicListFile" => "$home/filelist", "XMLFile" => "$home/IPTCinfo.xml", "saveEXIFforEdit" => 0, # save the EXIF info before editing the picture with GIMP (needed for GIMP version 1.3.15 and lower) "indexRows" => 2, # indexPrint "indexCols" => 2, # indexPrint "indexPicX" => 500, # indexPrint "indexPicY" => 500, # indexPrint "indexDisX" => 10, # indexPrint "indexDisY" => 10, # indexPrint "indexBG" => "white", # indexPrint background color "indexLabel" => 1, # indexPrint "indexLabelStr" => "%f (%wx%h, %b)", # indexPrint "WarnBeforeResize"=> 1, # warn before using mogrify in resize "ShowMoreEXIF" => 0, # show more EXIF infos: contrast sharpness saturation metering wb in thumbnail list ... "IPTCoverwrite" => 0, # overwrite IPTC attributes, when editing multiple pictures "IPTCmergeCatKey" => 1, # merge categories and keywords, when editing multiple pictures "IPTCdateEXIF" => 0, # use EXIF date as creation date "IPTCtimeEXIF" => 0, # use EXIF time as creation time "IPTCbylineEXIF" => 0, # use EXIF owner as ByLine "IPTCaddMapivi" => 0, # add Mapivi infos to IPTC "IPTC_action" => 'UPDATE', # ADD UPDATE or REPLACE "CheckForNonJPEGs"=> 0, # check if there are non JPEGs in the dir and ask to convert them "ShowPicInfo" => 1, # show a balloon info box with EXIF, comment, ... for the actual picture "SearchPattern" => "", # the search pattern "SearchExPattern" => "", # the search exclude pattern "SearchCom" => 1, # search in the picture comments "SearchExif" => 1, # search in the picture EXIF info "SearchIptc" => 1, # search in the picture IPTC info "SearchKeys" => 1, # search in the picture keywords "SearchName" => 1, # search in the picture file name "SearchDir" => 1, # search in the picture path "SearchCase" => 0, # search case sensitive "SearchWord" => 0, # 1 = search only complete words 0 = match also parts "SearchType" => 'exactly', # search type: "exactly", "all" or "any" "SearchOnlyInDir" => 0, # search only in dirs matching the actual/selected dir "SearchUrgencyOn" => 0, # search for pictures with a certain IPTC urgency level "SearchUrgency" => 0, # search only for pictures with this IPTC urgency level "SearchUrgencyRel"=> '<=',# <=, ==, >= "SearchPixelOn" => 0, # search for pictures with a certain pixel size "SearchPixel" => 0, # "SearchPixelRel" => '<=', # <=, ==, >= "SearchPopOn" => 0, # search for pic with a certain number of views "SearchPopRel" => 0, # <=, ==, >= "SearchPop" => 0, # search for pic with a certein numer of views "SearchJoin" => 0, # join comment, EXIF, IPTC and filename before searching "SearchDate" => 0, # search pics by date "SearchDateStart" => "01.01.1970", # start date "SearchDateEnd" => "25.08.2010", # end date "SearchMore" => 0, # show more search options in search window "SearchDBOnlyNew" => 0, # add only new pics when building DB "CopyPosition" => 'SouthEast', # position of the visible copyright info "CopyX" => 20, # x offset of the visible copyright info "CopyY" => 20, # Y offset of the visible copyright info "CopyAdd" => 0, # bool - add a visible copyright info "CopyFontFamily" => "Courier", # font family of the embedded copyright info "CopyFontSize" => 12, # font size of the embedded copyright info "CopyFontColFG" => "white", # foreground color of the embedded copyright info font "CopyFontColBG" => "black", # background color of the embedded copyright info font "CopyFontShadow" => 1, # bool - add a shadow to the copyright text "CopyrightLogo" => "$configdir/MapiviIcon.gif", "CopyTextOrLogo" => "text", "BorderWidth1x" => 10, # border 1 width in x direction "BorderWidth1y" => 10, # border 1 width in y direction "BorderColor1" => "white", # border 1 color "BorderWidth2x" => 0, # border 2 width in x direction "BorderWidth2y" => 0, # border 2 width in y direction "BorderColor2" => "black", # border 2 color "BorderWidth3x" => 0, # border 3 width in x direction "BorderWidth3y" => 0, # border 3 width in y direction "BorderColor3" => "white", # border 3 color "BorderWidth4x" => 0, # border 4 width in x direction "BorderWidth4y" => 0, # border 4 width in y direction "BorderColor4" => "gray80",# border 4 color "BorderAdd" => 0, # bool - add a border "DropShadow" => 0, # bool - add a drop shadow "DropShadowWidth" => 5, # the width of the drop shadow "DropShadowBlur" => 3, # the blur sigma factor of the drop shadow "DropShadowBGColor" => "white", # the background color of the drop shadow "jpegtranTrim" => 0, # bool - use the -trim switch of jpegtran "SlideShowTime" => 4, # pause between picture loading im sec "CropAspect" => 3/2, # 0 for no aspect ratio, 3/2 for 3:2 1 for 1:1 4/3 for 4:3 "CropGrid" => 1, # bool show 1/3 crop grid "AspectSloppyFactor" => 2.0, # delta factor for aspect ratio calculation in % "FilterDeco" => 0, # add a border or a text to the pictures when filtering "FilterPrevSize" => 200, # filter preview size (100% zoom crop of the picture) "EXIFshowApp" => 1, # show App*-Info and MakerNotes and ColorComponents in EXIF info "AddMapiviComment"=> 0, # add a comment to pictures created/processed by mapivi "Layout" => 0, # layout of the dir, thumb and picture frame "Layout0dirX" => 25, # default percentual width of the different layouts "Layout0thumbX" => 30, # "" "Layout1dirX" => 20, # "" "Layout3thumbX" => 20, # "" "Layout5dirX" => 20, # "" "CommentHeight" => 2, # height of the comment text frame above the picture "Gamma" => 1.0, # the gamma value, when displaying pictures "ShowFileDate" => 0, # show the file date in the size coloumn "Unsharp" => 0, # bool unsharp mask operation on/off "UnsharpRadius" => 0, # unsharp mask radius (blur) "UnsharpSigma" => 1.0, # unsharp mask sigma (blur) "UnsharpAmount" => 1.0, # unsharp mask amount "UnsharpThreshold"=> 0.05,# unsharp mask threshold "ResizeFilter" => "Lanczos", "RenameBackup" => 1, # bool, if 1 a backup file will be renamed if the file is renamed "ThumbMaxLimit" => 200, # maximum number of displayed thumbnails "Level" => 0, # level a picture "LevelBlack" => 8, # level a picture black point (%) "LevelWhite" => 92, # level a picture white point (%) "LevelGamma" => 1.0, # level a picture mid point (gamma value) "indexBorder" => 0, # bool add a border around the index print "indexBorderWidth"=> 50, "indexBorderColor"=> 'white', "indexInnerBorder" => 0, # bool add a border around the each picture "indexInnerBorderWidth"=> 2, "indexInnerBorderColor"=> 'black', "indexFontSize" => 10, # the font size of the index labels (0 = automatic) "CheckForLinks" => 1, # bool - check if a file is a link before processing it "ColorAdj" => 0, # bool - do some color adjustments when filtering a pic "LineLimit" => 8, # max nr of lines in the thumbnail table e.g. for comments "LineLength" => 30, # length of one line in the thumbnail table e.g. for comments "ExtViewer" => 'display', # name of external picture viewer "ExtViewerMulti" => 0, # bool "ExtBGApp" => "wmsetbg -a", # name of external app to set desktop background (with options) "ConvertUmlaut" => 1, # convert german umlaute (e.g. -> ae etc.) "DeadPixelStr" => "1300,846,3 85,411,3 7,365,3 1529,185,3 1593,201,3 1387,1003,3 1957,1057,3 50,1043,2 615,935,3", # info about the dead pixels of your camera see: http://www.zero-based.org/software/jpegpixi/ "DeadPixelMethod" => "linear", "ShowCoordinates" => 0, "ImportSource" => "/mnt/usb/DCIM/DIMG", "ImportSubdirs" => 0, # bool - import also from all subdirs "ImportTargetFix" => "$home/pictures", "ImportTargetVar" => "2008/02/14_Birthday_Sam", "ImportDeadPixel" => 1, "ImportRotate" => 1, "ImportRename" => 1, "ImportDeleteCameraJunk" => 0, "ImportDelete" => 1, "ImportShowPics" => 1, "ImportAddCom" => 0, "ImportAddComment"=> "(c) $copyright_year Martin Herrmann", "ImportAddIPTC" => 0, "ImportIPTCTempl" => 'template.iptc2', "ImportMore" => 0, # bool - show additional import options in wizard "ImportMarkLocked"=> 0, # bool - add a high rating to locked (= write protected) pictures during import "Borderwidth" => 1, # border width of GUI elements (widgets) "PrintBaseDir" => "$home/pictures/print", "PrintVarDir" => "3_times_13x18", "PrintTimes" => "1", "PrintTimesStr" => "times", "PrintSize" => "10x15", "CenterThumb" => 0, # move the thumbnails up or down, so that the next e.g. previous thumb is also visible "ShowNextPicAfterDel" => 0, # open and display next pic after a delete "BeepWhenLooping" => 1, # play a beep when looping to the first e.g. last picture "SlowButMoreFeatures" => 0, # enable some features slowing down mapivi "setEXIFDateAskAgain" => 0, # show/don't show ask dialog "EXIFDateAbs" => "2008:02:20-18:51:45", "EXIFPlusMin" => "+", # used in setEXIFdate "EXIFAbsRel" => "abs", # used in setEXIFdate "EXIFyears" => 0, # used in setEXIFdate "EXIFdays" => 0, # used in setEXIFdate "EXIFhours" => 0, # used in setEXIFdate "EXIFmin" => 0, # used in setEXIFdate "EXIFsec" => 0, # used in setEXIFdate "RotateThumb" => 1, # bool - rotate thumb when rotating the pic "ToggleBorder" => 0, # bool - switch window decoration on/off in fullscreen mode "CentralThumbDB" => 0, # bool - 1 = central thumb DB, 0 = decentral .thumbs dirs "IPTCLastPad" => "cap", # remember the NoteBook page on the IPTC dialog "OptionsLastPad" => "gen", # remember the NoteBook page on the IPTC dialog "MetadataWarn" => 0, # print a warning to stdout if some strange metadata is found (e.g. in EXIF) "dirDiffDirA" => $home, "dirDiffDirB" => $home, "dirDiffSize" => 1, "dirDiffPixel" => 1, "dirDiffComment" => 1, "dirDiffEXIF" => 1, "dirDiffIPTC" => 1, "MailPicNoChange" => 0, "MailPicMaxLength"=> 800, "MailPicQuality" => 75, "MailTool" => 'mozilla-thunderbird', "winDirRequesterAskAgain" => 1, "FuzzyBorderWidth"=> 10, "FuzzyBorderBlur" => 10, "FuzzyBorderColor"=> "black", "ShowInfoInCanvas"=> 1, "llBorderWidthX" => 16, "llBorderWidthY" => 16, "llBorderWidthIX" => 1, "llBorderWidthIY" => 1, "llBorderColor" => "white", "llBorderColorI" => "black", "supportOtherPictureFormats" => 0, "CategoriesAll" => 2, # category mode 0= last, 1=all, 2=join "KeywordsAll" => 2, # keyword mode 0= last, 1=all, 2=join "Version" => '000', "ShowUnfinishedDirs" => 1, "ShowFinishedDirs" => 1, "trackPopularity" => 1, "ChannelRed" => 100, "ChannelGreen" => 100, "ChannelBlue" => 100, "ChannelDeco" => 0, "ChannelBright" => 1, 'SlideShowDir' => $home, # settings for slideshows 'relative_path' => 1, # settings for xnview slideshows 'xnview_loop' => 1, # settings for xnview slideshows 'xnview_fullscreen' => 1, # settings for xnview slideshows 'xnview_filename' => 0, # settings for xnview slideshows 'xnview_random' => 0, # settings for xnview slideshows 'xnview_mouse' => 0, # settings for xnview slideshows 'xnview_title' => 0, # settings for xnview slideshows 'PicWinBalloon' => 1, # boolean -1 show balloon info in pic window 'IPTCProfessional'=> 1, # boolean - 1 = professional IPTC, 0 = simple dialog 'CheckNewKeywords'=> 1, 'KeywordMore' => 0, # boolean 1 = show more options in keyword search window 'KeywordExclude' => '', # space separated list of keywords to exclude 'KeywordLimit' => 0, # boolean 1 = limit number of displayed keywords 'KeywordDate' => 0, # boolean 1 = limit to a date range 'KeywordStart' => 1070254800, # start date (UNIX time) 'KeywordEnd' => 1170254800, # end date (UNIX time) 'KeywordRating' => 0, # boolean 1 = limit to a rating range 'KeywordRatingA' => 1, # rating range 'KeywordRatingB' => 3, # rating range 'UrgencyChangeWarning' => 1, # boolean 1 = show a warning when urgency changed 'ActPic' => '', # the last picture shown 'SelectLastPic' => 1, # Select last shown pic after startup 'AutoImport' => 1, # boolean = 1 start import at Mapivi wizard if memory card is inserted (ImportSource) 'llWatermarkX' => 16, # lossless watermark x position 'llWatermarkY' => -16, # lossless watermark y position 'llWatermarkFile' => "$configdir/EmptyThumb.jpg", # lossless watermark file name 'AspectBorderN' => 3, # lossless aspect ratio border 'AspectBorderM' => 2, # lossless aspect ratio border 'RelativeBorderX' => 10, # lossless relative border 'RelativeBorderY' => 10, # lossless relative border 'RelativeBorderIX' => 0.1, # lossless relative border 'RelativeBorderIY' => 0.1, # lossless relative border 'RelativeBorderEqual'=> 1, # boolean lossless relative border 'KeywordDialogDock'=> 0, # boolean dock keyword dialog to main window 'KeywordDialogDockL'=> 1, # boolean dock keyword dialog on left side 'XMP_file_operations'=> 1, # boolean XMP sidecar files follow picture file operations 'WAV_file_operations'=> 1, # boolean WAV audio files follow picture file operations 'RAW_file_operations'=> 0, # boolean RAW files follow picture file operations 'LocationMode' => 'UPDATE', # UPDATE or REPLACE - mode for writing IPTC location info ); # some platform specific default settings # for windows if ($EvilOS) { $config{ExtViewer} = 'C:\Program Files\IrfanView\iview_32.exe'; } # for Mac OS X if ($MacOSX) { $config{ExtViewer} = "macosx-preview"; $config{ExtViewerMulti} = 1; } my @IPTCAttributes = ( "Urgency", "Keywords", "Headline", "Caption/Abstract", "SubLocation", "City", "Province/State", "Country/PrimaryLocationCode", "Country/PrimaryLocationName", "Writer/Editor", "ObjectName", "CopyrightNotice", "Category", "Source", "EditStatus", "OriginatingProgram", "ProgramVersion", "EditorialUpdate", "ObjectCycle", "ByLine", "ByLineTitle", "FixtureIdentifier", "ContentLocationName", "ContentLocationCode", "ReleaseDate", "ReleaseTime", "OriginalTransmissionReference", "ExpirationDate", "ExpirationTime", "Credit", "SpecialInstructions", "ActionAdvised", "Contact", #"ReferenceService", # only usefull for multiple objects #"ReferenceDate", # only usefull for multiple objects #"ReferenceNumber", # only usefull for multiple objects "DateCreated", "TimeCreated", "ImageType", "ImageOrientation", "DigitalCreationDate", "DigitalCreationTime", "LanguageIdentifier", #"RecordVersion", # binary "ObjectTypeReference", "ObjectAttributeReference", "SubjectReference", "SupplementalCategory", #"RasterizedCaption", # binary # Audio... and ObjDataPreview... left out by now ... ); my %iptcHelp = ( "ByLine" => "Contains name of the creator of the objectdata, e.g. writer, photographer or graphic artist. Examples: Robert Capa, Ernest Hemingway, Pablo Picasso (max. 32 chars)", "ByLineTitle" => "A ByLineTitle is the title of the creator or creators of an objectdata. Where used, a by-line title should follow the ByLine it modifies. Examples: Staff Photographer, Corresponsal, Envoye Special (max. 32 chars)", "Caption/Abstract" => "The Caption field is the text that accompanies the photo, containing the who, what, when, where and why information (max. 2000 chars)", "CaptionWriter" => "The Caption Writer field lists the initials of all the people who wrote or edited the caption, header fields or image file. This includes toning and pixel editing", "Category" => "Identifies the subject of the objectdata in the opinion of the provider. A list of categories will be maintained by a regional registry, where available, otherwise by the provider. Note: Use of this DataSet is Deprecated. It is likely that this DataSet will not be included in further versions of the IIM. The Category field lists codes that aid in a more detailed search. (max. 3 chars)", "SubLocation" => "Identifies the location within a city. Examples: Capitol Hill, Maple Leaf Gardens, Strandgateparken (max. 32 chars)", "City" => "The City field lists where the photo was originally made. For file photos, do not use the transmission point's city (max. 32 chars)", "Country/PrimaryLocationCode" => "The Country field lists the three-letter country code where the photo was originally made. For file photos, do not put the transmission points country. Examples: USA (United States), GER (Germany), FRA (France), XUN (United Nations) (max. 3 chars)", "Country/PrimaryLocationName" => "Provides full, publishable, name of the country/primary location where the intellectual property of the objectdata was created, according to guidelines of the provider. (max. 64 chars)", "DateCreated" => "The Create Date field is the date the photo was originally made. For file photos, use the date the photo was originally made, if known. If the complete date is not known, leaf the field blank. The field will not accept a partial date. (8 chars CCYYMMDD)", "TimeCreated" => "Represented in the form HHMMSS+HHMM (or -HHMM) to designate the time the intellectual content of the objectdata current source material was created rather than the creation of the physical representation. Follows ISO 8601 standard. Where the time cannot be precisely determined, the closest approximation should be used. Example: 133015+0100 indicates that the object intellectual content was created at 1:30 p.m. and 15 seconds Frankfurt time, one hour ahead of UTC. (11 chars HHMMSS+HHMM)", "Credit" => "Identifies the provider of the objectdata, not necessarily the owner/creator. (The Credit field is the name of the service transmitting the photo) (max. 32 chars)", "Headline" => "The Headline field lists keywords to aid in a more detailed search for a photo. Example: Lindbergh Lands In Paris (max. 256 chars)", "SpecialInstructions" => "The Instructions field lists special notations that apply uniquely to a photo, such as file photo, correction, advance or outs Examples: SECOND OF FOUR STORIES, 3 Pictures follow, Argentina OUT (max. 256 chars)", "ObjectName" => "Used as a shorthand reference for the object. Changes to existing data, such as updated stories or new crops on photos, should be identified in Edit Status. Examples: Wall St., Ferry Sinks. The Object Name field lists the story slug associated with a photo. For photos without a story, Associated Press photographers or photo editors will make up a logical slug to aid in a search and note it as a stand alone photo in the INSTRUCTIONS field of the NAA/IPTC header. If a related story moves on Data-Stream, the photo will be retransmitted with the appropriate OBJECT NAME to match the story. (max. 64 chars)", "Source" => "Identifies the original owner of the intellectual content of the objectdata. This could be an agency, a member of an agency or an individual. (The Source field lists who is the original provider of a photo, such as: AP, an AP member, pool photo provider or handout photo provider.) (max. 32 chars)", "Province/State" => "The State field lists the state where the photo was originally made. Use U.S. postal code abbreviations. For file photos, do not use the transmission point's state. Examples: WA, Sussex, Baden-Wuerttenberg (max. 32 chars)", "SupplementalCategory" => "The Supplemental Categories field lists codes that aid in a more detailed search for a photo.", "OriginalTransmissionReference" => "A code representing the location of original transmission according to practices of the provider. Examples: BER-5, PAR-12-11-01. (The Trans Reference field lists a call letter/number combination associated with a photo. It includes an originating transmit points call letters and picture number from that point's sequence of offerings for a given day. Example: NY105.) (max. 32 chars)", "Urgency" => "priority 0 meaning None, 1 meaning High to 8 meaning Low", "CopyrightNotice" => "Contains any necessary copyright notice. (max. 128 chars)", "ExpirationTime" => "Designates in the form HHMMSS+HHMM (or -HHMM) the latest time the provider or owner intends the objectdata to be used. Follows ISO 8601 standard. Example: 090000-0500 indicates an objectdata that should not be used after 0900 in New York (five hours behind UTC).", "ExpirationDate" => "Designates in the form CCYYMMDD the latest date the provider or owner intends the objectdata to be used. Follows ISO 8601 standard. Example: 19940317 indicates an objectdata that should not be used after 17 March 1994.", "ReleaseTime" => "Designates in the form HHMMSS+HHMM (or -HHMM) the earliest time the provider intends the object to be used. Follows ISO 8601 standard. Example: 090000-0500 indicates object for use after 0900 in New York (five hours behind UTC)", "ReleaseDate" => "Designates in the form CCYYMMDD the earliest date the provider intends the object to be used. Follows ISO 8601 standard. Example: 19890317 indicates data for release on 17 March 1989. (8 chars)", "FixtureIdentifier" => "Identifies objectdata that recurs often and predictably. Enables users to immediately find or recall such an object. Example: EUROWEATHER", "EditStatus" => "Status of the objectdata, according to the practice of the provider. Examples: Lead, CORRECTION (max. 64 chars)", "Writer/Editor" => "Identification of the name of the person involved in the writing, editing or correcting the objectdata or caption/abstract. (max. 32 chars)", "LanguageIdentifier" => "Describes the major national language of the object, according to the 2-letter codes of ISO 639:1988. Does not define or imply any coded character set, but is used for internal routing, e.g. to various editorial desks. Example: en (english), de (german) (2 or 3 chars)", "ObjectCycle" => "Where: a = morning, p = evening, b = both. Virtually only used in North America. (1 char)", "Contact" => "Identifies the person or organisation which can provide further background information on the objectdata. (max. 128 chars)" ); # store all values which were entered in the labeled entry widgets # key = label of entry, value = reference to array containing all unique values my %entryHistory; my @allcolors = qw/black gray10 gray20 gray30 gray40 gray50 gray60 gray70 gray80 gray85 gray90 gray95 white snow2 snow3 snow4 seashell1 seashell2 seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 green3 green4 chartreuse1 chartreuse2 chartreuse3 chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 purple2 purple3 purple4 MediumPurple1 MediumPurple2 MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 thistle4/; # get the configurations from the rc file if the configdir exists readConfig($configFile, \%config) if (-d $configdir); $actpic = $config{ActPic}; # At startup the menu should always be visible $config{ShowMenu} = 1; # check if this is the first start of a new Mapivi version mapiviUpdate() if (($config{Version} eq '000') or ($version ne $config{Version})); $config{Version} = $version; processARGV(); # process the command line arguments as early as possible to give a fast feedback my $layoutOld = $config{Layout}; # this must be done after readConfig! # for zoom and subsample of Tk::Photo objects # the higher the zoom value the longer the time to zoom # subsample is quite fast, so the first number (zoom) should not be bigger than 4 # the second (subsample) may be bigger my @frac; if ($config{SlowButMoreFeatures}) { @frac = (10,1, 6,1, 4,1, 3,1, 2,1, 3,2, 4,3, 1,1, 4,5, 3,4, 2,3, 3,5, 1,2, 2,5, 1,3, 1,4, 1,5, 1,6, 1,7, 1,8, 1,10, 1,12, 1,16, 1,25, 1,50); } else { @frac = (10,1, 6,1, 4,1, 3,1, 2,1, 3,2, 4,3, 1,1, 4,5, 3,4, 2,3, 1,2, 1,3, 1,4, 1,5, 1,6, 1,7, 1,8, 1,10, 1,12, 1,16, 1,25, 1,50); } # open main window my $top = MainWindow->new; # hide it, while building up $top->withdraw; # set the window size checkGeometry(\$config{Geometry}); $top->geometry($config{Geometry}); # add a window and icon picture my $icon_data = <Photo(-data => $icon_data); my $mapiviiconfile = "$configdir/MapiviIcon.gif"; $mapiviiconfile = "$configdir/MapiviIcon32.gif" if $EvilOS; #my $mapiviicon = $top->Photo(-file => $mapiviiconfile) if (-f $mapiviiconfile); $top->idletasks if $EvilOS; # this line is crucial (at least on windows) $top->iconimage($mapiviicon) if $mapiviicon; my $dragAndDrop1 = "$configdir/MiniPic.jpg"; my $dragAndDrop2 = "$configdir/MiniPicMulti.jpg"; my $dragAndDropIcon1 = $top->Photo(-file => $dragAndDrop1) if (-f $dragAndDrop1); my $dragAndDropIcon2 = $top->Photo(-file => $dragAndDrop2) if (-f $dragAndDrop2); # button bitmap needed for color buttons my $mcbut = pack("b8" x 8, ".......", ".......", ".......", ".......", ".......", ".......", ".......", "......."); $top->DefineBitmap('mcbut' => 8, 8, $mcbut); # button bitmap needed for + buttons my $plusbut = pack("b5" x 5, "..1..", "..1..", "11111", "..1..", "..1..",); $top->DefineBitmap('plusbut' => 5, 5, $plusbut); # button bitmap needed for - buttons my $minusbut = pack("b5" x 5, ".....", ".....", "11111", ".....", ".....",); $top->DefineBitmap('minusbut' => 5, 5, $minusbut); # pseudo transpartent bitmap for cropDialog my $transbits = pack("b4" x 4, "11..", "11..", "..11", "..11"); $top->DefineBitmap('transp' => 4, 4, $transbits); # pseudo transpartent bitmap for cropDialog my $transbits2 = pack("b1" x 3, "1", "1", "."); $top->DefineBitmap('transp2' => 1, 3, $transbits2); # pseudo transpartent bitmap for cropDialog my $transbits3 = pack("b1" x 3, "1", ".", "1"); $top->DefineBitmap('transp3' => 1, 3, $transbits3); # set title and icon $top->title("MaPiVi $version"); $top->iconname("MaPiVi"); # set options my $ScW = 10; $ScW = 14 if $EvilOS; # the small scrollbars look ugly under windows for (qw(Scale Scrollbar)) { $top->optionAdd("*$_.width", $ScW, "userDefault"); } # override -takefocus for frames and scrollbars $top->optionAdd('*Frame.TakeFocus','0'); $top->optionAdd('*Scrollbar.TakeFocus','0'); $top->optionAdd('*ResizeButton.TakeFocus','0'); # change menu style to compact $top->optionAdd('*Menu.borderWidth' => 1); $top->optionAdd('*Menu.activeBorderWidth' => 0); $top->optionAdd('*Menu.borderWidth' => 1); $top->optionAdd('*selectForeground', $config{ColorSelFG}, 'userDefault'); $top->optionAdd('*selectBackground', $config{ColorSel}, 'userDefault'); $top->optionAdd("*highlightColor", $config{ColorSel}, 'userDefault'); $top->optionAdd("*highlightBackground", $config{ColorHlBG}, 'userDefault'); $top->optionAdd("*background", $config{ColorBG}, 'userDefault'); $top->optionAdd("*activeBackground", $config{ColorActBG}, 'userDefault'); # must be after the *background optionAdd call $top->optionAdd("*Menu.background", $config{ColorMenuBG}, 'userDefault'); for (qw(foreground)) { $top->optionAdd("*$_", $config{ColorFG}, 'userDefault'); } # must be after the *foreground and *background optionAdd call $top->optionAdd("*Menu.background", $config{ColorMenuBG}, 'userDefault'); $top->optionAdd("*Menu.foreground", $config{ColorMenuFG}, 'userDefault'); for (qw(Scale Scrollbar Adjuster)) { $top->optionAdd("*$_.troughColor", $config{ColorEntry}, "userDefault"); } $top->optionAdd("*ProgressBar.troughColor", $config{ColorBG}, "userDefault"); $top->optionAdd("*Label.background", $config{ColorBG}, "userDefault"); for (qw(Entry NumEntry Listbox KListbox K2Listbox TixHList HList Text BrowseEntry.Entry NoteBook)) { $top->optionAdd("*$_.background", $config{ColorEntry}, "userDefault"); } for (qw(Button Checkbutton Radiobutton Menubutton FlatCheckbox FireButton Menu)) { $top->optionAdd("*$_.cursor", "hand2", "userDefault"); } $top->optionAdd("*Radiobutton.selectColor", $config{ColorSelBut}, "userDefault"); $top->optionAdd("*Checkbutton.selectColor", $config{ColorSelBut}, "userDefault"); $top->optionAdd("*Menu.selectColor", $config{ColorSelBut}, "userDefault"); my $font = $top->Font(-family => $config{FontFamily}, -size => $config{FontSize}, #-weight => "normal,-slant,roman,-underline,0,-overstrike,0 ); my $small_font = $top->Font(-family => $config{FontFamily}, -size => 8); $top->optionAdd("*font", $font, "userDefault"); # slick scrollbars $top->optionAdd('*Scrollbar.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Adjuster.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Button.borderWidth' => $config{Borderwidth}); $top->optionAdd('*ResizeButton.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Entry.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Scale.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Slider.borderWidth' => $config{Borderwidth}); $top->optionAdd('*NoteBook.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Frame.borderWidth' => $config{Borderwidth}); $top->optionAdd('*NoteBook.Frame.borderWidth' => 0); $top->optionAdd('*checkbutton.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Checkbutton.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Radiobutton.borderWidth' => $config{Borderwidth}); $top->optionAdd('*radiobutton.borderWidth' => $config{Borderwidth}); $top->optionAdd('*separator.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Menu.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Cascade.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Label.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Canvas.borderWidth' => $config{Borderwidth}); $top->optionAdd('*ROText.borderWidth' => $config{Borderwidth}); $top->optionAdd('*Optionmenu.borderWidth' => $config{Borderwidth}); $top->optionAdd('*DirTree.borderWidth' => $config{Borderwidth}); $top->optionAdd('*HList.borderWidth' => $config{Borderwidth}); # call quitMain when the window is closed by the window manager $top->protocol("WM_DELETE_WINDOW" => sub { quitMain(); }); # init stuff $balloon = $top->Balloon(-bg => $config{ColorSel}, -initwait => 1000); $balloon->Subwidget("message")->configure(-justify => "left"); $top->fontCreate(qw/C_big -family courier -size 14 -weight bold/); #createMenubar(); my $infoF = $top->Frame(-relief => 'raised'); # $subF contains the 3 frames: dirtree ($dirF), thumbnails ($thumbF) and picture ($mainF) my $subF = $top->Frame(); my $dirF = $subF->Frame(); my $dirA = $subF->Adjuster(); my $thumbF = $subF->Frame(); my $thumbA = $subF->Adjuster(); my $mainF = $subF->Frame(); my $exifF = $mainF->Frame(-relief => "raised"); my $iptcB = makeButton($exifF, "left", "IPTC", "iptc.gif", 'displayIPTCData($picLB)'); $balloon->attach($iptcB, -msg => "Show all IPTC Information of displayed picture"); my $exifB = makeButton($exifF, "left", "EXIF", "exif.gif", 'displayEXIFData($picLB)'); $balloon->attach($exifB, -msg => "Show all EXIF Information of displayed picture"); my $exifL = $exifF->Label(-textvariable => \$exif, -anchor => 'w', -justify => "left", -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 1); $balloon->attach($exifL, -msg => "EXIF Information of displayed picture"); my $comF = $mainF->Frame(-relief => "raised"); my $comBF = $comF->Frame()->pack(-side => "left", -expand => 1, -fill => "both", -anchor=>"nw", -padx => 0, -pady => 0); my $capF = $mainF->Frame(-relief => "raised"); my $nrofL = $infoF->Label(-justify => "left",-textvariable => \$nrof, -relief => "sunken", -anchor => 'w' )->pack(-side => "left", -expand => 0, -fill => "y"); $balloon->attach($nrofL, -msg => "x/y (z, s) = first selected picture is number x\nfrom y pictures in the actual folder\nz pictures are selected\ns is the size of all selected pictures"); my $dirtreedir; # if the actual dir should be displayed in the dir frame, just change $thumbF to $dirF in the line below my $actdirF = $thumbF->Frame()->pack(-expand => 1, -fill => 'x', -padx => 2, -pady => 1); my $actdirL = $actdirF->Label(-textvariable => \$actdir, -width => 10, -anchor => "e", -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left", -expand => 1, -fill => 'x'); $balloon->attach($actdirL, -msg => "actual folder\nClick here to open a simple folder requester."); $actdirL->bind("", sub { getDirAndOpen(); }); my $otherFilesL = $actdirF->Label(-textvariable => \$otherFiles, -relief => "sunken", -bd => $config{Borderwidth})->pack(-side => "left"); $balloon->attach($otherFilesL, -msg => "number of non-JPEG files in the actual folder"); my $otherFilesB = $actdirF->Button(-text => "i", -command => sub {showNonJPEGS();}, -padx => 1, -pady => 0)->pack(-side => "left"); $balloon->attach($otherFilesB, -msg => "show non-JPEG files in the actual folder"); my $parentDirB = $actdirF->Button(-text => "..", -command => sub { my $parentdir = dirname($actdir); print "changing to $parentdir (was: $actdir)\n" if $verbose; openDirPost($parentdir); }, -padx => 0, -pady => 0)->pack(-side => "left"); $balloon->attach($parentDirB, -msg => "open parent folder"); my $dirPropSORT = 0; my $dirPropMETA = 0; my $dirPropPRIO = 0; $actdirF->{cbSORT} = $actdirF->Checkbutton(-variable => \$dirPropSORT, -command => sub { $dirProperties{$actdir}{SORT} = $dirPropSORT; })->pack(-side => 'left', -anchor=>'w', -padx => 0); $actdirF->{cbMETA} = $actdirF->Checkbutton(-variable => \$dirPropMETA, -command => sub { $dirProperties{$actdir}{META} = $dirPropMETA; })->pack(-side => 'left', -anchor=>'w', -padx => 0); $actdirF->{cbPRIO} = $actdirF->Checkbutton(-variable => \$dirPropPRIO, -command => sub { $dirProperties{$actdir}{PRIO} = $dirPropPRIO; })->pack(-side => 'left', -anchor=>'w', -padx => 0); $balloon->attach($actdirF->{cbSORT}, -msg => "Sort:\nCheck this button, if the pictures\nin this folder are sorted out."); $balloon->attach($actdirF->{cbMETA}, -msg => "Meta:\nCheck this button, if all needed meta infos\n(comments, IPTC) of the pictures in this folder are added."); $balloon->attach($actdirF->{cbPRIO}, -msg => "Prio:\nCheck this button, if the pictures in this\nfolder are rated with a IPTC urgency flag."); my $dirtree; $dirtree = $dirF->Scrolled('DirTree', -scrollbars => 'osoe', -width => 30, -height => 200, -showhidden => $config{ShowHiddenDirs}, -selectmode => 'browse', -exportselection => 1, -browsecmd => sub { # this function will show all subdirs when clicking on the + sign of a dir $dirtreedir = shift; $dirtreedir = Encode::encode('iso-8859-1', $dirtreedir); return if (@_ >= 1); if (!-d $dirtreedir) { print "dirtree xxx: $dirtreedir does not exists!\n"; return; } $top->Busy; my @dirs = getDirs($dirtreedir); $top->Unbusy; return if (@dirs < 1); $top->Busy; my $lastdir = $dirtreedir."/".$dirs[-1]; if ($dirtree->info("exists", "$lastdir")) { $dirtree->see($lastdir) if (-d $lastdir); } $top->Unbusy; }, -command => sub { openDirPost($dirtreedir); }, )->pack(-fill => "both", -expand => 1); # Set the initial folder exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir); bindMouseWheel($dirtree); $dirtree->bind('', sub { $dirtree->focus; } ) unless $EvilOS; $dirtree->bind('', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); my $dtr = $dirtree->Subwidget("scrolled"); # change the binding order of the dirtree $dtr->bindtags([$dtr,ref $dtr,$dtr->toplevel,'all']); # stop the execution of the scape key $dtr->bind('', sub { Tk->break; } ); my $c = $mainF->Scrolled('Canvas', -scrollbars => 'osoe', -width => 2000, -height => 2000, -relief => "flat", -borderwidth => 0, -highlightthickness => 0, -bg => $config{ColorBGCanvas}, ); $c->configure(-scrollregion => [0, 0, 100, 100]); my $whL = $infoF->Label(-textvariable => \$widthheight, -relief => "sunken")->pack(-side => "left", -expand => 0, -fill => "y"); $balloon->attach($whL, -msg => "width and height of displayed picture in pixels"); my $sizeL = $infoF->Label(-textvariable => \$size, -relief => "sunken")->pack(-side => "left", -fill => "y"); $balloon->attach($sizeL, -msg => "file size of displayed picture in kByte"); my $zoomL = $infoF->Label(-textvariable => \$zoomFactorStr, -relief => "sunken")->pack(-side => "left", -fill => "y"); $balloon->attach($zoomL, -msg => "zoom factor of the actual picture"); my $urgF = $infoF->Frame(-relief => "sunken")->pack(-side => "left", -fill => "y"); my $urgL = $urgF->Label(-textvariable => \$urgencyStr)->pack(-side => "left", -fill => "y"); $balloon->attach($urgF, -msg => "Rating (IPTC urgency) of actual picture\n0 or - meaning None, 1 meaning High to 8 meaning Low\nTo change use Ctrl-F1, -F2, ... -F8"); my $urgAnchor = 's'; $urgAnchor = 'n' if ($Tk::VERSION < 804); # the anchor behavior has changed my $urgencyBar = $urgF->ProgressBar(-takefocus => 0, -borderwidth => 0, -width => 12, -length => (2*$config{FontSize}), # try to guess the height of the labels -padx => 0, -pady => 0, -variable => \$urgencyScale, -colors => [0, $top->Darken($config{ColorSel}, 30), 1, $top->Darken($config{ColorSel}, 40), 2, $top->Darken($config{ColorSel}, 50), 3, $top->Darken($config{ColorSel}, 60), 4, $top->Darken($config{ColorSel}, 70), 5, $top->Darken($config{ColorSel}, 80), 6, $top->Darken($config{ColorSel}, 90), 7, $config{ColorSel} ], -troughcolor => $config{ColorBG}, -resolution => 1, -blocks => 0, -gap => 0, -anchor => $urgAnchor, -from => 0, -to => 8 )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0); my $userInfoL = $infoF->Label(-textvariable => \$userinfo, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 1); my $userInfoMsg; $balloon->attach($userInfoL, -postcommand => sub { $userInfoMsg = "information about what's going on"; $userInfoMsg .= "\n(actual folder: $actdir)"}, -msg => \$userInfoMsg); my $colorPickerInfo = $infoF->Label(-text => ' ', -background => $config{ColorPicker}, -relief => "sunken")->pack(-side => "left", -fill => 'both', -expand => 0); $balloon->attach($colorPickerInfo, -msg => "Color picker: last color picked by clicking\non the picture in the main window.\nPlease click to clear."); $colorPickerInfo->bind('', sub { $config{ColorPicker} = $config{ColorBG}; $colorPickerInfo->configure(-background => $config{ColorPicker}); }); #my $stopB = makeButton($infoF, "left", "STOP", "StopPic.gif", 'stopButStop()'); #$balloon->attach($stopB, -msg => "Stop actual action.\nThis may take a while, pressing the button once is enough,\neven if no immidiate feedback is visible."); #stopButEnd(); my $nrTCL = $infoF->Label(-textvariable => \$nrToConvert, -relief => "sunken")->pack(-side => "left", -expand => 0, -fill => "y"); $balloon->attach($nrTCL, -msg => "Number of thumbnails to generate/refresh"); my $progressBar = $infoF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -width => (2*$config{FontSize}), # try to guess the height of the labels -length => 30, -padx => 0, -pady => 0, -variable => \$proccount, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => $config{MaxProcs}, -anchor => 'w', -from => 0, -to => $config{MaxProcs} )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 0, -pady => 0); $balloon->attach($progressBar, -msg => "info about the number of background processes\n(generating thumbnail pictures)"); $clockL = $infoF->Label(-textvariable => \$time, -relief => "sunken")->pack(-side => "left", -fill => "y"); $balloon->attach($clockL, -msg => \$date); # JPEG comment box my $commentText = $comF->Scrolled("ROText", -scrollbars => 'oe', -wrap => 'word', -width => 200, -height => $config{CommentHeight}, )->pack(-side => "left", -fill => 'both', -expand => "1", -padx => 0, -pady => 0); $balloon->attach($commentText, -msg => "Comment(s) of displayed picture"); my $addB = makeButton($comBF, "left", "add", "add.gif", 'addComment($picLB)'); $balloon->attach($addB, -msg => "Add a comment"); my $editB = makeButton($comBF, "left", "edit", "edit.gif", 'editComment($picLB)'); $balloon->attach($editB, -msg => "Edit a comment"); my $remB = makeButton($comBF, "left", "del", "delete.gif", 'removeComment()'); $balloon->attach($remB, -msg => "Remove comment(s)"); my $picLB = makeThumbListbox($thumbF); $picLB->bind('', sub { $picLB->focus; } ) unless $EvilOS; # IPTC caption edit box my $captionText; $capF->Label(-text => "Caption")->pack(-side => "left", -fill => 'both'); $captionText = $capF->Scrolled("Text", -scrollbars => 'oe', -wrap => 'word', -width => 20, -height => $config{CommentHeight}, )->pack(-side => 'left', -fill => 'both', -expand => "1"); $balloon->attach($captionText, -msg => "IPTC caption of displayed picture"); my $saveB = $capF->Button(-image => compound_menu($top, 'save', 'media-floppy.png', 0), #-text => "save", -command => sub { my $iptc = { "Caption/Abstract" => $captionText->get(0.1, 'end') }; my @list = ($actpic); applyIPTC($picLB, $iptc, \@list); } )->pack(-side => "left", -fill => 'both'); $balloon->attach($saveB, -msg => "Save the IPTC caption to the file and database.\nPlease press this button after adding or editing."); #$captionText->Subwidget("scrolled")->bindtags([]); #$captionText->Subwidget("scrolled")->bind('', sub {}); #->Subwidget("scrolled") # item styles for the thumbnail view my $thumbCaptionFont = $top->Font(-family => $config{FontFamily}, -size => $config{ThumbCaptFontSize}); my $thumbS = $picLB->ItemStyle('imagetext', -anchor => 'w', -textanchor => 's', -foreground=>$config{ColorFG}, -background=>$config{ColorBG}, -font => $thumbCaptionFont); my $fileS = $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorFile}, -background=>$config{ColorBG}); my $iptcS = $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorIPTC}, -background=>$config{ColorBG}); my $comS = $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorComm}, -background=>$config{ColorBG2}); my $exifS = $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorEXIF}, -background=>$config{ColorBG2}); my $dirS = $picLB->ItemStyle('text', -anchor=>'nw', -foreground=>$config{ColorDir}, -background=>$config{ColorBG2}); toggleHeaders(); # mouse and button bindings # key-desc,double click,show picture in own window #$picLB->bind('', sub { showPicInOwnWin(); } ); # does not always work ??? # key-desc,MiddleMouseButton,show picture in own window $picLB->bind('', sub { return if (!$picLB->info('children')); showPicInOwnWin(getNearestItem($picLB)); } ); # experimental stuff #$top->bind('', sub { print "Mouse Press But 4\n"; } ); #$top->bind('', sub { print "Mouse Press But 5\n"; } ); # Define the source for drags. # Drags are started while pressing the Ctrl key and the left mouse button and moving the # mouse. Then the StartDrag callback is executed. my $token; # key-desc,S-C-LeftBut,(Shift-Ctrl-LeftMouseButton) drag and drop pictures to a dir $token = $picLB->DragDrop (-event => '', -sitetypes => 'Local', -startcommand => sub { dragFromPicLB($token) }, ); # Define the target for drops. $dirtree->DropSite (-droptypes => 'Local', -dropcommand => sub { dropToDirTree(); }, ); $picLB->bind('', sub { # saved here for undo function @savedselection2 = @savedselection; @savedselection = $picLB->info('selection'); } ); $picLB->bind('', sub { showSelectedPic(); } ); $picLB->bind('', sub { if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off $thumbMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); # key-desc,Return,display the selected picture $picLB->bind('', sub { showSelectedPic(); } ); $c->CanvasBind('', sub { if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off $picMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); # we can't bind all keys to the complete window ($top) as we have e.g. the IPTC Caption entry which should get all key events addWindowKeyBindings($dirtree, $picLB); addWindowKeyBindings($picLB, $picLB); addWindowKeyBindings($c, $picLB); addCommonKeyBindings($dirtree, $picLB); addCommonKeyBindings($picLB, $picLB); addCommonKeyBindings($c, $picLB); # key-desc,d,display picture in own window #$picLB->bind('', sub { showPicInOwnWin(); } ); $picLB->bind('', sub { my @sellist = getSelection($picLB); return unless checkSelection($top, 1, 0, \@sellist); show_multiple_pics(\@sellist, 0); } ); $dirtree->bind('', sub { my $dir = getRightDir(); my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }); $dirtree->bind('', sub { $dirtree->selectionClear(); $dirtree->selectionSet(getNearestItem($dirtree)); my $dir = getRightDir(); my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }); # window resize event $top->bind("" => sub { # only if dock is selected return unless ($config{KeywordDialogDock}); # and the keyword dialog is open return unless (Exists($keyw)); dock_keyword_dialog(); }); # support drag and drop from extern # this enables dropping pictures and folders on the mapivi window if ($Tk::VERSION < 804) { $top->DropSite (-dropcommand => \&dragAndDropExtern, -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun']) ); } else { $top->DropSite (#-entercommand => sub { print "DragAndDrop - Entercommand\n";}, -dropcommand => \&dragAndDropExtern, -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['XDND', 'Sun']) # KDEsite was removed in Tk804.026 ); } startup(); # show all types of images supported by Tk::Image #my @types = $top->imageTypes;printlist(@types); # Perl/Tk-Mainloop $top->MainLoop; # override the Motion sub of listbox (extended selection mode) # seems not to help with the drag and drop problem #sub Tk::HList::Motion { #sub Tk::Listbox::Motion { # return; #} ############################################################## # stillBusy - block some keys, untill loading of pictures is finished ############################################################## sub stillBusy { if ($showPicInAction) { beep(); $userinfo = "busy (loading pic), please retry later"; $userInfoL->update; return 1; } return 0; } ############################################################## # makeThumbListbox - create a scrolled HList for thumbnail display ############################################################## sub makeThumbListbox { my $widget = shift; my $lb = $widget->Scrolled('HList', -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 6, -scrollbars => 'osoe', -selectmode => 'extended', -background => $config{ColorBG}, -width => 30, -height => 200, )->pack(-expand => 1, -fill => 'both'); bindMouseWheel($lb); my $colNr = 0; if ($resizeAvail) { my $thumbH = $lb->ResizeButton(-text => 'Thumbnail', -relief => 'flat', -pady => 0,-anchor => 'w', -widget => \$lb, -column => $colNr); $lb->{thumbcol} = $colNr; $lb->header('create', $colNr++, -itemtype => 'window', -widget => $thumbH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $sizeH = $lb->ResizeButton(-text => 'File', -relief => 'flat', -pady => 0,-anchor => 'w', -command => sub { return unless ($lb == $picLB); if ($config{SortBy} eq 'name') { toggle(\$config{SortReverse}); } else { $config{SortReverse} = 0; } $config{SortBy} = 'name'; updateThumbsPlus(); }, -widget => \$lb, -column => $colNr); $lb->{filecol} = $colNr; $lb->header('create', $colNr++, -itemtype => 'window', -widget => $sizeH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $iptcH = $lb->ResizeButton(-text => 'IPTC', -relief => 'flat', -pady => 0,-anchor => 'w', -command => sub { return unless ($lb == $picLB); if ($config{SortBy} eq 'urgency') { toggle(\$config{SortReverse}); } else { $config{SortReverse} = 0; } $config{SortBy} = 'urgency'; updateThumbsPlus(); }, -widget => \$lb, -column => $colNr); $lb->{iptccol} = $colNr; $lb->header('create', $colNr++, -itemtype => 'window', -widget => $iptcH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $comH = $lb->ResizeButton(-text => 'Comments', -relief => 'flat', -pady => 0,-anchor => 'w', -widget => \$lb, -column => $colNr); $lb->{comcol} = $colNr; $lb->header('create', $colNr++, -itemtype => 'window', -widget => $comH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $exifH = $lb->ResizeButton(-text => 'EXIF', -relief => 'flat', -pady => 0,-anchor => 'w', -command => sub { return unless ($lb == $picLB); $config{SortBy} = 'exifdate'; toggle(\$config{SortReverse}); updateThumbsPlus(); }, -widget => \$lb, -column => $colNr); $lb->{exifcol} = $colNr; $lb->header('create', $colNr++, -itemtype => 'window', -widget => $exifH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $dirH = $lb->ResizeButton(-text => 'Folder', -relief => 'flat', -pady => 0,-anchor => 'w', -command => sub { return unless ($lb == $picLB); if ($config{SortBy} eq 'name') { toggle(\$config{SortReverse}); } else { $config{SortReverse} = 0; } $config{SortBy} = 'name'; updateThumbsPlus(); }, -widget => \$lb, -column => $colNr); $lb->{dircol} = $colNr; $lb->header('create', $colNr, -itemtype => 'window', -widget => $dirH, -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); } else { # no resizeAvail $lb->{thumbcol} = $colNr; $lb->header('create', $colNr++, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); #$lb->{namecol} = $colNr; #$lb->header('create', $colNr++, -text => 'Name', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $lb->{filecol} = $colNr; $lb->header('create', $colNr++, -text => 'File', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $lb->{iptccol} = $colNr; $lb->header('create', $colNr++, -text => 'IPTC', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $lb->{comcol} = $colNr; $lb->header('create', $colNr++, -text => 'Comments', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $lb->{exifcol} = $colNr; $lb->header('create', $colNr++, -text => 'EXIF', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $lb->{dircol} = $colNr; $lb->header('create', $colNr, -text => 'Folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); } return $lb; } ############################################################## # addWindowKeyBindings - add key shortcuts to a widget ############################################################## sub addWindowKeyBindings { my $bind_w = shift; # widget to bind keys to my $lb_w = shift; # thumbnail listbox to use # key-desc,b,show backup picture (if available) $bind_w->bind('', sub { showBackup(); }); # key-desc,w,show window list $bind_w->bind('', sub { showWindowList(); }); # key-desc,Ctrl-r,rebuild selected thumbnails $bind_w->bind('', sub { rebuildThumbs(); } ); # key-desc,Ctrl-s,search database $bind_w->bind('', sub { searchMetaInfo(); } ); # key-desc,k,search by keyword (tag cloud) $bind_w->bind('', sub { keyword_browse(); } ); # key-desc,o,open a new folder $bind_w->bind('', sub { openDir(); } ); # key-desc,h,show hot folders $bind_w->bind('', sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); # key-desc,u,update (reread folder and Image) $bind_w->bind('', sub { updateThumbsPlus(); } ); # key-desc,F05,smart update (add new and remove deleted images) $bind_w->bind('', sub { smart_update(); } ); # key-desc,U,update image $bind_w->bind('', sub { deleteCachedPics($actpic); showPic($actpic); } ); # layouts # key-desc,l,cycle layout of folder thumbnail and picture frame $bind_w->bind('', sub { $config{Layout}++; layout(1); } ); # key-desc,F01,toggle show menu bar $bind_w->bind('', sub { $config{ShowMenu} = $config{ShowMenu} ? 0 : 1; showHideFrames(); } ); # key-desc,F02,toggle show status bar $bind_w->bind('', sub { $config{ShowInfoFrame} = $config{ShowInfoFrame} ? 0 : 1; showHideFrames(); } ); # key-desc,F03,toggle show EXIF box $bind_w->bind('', sub { $config{ShowEXIFField} = $config{ShowEXIFField} ? 0 : 1; showHideFrames(); } ); # key-desc,F04,toggle show comment box $bind_w->bind('', sub { $config{ShowCaptionField} = $config{ShowCaptionField} ? 0 : 1; showHideFrames(); } ); # key-desc,F06,layout 0: folders-thumbnails-picture (25-30-45) $bind_w->bind('', sub { $config{Layout} = 0 ; layout(1);} ); # key-desc,F07,layout 1: folders-thumbnails (20-80-0) $bind_w->bind('', sub { $config{Layout} = 1 ; layout(1);} ); # key-desc,F08,layout 2: thumbnails (0-100-0) $bind_w->bind('', sub { $config{Layout} = 2 ; layout(1);} ); # key-desc,F09,layout 3: thumbnails-picture (0-50-50) $bind_w->bind('', sub { $config{Layout} = 3 ; layout(1);} ); # key-desc,F10,layout 4: picture (0-0-100) $bind_w->bind('', sub { $config{Layout} = 4 ; layout(1); Tk->break; # stop default binding of this key } ); # key-desc,F11,fullscreen mode $bind_w->bind('', sub { topFullScreen(); }); # key-desc,Delete,delete selected pictures to trash $bind_w->bind('', sub { deletePics($lb_w, TRASH); } ); # key-desc,Shift-Delete,remove selected pictures $bind_w->bind('', sub { deletePics($lb_w, REMOVE); } ); # key-desc,q,quit mapivi $bind_w->bind('', sub { quitMain(); } ); # key-desc,R,smart rename selected pictures (e.g to EXIF date) $bind_w->bind('', sub { renameSmart($lb_w); } ); # key-desc,F12,quit mapivi $bind_w->bind('', sub { quitMain(); } ); # show picture, EXIF, Comment and IPTC info # key-desc,c,display JPEG comment $bind_w->bind('', sub { showComment(); } ); # key-desc,t,display embedded EXIF thumbnail $bind_w->bind('', sub { showEXIFThumb(); } ); # key-desc,Ctrl-v,toggle verbose output $bind_w->bind('', sub { toggle(\$verbose); $userinfo = "verbose switched to $verbose"; $userInfoL->update; } ); # key-desc,Ctrl-c,crop (lossless) $bind_w->bind('', sub { crop($lb_w); } ); # key-desc,Ctrl-b,add border and/or copyright $bind_w->bind('', sub { losslessBorder(PIXEL); } ); # key-desc,Ctrl-q,change size/quality $bind_w->bind('', sub { changeSizeQuality(); } ); # key-desc,Ctrl-o,open options dialog $bind_w->bind('', sub { options(); } ); # key-desc,Ctrl-e,edit picture in GIMP $bind_w->bind('', sub { GIMPedit(); } ); # key-desc,Ctrl-f,apply a filter to the picture $bind_w->bind('', sub { filterPic(); } ); # key-desc,H,display picture histogram $bind_w->bind('', sub { showHistogram($lb_w); }); # key-desc,9,rotate picture(s) 90 degrees clockwise $bind_w->bind('', sub { rotate(90); }); # key-desc,8,rotate picture(s) 180 degrees clockwise $bind_w->bind('', sub { rotate(180); }); # key-desc,7,rotate picture(s) 270 degrees clockwise $bind_w->bind('', sub { rotate(270); }); # key-desc,0,auto rotate picture(s) (EXIF orientation) $bind_w->bind('', sub { rotate("auto"); }); # key-desc,Escape,iconify the main window/close any other window $bind_w->bind('', sub { $top->iconify; } ); # thumbnail navigation # key-desc,Space,display the next picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(nextPic($actpic)); } ); # key-desc,S,display the next selected picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @sellist = $lb_w->info('selection'); showPic(nextSelectedPic($actpic)); reselect($lb_w, @sellist); } ); # key-desc,Page-Down,display the next picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(nextPic($actpic));} ); # key-desc,Backspace,display the previous picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(prevPic($actpic));} ); # key-desc,Page-Up,display the previous picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(prevPic($actpic));} ); # key-desc,Home,display the first picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $lb_w->info('children'); return unless (@childs); showPic($childs[0]); } ); # key-desc,End,display the last picture $bind_w->bind('', sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $lb_w->info('children'); return unless (@childs); showPic($childs[-1]); }); # key-desc,Ctrl-g,goto picture $bind_w->bind('', sub { gotoPic($lb_w); } ); # key-desc,s,start/stop slideshow $bind_w->bind('', sub { if ($slideshow == 0) { $slideshow = 1; } else { $slideshow = 0; } slideshow(); } ); # key-desc,-,zoom out or faster slideshow $bind_w->bind('', sub { if ($slideshow) { $config{SlideShowTime}-- if ($config{SlideShowTime} >= 1); $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; } else { zoomStep(-1); } } ); # key-desc,+,zoom in or slideshow slower $bind_w->bind('', sub { if ($slideshow) { $config{SlideShowTime}++ if ($config{SlideShowTime} < 30); $userinfo = "slideshow time: ".$config{SlideShowTime}." sec"; $userInfoL->update; } else { zoomStep(1); } }); # key-desc,Ctrl-h,display picture in original size (100% zoom) $bind_w->bind('', sub { zoom100(); }); # key-desc,z,display picture in original size (100% zoom) $bind_w->bind('', sub { zoom100(); }); # key-desc,f,fit picture in canvas (auto zoom) $bind_w->bind('', sub { fitPicture(); }); } ############################################################## # addCommonKeyBindings - add key shortcuts to a widget ############################################################## sub addCommonKeyBindings { my $bind_w = shift; # widget to bind keys to my $lb_w = shift; # thumbnail listbox to use # key-desc,a,add JPEG comment $bind_w->bind('', sub { addComment($lb_w); } ); # key-desc,e,edit JPEG comment $bind_w->bind('', sub { editComment($lb_w); } ); # key-desc,v,open picture in external viewer $bind_w->bind('', sub { openPicInViewer($lb_w); } ); # key-desc,r,rename selected pictures $bind_w->bind('', sub { renamePic($lb_w); } ); # key-desc,x,display embedded EXIF data $bind_w->bind('', sub { displayEXIFData($lb_w); } ); # key-desc,Ctrl-a,select all pictures $bind_w->bind('', sub { selectAll($lb_w); } ); # key-desc,i,display IPTC data $bind_w->bind('', sub { displayIPTCData($lb_w); } ); # key-desc,Ctrl-i,edit IPTC data $bind_w->bind('', sub { editIPTC($lb_w); } ); # key-desc,Ctrl-p,copy to print $bind_w->bind('', sub { copyToPrint($lb_w); } ); # key-desc,Ctrl-l,show selected thumbnails on light table $bind_w->bind('', sub { light_table_add_from_lb($lb_w); } ); # key-desc,Ctrl-t,add/remove categories $bind_w->bind('', sub { editIPTCCategories($lb_w); } ); # key-desc,Ctrl-k,add/remove keywords $bind_w->bind('', sub { editIPTCKeywords($lb_w); } ); # key-desc,Ctrl-F01,set IPTC urgency to 1 - high $bind_w->bind('', sub { setIPTCurgency($lb_w, 1); } ); # key-desc,Ctrl-F02,set IPTC urgency to 2 $bind_w->bind('', sub { setIPTCurgency($lb_w, 2); } ); # key-desc,Ctrl-F03,set IPTC urgency to 3 $bind_w->bind('', sub { setIPTCurgency($lb_w, 3); } ); # key-desc,Ctrl-F04,set IPTC urgency to 4 $bind_w->bind('', sub { setIPTCurgency($lb_w, 4); } ); # key-desc,Ctrl-F05,set IPTC urgency to 5 - normal $bind_w->bind('', sub { setIPTCurgency($lb_w, 5); } ); # key-desc,Ctrl-F06,set IPTC urgency to 6 $bind_w->bind('', sub { setIPTCurgency($lb_w, 6); } ); # key-desc,Ctrl-F07,set IPTC urgency to 7 $bind_w->bind('', sub { setIPTCurgency($lb_w, 7); } ); # key-desc,Ctrl-F08,set IPTC urgency to 8 - low $bind_w->bind('', sub { setIPTCurgency($lb_w, 8); } ); # key-desc,Ctrl-F09,set IPTC urgency to 0 - none $bind_w->bind('', sub { setIPTCurgency($lb_w, 0); } ); # key-desc,Ctrl-F10,remove IPTC urgency flag $bind_w->bind('', sub { setIPTCurgency($lb_w, 9); } ); } ############################################################## # startup - process all stuff needed to set up mapivi ############################################################## sub startup { print "sub startup ...\n" if $verbose; $picLB->focus; if ($config{NrOfRuns} == 0) { print "first run ...\n" if $verbose; makeConfigDir(); # todo this should be done outside mapivi (we need an installer!!! :) #copyConfigPics(); #copyOtherStuff(); #copyPlugIns(); } $config{NrOfRuns}++; gratulation() if (($config{NrOfRuns} % 1000 == 0) and ($config{NrOfRuns} > 0)); # modulo # create menus createMenubar(); createDirMenu(); createThumbMenu(); createPicMenu(); checkSystem(); startStopClock(); # migrate from the old file name "dirInfo" to "SearchDataBase" if (-f "$configdir/dirInfo") { if (-f "$configdir/SearchDataBase") { warn "Mapivi: there is something wrong! I found a file \"dirInfo\" and \"SearchDataBase\" in $configdir\n"; } else { if (rename("$configdir/dirInfo", "$configdir/SearchDataBase")) { print "Mapivi: I have renamed the file \"dirInfo\" to \"SearchDataBase\" in $configdir\n"; } else { warn "Mapivi: error renaming \"dirInfo\" to \"SearchDataBase\" in $configdir: $!\n"; } } } # try to get the saved database (meta info hash) if ($config{SaveDatabase} and -f "$configdir/SearchDataBase") { my $hashRef = retrieve("$configdir/SearchDataBase"); warn "could not retrieve searchDB" unless defined $hashRef; %searchDB = %{$hashRef}; } # try to get the saved hotlist folders if (-f "$configdir/hotlist") { my $hashRef = retrieve("$configdir/hotlist"); warn "could not retrieve hotlist" unless defined $hashRef; %dirHotlist = %{$hashRef}; } # try to get the saved folder properties if (-f "$configdir/dirProperties") { my $hashRef = retrieve("$configdir/dirProperties"); warn "could not retrieve dirProperties" unless defined $hashRef; %dirProperties = %{$hashRef}; } # try to get the saved ignore keywords if (-f "$configdir/keywords_ignore") { my $hashRef = retrieve("$configdir/keywords_ignore"); warn "could not retrieve keywords_ignore" unless defined $hashRef; %ignore_keywords = %{$hashRef}; } if (MatchEntryAvail) { # try to get the saved entry values if (-f $file_Entry_values) { my $hashRef = retrieve($file_Entry_values); warn "could not retrieve $file_Entry_values" unless defined $hashRef; %entryHistory = %{$hashRef}; } } updateDirMenu(); if (-f $config{DefaultThumb}) { $defaultthumbP = $picLB->Photo(-format => 'jpeg', -file => $config{DefaultThumb}, -gamma => $config{Gamma}); } else { warn "Mapivi info: no file ".$config{DefaultThumb}." found! (Please copy any thumbnail to this folder and rename it ".basename($config{DefaultThumb}).")\n"; undef $defaultthumbP; } layout(0); # remove splash screen $splash->Destroy if $splash; # show main window $top->deiconify; $top->raise; setDirProperties(); updateThumbs(); setAdjusterPos(); my $tmp = $config{ShowPic}; $config{ShowPic} = 0; showPic($actpic) if ($config{SelectLastPic} and (defined $actpic) and ($actpic ne '') and (dirname($actpic) eq $actdir)); $config{ShowPic} = $tmp; selectDirInTree($actdir); checkTrash(); # if command line option -i is set or a memory card is inserted we start the import wizard importWizard() if (($opt_i) or ($config{AutoImport} and (-d $config{ImportSource}))); if ($EvilOS) { warn "Win32::Process module not available\n" unless (Win32ProcAvail); } $top->update(); } ############################################################## # testSuite - automated regression tests for mapivi ############################################################## sub testSuite { my @childs = $picLB->info('children'); if (@childs < 2) { $top->messageBox(-icon => 'error', -message => "test suite must be started in a folder with at least two picture!", -title => "test suite", -type => 'OK'); return; } my $startdir = dirname($childs[0]); my $rc = $top->messageBox(-icon => 'question', -message => "Start some internal test with ".scalar @childs." pictures in $actdir.\nTest results will go to STDOUT (shell/DOS-box where you've started Mapivi).\nOk to go on?", -title => "Start test suite?", -type => 'OKCancel'); return unless ($rc =~ m/Ok/i); # test single selection print "testSuite: testing single selection\n"; foreach (@childs) { selectThumb($picLB, $_); my @sel = $picLB->info('selection'); print "testSuite: *** wrong selection\n" if (@sel != 1); print "testSuite: *** wrong selection\n" if ($sel[0] ne $_); } # test all selection print "testSuite: testing all selection\n"; selectAll($picLB); my @sel = $picLB->info('selection'); print "testSuite: *** wrong selection\n" if (@sel != @childs); my $dir1 = "$trashdir/testdir1"; my $dir2 = "$trashdir/testdir2"; # cleanup foreach ($dir1, $dir2) { print "testSuite: removing temp dir $_\n"; rmtree($_, 0, 1) if (-d $_); # dir, 0 = no message for each file, 1 = skip write protected files } foreach ($dir1, $dir2) { unless (makeDir($_, NO_ASK)) { print "testSuite: could not create $_\n"; } } print "testSuite: temp dirs created\n"; foreach ($dir1, $dir2) { unless (-d $_) { warn "testSuite: *** $_ not found!\n"; return; } } # test copy actdir -> dir1 print "testSuite: testing copy all\n"; selectAll($picLB); copyPics($dir1, COPY, $picLB, @childs); openDirPost($dir1); my @childs1 = $picLB->info('children'); if (@childs1 != @childs) { warn "testSuite: *** copy error ".scalar @childs1." ne ".scalar @childs."\n"; } foreach my $i (0 .. $#childs1) { # todo this will fail, if files are sorted by file date (copy date) if (basename($childs[$i]) ne basename($childs1[$i])) { warn "testSuite: *** copy error $childs[$i] ne $childs1[$i]\n"; } } # copy first pic dir1 -> dir2 print "testSuite: testing copy first\n"; selectThumb($picLB, $childs1[0]); @sel = $picLB->info('selection'); if (@sel ne 1) { warn "testSuite: *** sel error ".scalar @sel." ne 1\n"; } copyPics($dir2, COPY, $picLB, @sel); openDirPost($dir2); my @childs2 = $picLB->info('children'); if (@childs2 ne 1) { warn "testSuite: *** copy error ".scalar @childs2." ne 0\n"; } if (basename($childs1[0]) ne basename($childs2[0])) { warn "testSuite: *** copy error $childs[0] ne $childs1[0]\n"; } # clean dir2 selectAll($picLB); deletePics($picLB, TRASH); # copy last pic dir1 -> dir2 print "testSuite: testing copy last\n"; openDirPost($dir1); selectThumb($picLB, $childs1[-1]); @sel = $picLB->info('selection'); if (@sel ne 1) { warn "testSuite: *** sel error ".scalar @sel." ne 1\n"; } copyPics($dir2, COPY, $picLB, @sel); openDirPost($dir2); @childs2 = $picLB->info('children'); if (@childs2 ne 1) { warn "testSuite: *** copy error ".scalar @childs2." ne 0\n"; } if (basename($childs1[-1]) ne basename($childs2[-1])) { warn "testSuite: *** copy error $childs[-1] ne $childs1[-1]\n"; } # clean dir2 print "testSuite: cleaning dir\n"; selectAll($picLB); deletePics($picLB, TRASH); # move all pics dir1 -> dir2 print "testSuite: testing move all\n"; openDirPost($dir1); selectAll($picLB); @sel = $picLB->info('selection'); movePics($dir2, $picLB, @sel); openDirPost($dir2); @childs2 = $picLB->info('children'); if (@childs2 != @childs1) { warn "testSuite: *** move error ".scalar @childs2." ne ".scalar @childs1."\n"; } # move first and last pics dir2 -> dir1 print "testSuite: testing move first and last\n"; selectThumb($picLB, $childs2[0]); @sel = $picLB->info('selection'); movePics($dir1, $picLB, @sel); selectThumb($picLB, $childs2[-1]); @sel = $picLB->info('selection'); movePics($dir1, $picLB, @sel); openDirPost($dir1); @childs1 = $picLB->info('children'); if (@childs1 != 2) { warn "testSuite: *** move error ".scalar @childs1." ne 2\n"; } # test backup dir1 print "testSuite: testing backup all\n"; selectAll($picLB); @sel = $picLB->info('selection'); copyPics($dir1, BACKUP, $picLB, @sel); @childs1 = $picLB->info('children'); if (@childs1 != 4) { warn "testSuite: *** backup error ".scalar @childs1." ne 4\n"; } # test delete backups dir1 selectBak(); @sel = $picLB->info('selection'); warn "testSuite: *** sel error ".scalar @sel." ne 2\n" if (@sel != 2); deletePics($picLB, TRASH); @childs1 = $picLB->info('children'); warn "testSuite: *** delete backup error ".scalar @childs1." ne 2\n" if (@childs1 != 2); # move the two pics back dir1 -> dir2 print "testSuite: testing move back\n"; selectAll($picLB); @sel = $picLB->info('selection'); warn "testSuite: *** sel error ".scalar @sel." ne 2\n" if (@sel != 2); movePics($dir2, $picLB, @sel); @childs1 = $picLB->info('children'); if (@childs1 != 0) { warn "testSuite: *** delete backup error ".scalar @childs1." ne 0\n"; } # check if nothing is lost openDirPost($dir2); @childs2 = $picLB->info('children'); warn "testSuite: *** we lost some pics ".scalar @childs2." ne ".scalar @childs."\n" if (@childs2 != @childs); warn "testSuite: move ".scalar @childs2." = ".scalar @childs."?\n"; # link all pics dir2 -> dir1 print "testSuite: testing link all\n"; openDirPost($dir2); @childs2 = $picLB->info('children'); selectAll($picLB); @sel = $picLB->info('selection'); linkPics($dir1, @sel); @childs2 = $picLB->info('children'); openDirPost($dir1); @childs1 = $picLB->info('children'); warn "testSuite: link ".scalar @childs2." = ".scalar @childs1."?\n"; if (@childs2 != @childs1) { warn "testSuite: *** link error ".scalar @childs2." ne ".scalar @childs1."\n"; } # clean dir1 print "testSuite: cleaning dir\n"; selectAll($picLB); deletePics($picLB, TRASH); # test comments first pic print "testSuite: testing comment single\n"; my $testcom = "xxxcccxxx1234ABC"; openDirPost($dir2); @childs2 = $picLB->info('children'); selectThumb($picLB, $childs2[0]); @sel = $picLB->info('selection'); addCommentToPic($testcom, $sel[0], TOUCH); my $com = getComment($sel[0], LONG); if ($com !~ m/.*$testcom.*/) { warn "testSuite: *** comment $com does not contain $testcom\n"; } # test comments join print "testSuite: testing comments remove and join\n"; # add a comment to all pics selectAll($picLB); @sel = $picLB->info('selection'); addCommentToPic($testcom, $_, TOUCH) foreach (@sel); # remove the comments from the last pic, so we have at least one example for no comment selectThumb($picLB, $childs2[-1]); removeAllComments(NO_ASK); warn "testSuite: *** remove comment error\n" if (scalar getComments($childs2[-1]) != 0); selectAll($picLB); my %comNr; # hash: key:dpic value:nr of comments foreach (@childs2) { my @com = getComments($_); $comNr{$_} = scalar @com; } joinComments(NO_ASK); foreach (@childs2) { my @com = getComments($_); my $nr = $comNr{$_}; $nr = 1 if ($nr >= 2); print $comNr{$_}." -> $nr act: ".scalar @com."($#com)\n" if $verbose; warn "testSuite: *** comment join error\n" if ($nr != @com); } # test rotate print "testSuite: testing rotate single\n"; selectThumb($picLB, $childs2[0]); rotate(90); rotate(270); my $size = getFileSize($childs2[0]); rotate(90); rotate(270); warn "testSuite: *** rotate single file mismatch!\n" if ($size != getFileSize($childs2[0])); @childs2 = $picLB->info('children'); warn "testSuite: *** rotate all 90 ".scalar @childs2." ne ".scalar @childs."\n" if (@childs2 != @childs); ################################################## print "testSuite: going back to start dir\n"; openDirPost($startdir); changeDir($startdir); # linking files changes the cwd so we must move back before we try to remove the dirs # end $top->messageBox(-icon => 'info', -message => "test suite finished", -title => "test suite", -type => 'OK'); # cleanup foreach ($dir1, $dir2) { print "testSuite: removing temp dir $_\n"; rmtree($_, 0, 1) if (-d $_); # dir, 0 = no message for each file, 1 = skip write protected files } } ############################################################## # addToCachedPics - add a image (path and file name) to # the cachedPics list # if it is already in the list, move it to # the end ############################################################## sub addToCachedPics { my $dpic = shift; for my $t ( 0 .. $#cachedPics ) { if ($cachedPics[$t] eq $dpic) { splice @cachedPics, $t, 1; # remove it from list last; } } push @cachedPics, $dpic; # add item to the list print "addToCachedPics: $dpic list:$#cachedPics\n" if $verbose; checkCachedPics(); } ############################################################## # checkCachedPics - check if the cachedPics list contains more # images than allowed, remove the oldest # if necessary ############################################################## sub checkCachedPics { # first check if all entries are valid pictures my @rm_list; for my $t ( 0 .. $#cachedPics ) { push @rm_list, $t unless (-f $cachedPics[$t]); } # remove the invalid pictures for my $t (reverse @rm_list) { my $dpic = $cachedPics[$t]; next unless ($dpic); print "checkCachedPics: removing not existing $dpic\n" if $verbose; $c->delete('withtag', $dpic); # remove it from the canvas $photos{$dpic}->delete if $photos{$dpic}; # delete the photo object delete $photos{$dpic}; # delete the hash item splice @cachedPics, $t, 1; # remove not existing pictures it from list } # short the list, if it is to long while (@cachedPics > $config{MaxCachedPics}) { if ($actpic eq $cachedPics[0]) { print "this is the aktual pic - skipping!\n" if $verbose; next; } my $dpic = shift @cachedPics; # get the oldest print "checkCachedPics: removing old $dpic list:$#cachedPics\n" if $verbose; $c->delete('withtag', $dpic); # remove it from the canvas $photos{$dpic}->delete if $photos{$dpic}; # delete the photo object delete $photos{$dpic}; # delete the hash item } #printlist(@cachedPics); # just for safety warn "*** checkCachedPics: photos hash contains more than MaxCachedPics pics (".scalar @cachedPics."(".scalar(keys(%photos)).") > ".$config{MaxCachedPics}.")" if (keys %photos > $config{MaxCachedPics}); } ############################################################## # renameCachedPic - rename a list item ############################################################## sub renameCachedPic($$) { my $old = shift; my $new = shift; return unless (defined $photos{$old}); # open new photo object $photos{$new} = $top->Photo; $photos{$new}->blank; $photos{$new}->copy($photos{$old}); $c->delete('withtag', $old); # remove it from the canvas $photos{$old}->delete if $photos{$old}; # delete the photo object delete $photos{$old}; # delete the hash item my $xoffset = 0; my $yoffset = 0; $xoffset = int(($c->width - $photos{$new}->width) /2) if ($c->width > $photos{$new}->width); $yoffset = int(($c->height - $photos{$new}->height)/2) if ($c->height > $photos{$new}->height); # hide all items on the canvas canvasHide(); # insert pic my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$new}, -tag => ["pic", $new], -anchor => "nw"); bindItem($id); for my $t ( 0 .. $#cachedPics ) { if ($cachedPics[$t] eq $old) { $cachedPics[$t] = $new; # rename list item } } print "renameCachedPic: $old -> $new\n" if $verbose; checkCachedPics(); } ############################################################## # deleteCachedPics - delete all or just one element(s) # and photo objects of the cachedPics list ############################################################## sub deleteCachedPics { my $dpic = shift; # optional, if available this picture will be removed from the cachedPics list, # if not available all elements will be deleted if (defined($dpic) and isInList($dpic, \@cachedPics)) { print "deleteCachedPics: delete single pic $dpic (".scalar @cachedPics.")\n" if $verbose; $c->delete('withtag', $dpic); # remove it from the canvas $photos{$dpic}->delete if $photos{$dpic}; # delete the photo object delete $photos{$dpic}; # delete the hash item #printlist(@cachedPics); my @list = @cachedPics; # copy list @cachedPics = (); # empty list foreach my $i (reverse 0 .. $#list) { unless ($list[$i] eq $dpic) { print "deleteCachedPics: adding $list[$i]\n" if $verbose; push @cachedPics, $list[$i]; } } } else { print "deleteCachedPics: delete all (".scalar @cachedPics.")\n" if $verbose; foreach (@cachedPics) { $c->delete('withtag', $_); # remove it from the canvas $photos{$_}->delete if $photos{$_}; # delete the photo object delete $photos{$_}; # delete the hash item print "deleteCachedPics: deleting pic $_\n" if $verbose; } @cachedPics = (); # empty list } } ############################################################## # showSelectedPic - displays the original picture of the # selected thumbnail ############################################################## sub showSelectedPic { return if (stillBusy()); # block, until last picture is loaded my @sellist = $picLB->info('selection'); # show index number in window showNrOf(); return unless ($picLB->info('children')); return if (@sellist > 1); showPic($sellist[0]); } ############################################################## # showNrOf ############################################################## sub showNrOf { my @pics = $picLB->info('children'); my @sellist = $picLB->info('selection'); my $index = 0; my $size = 0; my $sizeStr = ""; if (@sellist >= 1) { # selection available foreach (@pics) { $index++; last if ($_ eq $sellist[0]); } } if (@sellist >= 2) { # more than one selected foreach (@sellist) { $size += getFileSize($_, NO_FORMAT); } $sizeStr = computeUnit($size) if $size; $sizeStr = ", $sizeStr" if ($sizeStr ne ""); } # show index number in window $nrof = "$index/".@pics." (".@sellist."$sizeStr)"; } ############################################################## # computeUnit - do a byte to kB or MB conversion ############################################################## sub computeUnit { my $size = shift; my $sizeStr; $size = int($size/1024); # KiloByte if ($size > 1024) { # MegaByte if ($size > 1024*1024) { # GigaByte if ($size < (1024*1024*100)) { # less than 100GB $size = int($size*10/(1024*1024))/10; # e.g. 6.9GB or 23.4GB } else { $size = int($size/(1024*1024)); # e.g. 104GB } $sizeStr = "${size}GB"; } else { if ($size < (1024*100)) { # less than 100MB $size = int($size*10/1024)/10; # e.g. 6.9MB or 23.4MB } else { $size = int($size/1024); # e.g. 104MB } $sizeStr = "${size}MB"; } } else { $sizeStr = "${size}kB"; } return $sizeStr; } ############################################################## # showPic - displays the picture with the given index $i ############################################################## sub showPic { my $dpic = shift; my @pics = $picLB->info('children'); return if ((!defined $dpic) or (!@pics)); if (@pics < 1) { warn "no pictures in picLB!" if $verbose; $userinfo = "no JPEG pictures in dir $actdir"; $userInfoL->update; return; } $actpic = $dpic; return if ((!defined $actpic) or ($actpic eq "")); setTitle(); # show EXIF info and comment showImageInfo($dpic); my $pic = basename($dpic); # select thumb in list even if picture is not shown (see "ShowPic" below) selectThumb($picLB, $dpic); return if (!$config{ShowPic}); # we are still not able to display RAW pictures (nefextract may be a solution for NEFs) return if ($dpic =~ m/.*\.(nef)|(raw)$/i); # do not show a picture if there is no picture frame if (!$config{ShowPicFrame}) { $userinfo = "$pic not displayed - no picture frame (hint: try F9 or F11)"; $userInfoL->update; return; } # do not show a picture if the frame is very small if ($mainF->width < 200) { $userinfo = "$pic not displayed (picture frame too small)"; $userInfoL->update; return; } $showPicInAction = 1; $balloon->detach($c); # clear the balloon info for the actual pic (right frame of main window) $userinfo = "loading $pic ..."; $userInfoL->update; my @ids = $c->find('withtag', $dpic); my $id; if (@ids > 0) { # pic is already loaded print "showPic: using cached pic $dpic\n" if $verbose; # hide all items on the canvas canvasHide(); $c->itemconfigure($ids[0], -state => 'normal'); $id = $ids[0]; $top->update(); } else { print "showPic: loading pic $dpic\n" if $verbose; if (-f $dpic) { # load pic $top->Busy(); #my $dpic_jpg = ""; #if ($dpic =~ m/(.*)\.nef$/i) { # $dpic_jpg = $1.".jpg"; # print "$dpic is a NEF -> $dpic_jpg\n"; # my $command = "nefextract \"$dpic\" > \"$dpic_jpg\" "; # execute($command); #} #if (-f $dpic_jpg) { # load pic # $photos{$dpic} = $top->Photo(-file => $dpic_jpg, -gamma => $config{Gamma}); # zoom pic # autoZoom(\$photos{$dpic}, $dpic_jpg, $c->width, $c->height); #} #else { # load pic $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); # zoom pic autoZoom(\$photos{$dpic}, $dpic, $c->width, $c->height) if (exists $photos{$dpic} and $config{AutoZoom}); #} if (exists $photos{$dpic}) { # center pic in canvas, only when it's smaller my $xoffset = 0; my $yoffset = 0; $xoffset = int(($c->width - $photos{$dpic}->width) /2) if ($c->width > $photos{$dpic}->width); $yoffset = int(($c->height - $photos{$dpic}->height)/2) if ($c->height > $photos{$dpic}->height); # hide all items on the canvas canvasHide(); # insert pic $id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -tag => ['pic',"$dpic"], -anchor => 'nw'); bindItem($id); addToCachedPics($dpic); } else { $userinfo = "error loading $actpic"; $userInfoL->update; warn "showPic: error loading $actpic!" if $verbose; } $top->Unbusy(); addToCachedPics($dpic); } else { canvasHide(); warn "showPic: error $actpic not available!" if $verbose; } } # show zoom info showZoomInfo($dpic, $id); showImageInfoCanvas($dpic); increasePicPopularity($dpic); updateOneRow($dpic, $picLB) if ($config{trackPopularity}); if ($config{ShowPicInfo}) { # balloon info for displayed picture (right frame of the main window) my $balloonmsg = makeBalloonMsg($dpic); # bind the balloon to the canvas $balloon->attach($c->Subwidget('canvas'), -balloonposition => 'mouse', -msg => {"pic" => $balloonmsg} ); } else { $balloon->detach($c->Subwidget('canvas')); } $userinfo = "$pic"; $userInfoL->update; # adjust the canvas scrollbars my ($x1, $y1, $x2, $y2) = $c->bbox($id); if (defined($x1) and defined($x2) and defined($y1) and defined($y2)) { $c->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]); } $top->Unbusy(); $showPicInAction = 0; } ############################################################## # canvasHide ############################################################## sub canvasHide { # hide all items on the canvas $c->update(); #$c->itemconfigure('all', -state => 'hidden'); #$c->itemconfigure('withtag', 'pic', -state => 'hidden'); foreach ($c->find('withtag', 'pic')) { $c->itemconfigure($_, -state => 'hidden'); } } ############################################################## # setTitle - set the window title and the userinfo to the # actual pic ############################################################## sub setTitle { my $title = ""; $title = basename($actpic)." - " if ((defined $actpic) and ($actpic ne "") and (-f $actpic)); $title .= "MaPiVi $version"; # just a little gag my (undef,undef,undef,$d,$m,$y,undef,undef, undef,undef) = localtime(time()); $y += 1900; $m++; $title .= " - Happy new year $y!" if ($d == 1 and $m == 1); $top->title($title); $userinfo = basename($actpic); $userInfoL->update; } ############################################################## # increasePicPopularity ############################################################## sub increasePicPopularity { return unless ($config{trackPopularity}); my $dpic = shift; if (defined $searchDB{$dpic}{POP}) { $searchDB{$dpic}{POP}++; } else { $searchDB{$dpic}{POP} = 1; } print "$dpic has been shown $searchDB{$dpic}{POP} times.\n" if $verbose; } ############################################################## # showMostPopularPics - display the Top 100 of the best rated pics ############################################################## sub showMostPopularPics { # open window my $win = $top->Toplevel(); $win->title('Best rated pictures - TOP 100'); $win->iconimage($mapiviicon) if $mapiviicon; my $text = "searching ..."; $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 3, -scrollbars => 'osoe', -selectmode => 'extended', -background => $config{ColorBG}, #8fa8bf -width => 100, -height => 60, )->pack(-expand => 1, -fill => "both"); bindMouseWheel($tlb); $tlb->header('create', 0, -text => 'Place', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 1, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 2, -text => 'Info', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $Xbut = $butF->Button(-text => 'Close', -command => sub { $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { selectAll($tlb); } ); $win->bind('', sub { return if (!$tlb->info('children')); my $dpic = getNearestItem($tlb); showPicInOwnWin($dpic); }); $win->Popup(-popover => 'cursor'); repositionWindow($win); my @populatity_list = sort { my $urga = 0; $urga = $searchDB{$a}{URG} if (defined $searchDB{$a}{URG}); $urga = 9 if ($urga == 0); my $urgb = 0; $urgb = $searchDB{$b}{URG} if (defined $searchDB{$b}{URG}); $urgb = 9 if ($urgb == 0); $urga <=> $urgb; } keys %searchDB; # my @populatity_list = sort { # my $popa = 0; # $popa = $searchDB{$a}{POP} if (defined $searchDB{$a}{POP}); # my $popb = 0; # $popb = $searchDB{$b}{POP} if (defined $searchDB{$b}{POP}); # $popb <=> $popa; # } keys %searchDB; $win->update(); $text = "loading ..."; my %thumbs; foreach my $nr (0 .. 99) { my $dpic = $populatity_list[$nr]; my $num = $nr + 1; my $pic = basename($dpic); my $path = dirname($dpic); my $thumb = getThumbFileName($dpic); $tlb->add($dpic); $text = "loading $num ..."; $tlb->itemCreate($dpic, 0, -text => $num, -style => $comS); if (-f $thumb) { $thumbs{$thumb} = $top->Photo(-file => $thumb, -gamma => $config{Gamma}); if (defined $thumbs{$thumb}) { $tlb->itemCreate($dpic, 1, -image => $thumbs{$thumb}, -itemtype => 'imagetext', -style => $thumbS); } } my $pop = 0; $pop = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP}); my $urg = 0; $urg = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG}); $tlb->itemCreate($dpic, 2, -text => "$pic\n$path\nRating: $urg\n(viewed $pop times)", -style => $fileS); } $text = "Ready"; $win->waitWindow; foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory } ############################################################## # stopWatchStart ############################################################## my $stopWatchTime; sub stopWatchStart { $stopWatchTime = Tk::timeofday(); } ############################################################## # stopWatchStop ############################################################## sub stopWatchStop { my $text = ''; $text = shift; printf "stopWatch: %.5f secs ($text)\n", (Tk::timeofday() - $stopWatchTime); } ############################################################## # selectThumb ############################################################## sub selectThumb { my $lb = shift; my $index = shift; $lb->selectionClear(); return unless (defined $index); unless ($lb->info("exists", $index)) { warn "selectThumb: $index is not availabel!" if $verbose; return; } $lb->selectionSet($index); $lb->anchorSet($index); $lb->see($index); $lb->update; if ($config{CenterThumb}) { my $next = $lb->info('next', $index); my $prev = $lb->info('prev', $index); $lb->see($prev) if ($prev); $lb->update; $lb->see($next) if ($next); } showNrOf(); } ############################################################## # selectAll ############################################################## sub selectAll { my $lb = shift; my @pics = $lb->info('children'); return unless (@pics); $lb->selectionSet($pics[0], $pics[-1]); showNrOf() if ($lb == $picLB); } ############################################################## # selectBak ############################################################## sub selectBak { $picLB->selectionClear(); my @pics = $picLB->info('children'); foreach (@pics) { if ($_ =~ m/.*-bak\.jp(g|eg)$/i) { $picLB->selectionSet($_); } } showNrOf(); if (!defined $picLB->info('selection')) { $top->messageBox(-icon => 'info', -message => "Nothing selected!\nThere are no file names matching the pattern: \"*-bak.jp(e)g\".", -title => "No backups", -type => 'OK'); } } ############################################################## # selectInv ############################################################## sub selectInv { my @sellist = $picLB->info('selection'); $picLB->selectionClear(); my @pics = $picLB->info('children'); foreach (@pics) { if (!isInList($_, \@sellist)) { $picLB->selectionSet($_); } } showNrOf(); } ############################################################## # getThumbFileName - return the location of the corresponding # thumbnail file (full path) ############################################################## sub getThumbFileName($) { my $dpic = shift; my $dir = dirname( $dpic); my $pic = basename($dpic); # normalize the path $dir =~ s!\\!\/!g; # replace Windows path delimiter with UNIX style \ -> / #$dir =~ s/\\/\//g; # replace Windows path delimiter with UNIX style \ -> / if (defined $thumbDBhash{$dir}) { return $thumbDBhash{$dir}."/$pic"; } #$dir =~ s!^([a-z]:)/!$1\\!i if $EvilOS; # replace E:/ with E:\ else Win will fire an error message that E: is not mounted my @thumbDirNoNos = qw( /mnt/cdrom /mnt/dvd ); # todo my $thumbDB = "$configdir/thumbDB"; my $thumbdir = "$dir/$thumbdirname"; # central thumbDB if (($config{CentralThumbDB}) or # config option set to central thumbdir (!-d $dir) or # if the folder is not mounted/available ((-d $thumbdir) and (!-w $thumbdir)) or # or .thumbdir exists but is write protected (-f "$dir/.nothumbs") or # or file .nothumbs is found ((!-w $dir) and (!-d $thumbdir))) { # or dir is write protected but there is no .thumbdir if ($EvilOS) { # in windows we have to get rid of the device names (C:\ d:/ etc.) print "getThumbFileName: $dir " if $verbose; $dir =~ s!^[a-z]:/!!i; # for slash $dir =~ s!^[a-z]:\\!!i; # for backslash print "-> $dir\n" if $verbose; } else { # for other OS (Linux etc.) we cut off special parts foreach (@thumbDirNoNos) { if ($dir =~ /^$_/) { print "getThumbFileName: $dir " if $verbose; $dir =~ s/^$_//; # cut off unwanted dir part e.g. /mnt/cdrom print "-> $dir\n" if $verbose; last; # one is enough } } } $thumbdir = "$thumbDB/$dir"; $thumbdir =~ s/\/+/\//g; # replace multiple slashes with one // -> / } $thumbDBhash{$dir} = $thumbdir; # store for quicker response my $thumb = "$thumbdir/$pic"; # add the pic name return $thumb; } ############################################################## # generateThumbs - generate thumbnails for each picture # remove outdated thumbs ############################################################## sub generateThumbs { print "generateThumbs\n" if $verbose; my $ask = shift; # ASK = ask the user befor making a thumbnail dir, NO_ASK my $show = shift; # SHOW = show the generated thumbs in $picLB, NO_SHOW my $getpics = shift; # optional bool, get the pics with getpics not from the listbox my ($pic, $dpic, $lpic, $thumb, $string); my $nrofprocs = 0; my @pics; if ((defined $getpics) and ($getpics == 1)) { @pics = getPics($actdir, WITH_PATH); # if the thumbs won't be shown, no need to sort sortPics($config{SortBy}, $config{SortReverse}, \@pics) if ($show == SHOW); } else { @pics = $picLB->info('children'); # this should be much faster than getPics($actdir); } # remove outdated thumbs and exif data cleanSubDirs($actdir); return if (@pics <= 0); my $thumbdir = dirname(getThumbFileName("$actdir/dummy.jpg")); return if (!makeDir("$thumbdir", $ask)); # if thumb dir is not writeable if (!-w $thumbdir) { $top->messageBox(-icon => 'warning', -message => "$thumbdir is not writeable, so mapivi is not able to generate thumbnails", -title => "No write access", -type => 'OK'); return; } # look what's to do $nrToConvert = 0; foreach $lpic (@pics) { $dpic = $lpic; next if (!getRealFile(\$dpic)); $thumb = getThumbFileName($lpic); if (aNewerThanb($dpic, $thumb)) { $nrToConvert++; # count the nr of thumbs to generate/refresh } } return if ($nrToConvert == 0); # nothing to do # ask the user, if he wants to update the thumbs now if ($config{AskGenerateThumb}) { my $rc = checkDialog("Generate thumbnails?", "There are $nrToConvert thumbnails to generate.\nShall I do this now?", \$config{AskGenerateThumb}, "ask every time", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); } my $pre = makeCommandString(\%config); # generate thumbs my $i = 0; # pic list index foreach $lpic (@pics) { $dpic = $lpic; next if (!getRealFile(\$dpic)); $pic = basename($dpic); $thumb = getThumbFileName($lpic); if (!aNewerThanb($dpic, $thumb)) { $i++; next; } if (-z $dpic) { # file is empty (size zero) $top->messageBox(-icon => 'warning', -message => "$pic is an empty file. Skipping.", -title => 'Error', -type => 'OK'); $i++; next; } removeFile($thumb); # try to get the EXIF thumbnail if ($config{UseEXIFThumb}) { my $errors = ""; extractThumb($dpic, $thumb, \$errors); } # found a EXIF thumbnail -> show it if (-f $thumb) { # here we increase the process counter, just because ... proccount(1); # ... in updateOneThumb it will be decreased updateOneThumb($thumb, $lpic, $show); $i++; next; } # thumbnail is always in JPEG format, but the suffix of the picture is not changed $string = "$pre \"$dpic\" JPEG:\"$thumb\" "; print "command: $string\n" if $verbose; if (!$EvilOS) { # running on a "good" OS like Linux we can use background processes :) # start a background process for each pic my $fh = Tk::IO->new(-linecommand => \&nop, -childcommand => [\&updateOneThumb, $thumb, $dpic, $show]); #$hiresstart = [gettimeofday]; # hires - measure the loading time $fh->exec($string); proccount(1); # count processes $nrofprocs = proccount(); if ($nrofprocs >= $config{MaxProcs}) { # waiting for current process to finish $fh->wait(); } } else { # we run on a evil OS like windows - no threading :( proccount(1); # count processes (system "$string") == 0 or warn "$string failed: $!"; updateOneThumb($thumb, $lpic, $show); } $i++; } print "...done\n" if $verbose; } ############################################################## # generateOneThumb ############################################################## sub generateOneThumb { my $dpic = shift; my $pre = makeCommandString(\%config); my $thumb = getThumbFileName($dpic); my $string = "$pre \"$dpic\" JPEG:\"$thumb\" "; execute($string); } ############################################################## # cleanSubDirs - remove thumbs and exif infos without a # corresponding picture ############################################################## sub cleanSubDirs { my $dir = shift; my $thumbdir = dirname(getThumbFileName("$dir/dummy.jpg")); my $exifdir = "$dir/$exifdirname"; my $pic; return if (!-d $dir); # clean thumb and exif dir foreach my $subdir ($thumbdir, $exifdir) { if (-d $subdir) { my @subpics = getPics($subdir, JUST_FILE); # no sort needed foreach $pic (@subpics) { if (!-f "$dir/$pic") { removeFile("$subdir/$pic"); } } } } } ############################################################## # makeCommandString - build up the command string for the # generation of thumbnails depending on # the settings in the given config hash ############################################################## sub makeCommandString { my $conf = shift; my $pre = ""; $pre = " montage -size $conf->{'ThumbSize'}x$conf->{'ThumbSize'} -geometry $conf->{'ThumbSize'}x$conf->{'ThumbSize'}+$conf->{'ThumbBorder'}+$conf->{'ThumbBorder'} -quality $conf->{'ThumbQuality'} -background \"$conf->{'ColorThumbBG'}\" "; #$pre .= "-frame $conf->{'ThumbBorder'}x$conf->{'ThumbBorder'} " if $conf->{UseThumbFrame}; $pre .= "-shadow " if $conf->{UseThumbShadow}; # ! Sharpen is the most time consuming option, when building thumbnails! if ($conf->{ThumbSharpen} > 0) { $pre .= "-sharpen $conf->{'ThumbSharpen'} " # the higher the value the slower } return $pre; } ############################################################## # light_table_open_window ############################################################## sub light_table_open_window { if (Exists($ltw)) { $ltw->deiconify; $ltw->raise; $ltw->focus; return; } # open window $ltw = $top->Toplevel(); $ltw->title('Mapivi Light table'); $ltw->iconimage($mapiviicon) if $mapiviicon; $ltw->bind('', sub {light_table_close(ASK);}); $ltw->bind('', sub {light_table_close(ASK);}); $ltw->bind('', sub {light_table_select_all();}); # window resize event $ltw->bind("" => sub { # if there is a timer running cancel it $ltw->{LAST_RESIZE_TIMER_MH}->cancel if ($ltw->{LAST_RESIZE_TIMER_MH}); $ltw->{LAST_RESIZE_MH} = Tk::timeofday; # after 200 msec we reorder the thumbnails according to the new geometry to give a preview $ltw->{LAST_RESIZE_TIMER_MH} = $ltw->after(200, sub { light_table_reorder(); }); }); # call quitMain when the window is closed by the window manager $ltw->protocol("WM_DELETE_WINDOW" => sub { light_table_close(ASK); }); $ltw->{menu} = $ltw->Menu; $ltw->configure(-menu => $ltw->{menu}); my $file_menu = $ltw->{menu}->cascade(-label => "Slideshow"); $file_menu->cget(-menu)->configure(-title => "Slideshow menu"); #$file_menu->command(-label => "Rename pics ...", -command => sub { rename_pics(); }); $file_menu->command(-label => "Open ...", -command => sub { light_table_open(RESET); }); $file_menu->command(-label => "Show selected pictures", -command => sub { my @sel = getSelection($ltw->{canvas}); show_multiple_pics(\@sel, 0);}); $file_menu->command(-label => "Add list ...", -command => sub { light_table_open(ADD); }); $file_menu->command(-label => "Save", -command => sub { if ((defined $ltw->{file}) and (-f $ltw->{file})) { light_table_save($ltw->{file}); } }); $file_menu->command(-label => "Save as ...", -command => sub { light_table_save_as(); }); $file_menu->command(-label => "Clear", -command => sub { undef @light_table_list; light_table_clear(); }); $file_menu->command(-label => "Update", -command => sub { light_table_reorder(); }); $file_menu->command(-label => "Close", -command => sub { light_table_close(NO_ASK); }); my $sort_menu = $ltw->{menu}->cascade(-label => 'Sort'); $sort_menu->command(-label => 'file name (A - Z)', -command => sub { $ltw->Busy; sortPics('name', 0, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); $sort_menu->command(-label => 'file name (Z - A)', -command => sub { $ltw->Busy; sortPics('name', 1, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); $sort_menu->command(-label => 'EXIF date (new first)', -command => sub { $ltw->Busy; sortPics('exifdate', 0, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); $sort_menu->command(-label => 'EXIF date (old first)', -command => sub { $ltw->Busy; sortPics('exifdate', 1, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); $sort_menu->command(-label => 'IPTC urgency/rating (high first)', -command => sub { $ltw->Busy; sortPics('urgency', 0, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); $sort_menu->command(-label => 'IPTC urgency (low first)', -command => sub { $ltw->Busy; sortPics('urgency', 1, \@light_table_list); $ltw->Unbusy; light_table_reorder(); }); my $opt_menu = $ltw->{menu}->cascade(-label => "Options"); $ltw->{show_balloon} = 1; # todo: move to config hash $ltw->{show_status} = 1; # todo: move to config hash $opt_menu->checkbutton(-label => "show balloon info", -variable => \$ltw->{show_balloon}, -command => sub { light_table_balloon();}); $opt_menu->checkbutton(-label => "show status line", -variable => \$ltw->{show_status}, -command => sub { light_table_status();}); $ltw->{status_line} = $ltw->Label(-textvariable => \$ltw->{label}); $ltw->{frame} = $ltw->Scrolled('Canvas', -scrollbars => 'oe', -confine => 1, -xscrollincrement => 117, -yscrollincrement => 117, -height => 570, -width => 370, -relief => 'flat', -borderwidth => 0, -highlightthickness => 0, )->pack(-fill =>'both', -expand => 1, -padx => 3, -pady => 3); #bindMouseWheel($ltw->{frame}); light_table_status(); $ltw->{canvas} = $ltw->{frame}->Subwidget('canvas'); my $context_menu = $ltw->Menu(-title => "Context Menu"); $ltw->bind('', sub { $context_menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $ltw->bind('', sub {light_table_delete(); }); $context_menu->command(-image => compound_menu($top, 'move selected to top', 'go-first.png'), -command => sub { light_table_shift('top'); }); $context_menu->command(-image => compound_menu($top, 'move selected to bottom', 'go-first.png'), -command => sub { light_table_shift('bottom'); }); $context_menu->separator; $context_menu->command(-label => 'remove selected from light table', -accelerator => "", -command => sub { light_table_delete(); }); $context_menu->command(-label => 'copy and rename selected', -command => sub { light_table_copy_rename(); }); $context_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($ltw->{canvas}); }); $context_menu->separator; $context_menu->command(-label => 'montage/index print ...', -command => sub { my @pics = getSelection($ltw->{canvas}); indexPrint(\@pics); }); $context_menu->separator; $context_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'), -command => sub { openPicInViewer($ltw->{canvas}); }); #$context_menu->command(-label => 'Show in external viewer', # -command => sub { openPicInViewer($ltw);(); }); #$context_menu->command(-label => 'Add pics', -command => sub { add_pics(); }); $ltw->{thumb_distance} = 5; # in pixels $ltw->{thumb_size} = 108; # in pixels todo $ltw->Popup; checkGeometry(\$config{LtwGeometry}); $ltw->geometry($config{LtwGeometry}); } ############################################################## # light_table_status ############################################################## sub light_table_status { if ($ltw->{show_status}) { $ltw->{status_line}->pack(-before => $ltw->{frame} ,-fill => 'x'); } else { $ltw->{status_line}->packForget; } } ############################################################## # light_table_open ############################################################## sub light_table_open { my $mode = shift; # must be ADD or RESET my $text = 'Open'; $text = 'Add to' if ($mode == ADD); my $fileSelect = $ltw->FileSelect(-title => "$text slideshow", -initialfile => "slideshow.sld", -create => 0, -directory => $config{SlideShowDir}, -width => 30, -height => 30); my $file = $fileSelect->Show; return unless (defined $file); return if ($file eq ''); return unless (-f $file); unless (-T $file) { $ltw->messageBox(-icon => 'warning', -message => 'Please select a valid slideshow (ASCII) file.', -title => 'Wrong file type', -type => 'OK'); return; } $config{SlideShowDir} = dirname($file) if (-d dirname($file)); my $fh; if (!open($fh, "<$file")) { warn "open slideshow: Couldn't open $file: $!"; return; } if ($mode == RESET) { # reset list and clean up canvas undef @light_table_list; light_table_clear(); } my @pics; my $pic_number = 0; my $errors = ''; my $double = ''; my $double_count = 0; while (<$fh>) { chomp; # no newline if ($_ =~ m|\"(.*)\"|) { # match just quoted lines $pic_number++; my $dpic; # $dpic may also have a relative path! if ($filespecAvail) { $dpic = File::Spec->rel2abs($1, dirname($file)); } print "found $dpic - " if $verbose; if (-f $dpic) { print "file\n" if $verbose; if (isInList($dpic, \@light_table_list)) { $double .= "$dpic\n"; $double_count++; } else { push @pics, $dpic; } } else { print "no file\n" if $verbose; $errors .= "error: $dpic not found! (number: $pic_number)\n"; } } else { $errors .= "info: ignoring line $_\n"; } } close $fh; $errors .= "\nadded ".scalar @pics." of $pic_number pictures!\n"; # add pics to end of global list push @light_table_list, @pics; # add new pictures to light table light_table_add_list(\@pics); $ltw->{label} = scalar @light_table_list.' pictures'; if (($errors ne '') or ($double_count > 0)) { my $text; $text = "These $double_count pictures are already in the slideshow and have been skipped:\n$double\n\n" if ($double_count > 0); $text .= "Information and errors while reading $file:\n$errors" if ($errors ne ''); showText("Information and Errors", $text, NO_WAIT); } if ($mode == RESET) { $ltw->title('Light table: '.basename($file)); $ltw->{file} = $file; } } ############################################################## # light_table_save_as ############################################################## sub light_table_save_as { my $fileSelect = $ltw->FileSelect(-title => "Save as (use .sld suffix)", -initialfile => "slideshow.sld", -create => 1, -directory => $config{SlideShowDir}, -width => 30, -height => 30); my $file = $fileSelect->Show; return unless (defined $file); return if ($file eq ''); $config{SlideShowDir} = dirname($file) if (-d dirname($file)); if (-f $file) { my $rc = $ltw->messageBox(-icon => 'warning', -message => "Slideshow file $file exist.\nOk to overwrite?", -title => "Overwrite slideshow?", -type => "OKCancel"); return if ($rc !~ m/Ok/i); } my $rc = 0; # open window my $win = $top->Toplevel(); $win->title('Save slideshow options'); $win->iconimage($mapiviicon) if $mapiviicon; $win->Checkbutton(-variable => \$config{relative_path}, -text => "Use relative file paths")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_loop}, -text => "Loop slide show")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_fullscreen}, -text => "Full screen display")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_title}, -text => "Show title bar")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_filename}, -text => "Show file name")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_mouse}, -text => "Hide mouse")->pack(-anchor=>'w'); $win->Checkbutton(-variable => \$config{xnview_random}, -text => "Random order")->pack(-anchor=>'w'); my $but_frame = $win->Frame()->pack(-fill =>'x'); my $ok_but = $but_frame->Button(-text => 'OK', -command => sub { $rc = 1; $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); my $x_but = $but_frame->Button(-text => 'Cancel', -command => sub { $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); $win->Popup(-popover => 'cursor'); repositionWindow($win); $win->waitWindow; return unless ($rc); light_table_save($file); } ############################################################## # light_table_save ############################################################## sub light_table_save { my $file = shift; print "writing slideshow to $file\n" if $verbose; my $fh; if (!open($fh, ">$file")) { print "could not open $file for write access!: $!\n"; return; } my $xnview_slideshow_header = '# Slide Show Sequence View = 1 CenterWindow = 0 ReadErrors = 1 BackgroundColor = 0'; print $fh "$xnview_slideshow_header\n"; print $fh "Loop = $config{xnview_loop}\n"; print $fh "FullScreen = $config{xnview_fullscreen}\n"; print $fh "TitleBar = $config{xnview_title}\n"; print $fh "HideMouse = $config{xnview_mouse}\n"; print $fh "RandomOrder = $config{xnview_random}\n"; print $fh "ShowFilename = $config{xnview_filename}\n"; foreach my $dpic (@light_table_list) { my $rel = $dpic; if ($filespecAvail and $config{relative_path}) { $rel = File::Spec->abs2rel($dpic, dirname($file)); } print $fh "\"$rel\"\n"; print "\"$rel\"\n" if $verbose; } close $fh; $ltw->{label} = "wrote slideshow: ".basename($file); $ltw->title('Light table: '.basename($file)); $ltw->{file} = $file; } ############################################################## # light_table_close ############################################################## sub light_table_close { my $ask = shift; if ((defined $ask) and ($ask == ASK)) { my $rc = $ltw->messageBox(-icon => 'question', -message => "The slideshow will not be saved automatically.\nOK to close light table?", -title => "Close light table?", -type => 'OKCancel'); return unless ($rc =~ m/Ok/i); } undef @light_table_list; light_table_clear(); $config{LtwGeometry} = $ltw->geometry; $ltw->destroy(); } ############################################################## # light_table_clear ############################################################## sub light_table_clear { $ltw->{canvas}->delete('all'); # delete all photo objects (thumbnnails) foreach (keys %light_table_thumbs) { $light_table_thumbs{$_}->delete if (defined $light_table_thumbs{$_}); # delete photo object delete $light_table_thumbs{$_}; # delete hash entry } $ltw->{label} = scalar @light_table_list.' pictures'; $ltw->title('Mapivi Light table'); } ############################################################## # light_table_add_from_lb ############################################################## sub light_table_add_from_lb { my $lb = shift; my @sellist = $lb->info('selection'); light_table_add(\@sellist); } ############################################################## # light_table_add ############################################################## sub light_table_add { my $list_ref = shift; return unless checkSelection($top, 1, 0, $list_ref); # open light table window if needed light_table_open_window() unless (Exists($ltw)); my $error = ''; my $error_count = 0; my @list; # check for double pictures (not yet supported) foreach my $dpic (@$list_ref) { if (isInList($dpic, \@light_table_list)) { $error .= "$dpic\n"; $error_count++; } else { push @list, $dpic; } } if ($error ne '') { $error = "These $error_count pictures are already in the slideshow and have been skipped:\n\n".$error; showText('Ignored pictures', $error, NO_WAIT); } return unless (@list); # add selected pictures at end of slideshow list push @light_table_list, @list; # add selected pictures to light table light_table_add_list(\@list); } ############################################################## # light_table_add_list ############################################################## sub light_table_add_list { my $list_ref = shift; # list of JPEG pics with full path return if (@$list_ref < 1); # no pics to add # get thumb size info from first thumbnail in list (this may be wrong, as others may be bigger) my ($tw, $th) = getSize(getThumbFileName($$list_ref[0])); $ltw->{thumb_size} = $tw if ($tw > 1); my $i = 0; my $pw = progressWinInit($ltw, "Add pictures to light table"); foreach my $dpic (@$list_ref) { my $thumb = getThumbFileName($dpic); last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding picture ($i/".scalar @$list_ref.") ...", $i, scalar @$list_ref); if (-f $thumb) { # save all thumb photo objects in global hash %light_table_thumbs # to delete them later $light_table_thumbs{$dpic} = $ltw->Photo(-file => $thumb); } else { if ($config{UseDefaultThumb} and $defaultthumbP) { $light_table_thumbs{$dpic} = $defaultthumbP; } } if ($light_table_thumbs{$dpic}) { my $id = $ltw->{canvas}->createImage(0, 0, -image => $light_table_thumbs{$dpic}, -tag => ['THUMB_MH',$dpic], -anchor => 'nw'); # add bindings $ltw->{canvas}->bind($id,'', sub { light_table_select($id); }); $ltw->{canvas}->bind($id,'', sub {$ltw->{LOCK_MH} = 1; light_table_select_range();}); $ltw->{canvas}->bind($id,'', sub {$ltw->{LOCK_MH} = 1; light_table_select_add($id); }); $ltw->{canvas}->bind($id,'', sub { light_table_move($id); }); $ltw->{canvas}->bind($id,'', sub { return if ($ltw->{LOCK_MH}); light_table_drop($id); }); $ltw->{canvas}->bind($id,'', sub { $ltw->{LOCK_MH} = 0; }); $ltw->{canvas}->bind($id,'', sub { $ltw->{LOCK_MH} = 0; }); $ltw->{canvas}->bind($id,'', sub { showPicInOwnWin($dpic); }); #sub { show_multiple_pics($list_ref, 0); }); } } progressWinEnd($pw); light_table_reorder(); $ltw->{canvas}->yviewMoveto(1); $ltw->{label} = scalar @light_table_list.' pictures'; } ############################################################## # light_table_balloon ############################################################## sub light_table_balloon { if ($ltw->{show_balloon}) { my $msg; # the balloon message is generated on demand later, to speed up the loading of the thumbs $balloon->attach($ltw->{canvas}, -postcommand => sub { my @curr = $ltw->{canvas}->find('withtag', 'current'); my $dpic = get_path_from_id($curr[0]); $msg = makeBalloonMsg($dpic); }, -balloonposition => 'mouse', -msg => \$msg); } else { $balloon->detach($ltw->{canvas}); } } ############################################################## # light_table_reorder ############################################################## sub light_table_reorder { $ltw->update; #$ltw->Busy; # resizing the window does not work under windows if Busy is used my $dis = $ltw->{thumb_size} + $ltw->{thumb_distance}; # get canvas size my $cx = $ltw->{canvas}->width; my $cy = $ltw->{canvas}->height; # calc visible columns and rows my $c_cols = int($cx/$dis); $c_cols = 1 if ($c_cols < 1); # avoid division by zero my $c_rows = int($cy/$dis); # how many rows are needed for all pics? my $all_rows = int(@light_table_list / $c_cols); $all_rows++ if ((@light_table_list % $c_cols) != 0); # adjust scrollbar $ltw->{canvas}->configure(-scrollregion => [0, 0, $c_cols*$dis + $ltw->{thumb_distance}, $all_rows*$dis + $ltw->{thumb_distance}]); my $index = 0; foreach my $dpic (@light_table_list) { my $row = int ($index / $c_cols); my $col = $index % $c_cols; # modulo #print "reorder: $index col:$col row:$row $dpic\n"; # we move the thumbs by tag which is the path+file name # this excludes the possibility to have a pic twice in the list $ltw->{canvas}->coords($dpic, $col*$dis+$ltw->{thumb_distance}, $row*$dis+$ltw->{thumb_distance}); $index++; } light_table_update_selection(); $ltw->{label} = scalar @light_table_list.' pictures'; #$ltw->Unbusy; # resizing the window does not work under windows if Busy is used } ############################################################## # get_path_from_id ############################################################## sub get_path_from_id { my $id = shift; my @tags = $ltw->{canvas}->gettags($id); my $dpic = ''; foreach (@tags) { next if ($_ eq 'current'); next if ($_ =~ m/.*_MH/); # all my thumb tags are ending with _MH $dpic = $_; # so this must be the path with file name } if ($dpic eq '') { print "Error could not find path from item: "; print "$_ " foreach (@tags); print "\n"; } return $dpic; } ############################################################## # light_table_copy_rename ############################################################## sub light_table_copy_rename { # find all selected thumbs my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); return unless checkSelection($top, 1, 0, \@sel); my $rc = $ltw->messageBox(-icon => 'warning', -message => "Copy and rename the ".scalar @sel." selected pictures.\nThe pictures will be renamed by adding a leading number according to the current order.\npic.jpg will for example be renamed to: 000-pic.jpg.\n\nOk to proceed?", -title => "Copy and rename", -type => "OKCancel"); return if ($rc !~ m/Ok/i); my $targetdir = getDirDialog("Copy pictures to"); return if ($targetdir eq ""); return unless (-d $targetdir); makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); my $i = 0; $rc = 1; #my $digits = 3; # idea from Yann Michel my $digits = int(log(@sel)/log(10))+1; # calculate the needed digits dynamically my $pw = progressWinInit($ltw, "Copy and rename pictures"); foreach my $id (@sel) { my $dpic = get_path_from_id($id); last if progressWinCheck($pw); my $pic = basename($dpic); my $tpic = $targetdir.'/'.sprintf "%0*d-$pic", $digits, $i; my $thumbpic = getThumbFileName($dpic); my $thumbtpic = getThumbFileName($tpic); $i++; progressWinUpdate($pw, "copy and rename picture ($i/".scalar @sel.") ...", $i, scalar @sel); $rc = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); if (mycopy ($dpic, $tpic, OVERWRITE)) { if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ("$thumbpic","$thumbtpic", OVERWRITE) } $searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database } } # foreach - end progressWinEnd($pw); } ############################################################## # light_table_drop ############################################################## sub light_table_drop { # where the drop happened my $x = $ltw->{canvas}->canvasx($Tk::event->x()); my $y = $ltw->{canvas}->canvasy($Tk::event->y()); # distance between upper left corner of thumbs my $dis = $ltw->{thumb_size} + $ltw->{thumb_distance}; $dis = 1 if ($dis == 0); # avoid division by zero # drop position in cols/rows my $col = sprintf "%0d", ($x / $dis); # round my $row = sprintf "%0d", ($y / $dis); print "drop at x=$x y=$y col=$col row=$row\n"; # get size of canvas in cols/rows my $cx = $ltw->{canvas}->width; my $cy = $ltw->{canvas}->height; my $c_cols = int($cx/$dis); my $c_rows = int($cy/$dis); # new position in list my $to_index = $row * $c_cols + $col; my $to_dpic = $light_table_list[$to_index]; # find all selected thumbs my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); my @sel_dpics; # remove selected pics from the pic list foreach my $id (@sel) { my $dpic = get_path_from_id($id); my $index = index_in_list($dpic, \@light_table_list); #print "drop: removing index $index ($dpic)\n"; # remove this pic from the list push @sel_dpics, splice @light_table_list, $index, 1; } # add the removed pics at the right place again foreach my $dpic (@sel_dpics) { #print "drop: adding at $to_index $dpic\n"; # add it at the right position splice @light_table_list, $to_index, 0, $dpic; } #print "the list has now ".scalar @light_table_list." items\n"; light_table_reorder(); light_table_update_selection(); } ############################################################## # index_in_list - returns the index of an element in a list # return -1 if not found ############################################################## sub index_in_list { my $e = shift; my $listRef = shift; my $index = 0; foreach (@$listRef) { last if ($e eq $_); $index++; } if ($index > @$listRef) { print "$index is bigger than @$listRef\n"; $index = -1; } return $index; } ############################################################## # light_table_select - select a thumbnail, remove all other selections ############################################################## sub light_table_select { my $id = shift; # remember the current selection my @sel_IDs = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); $ltw->{sel_IDs} = \@sel_IDs; $ltw->{sel_time} = Tk::timeofday(); # delete all selection frames print "light_table_select\n"; remove_tag_from_all('THUMBSELECT_MH'); remove_tag_from_all('ANCHOR_MH'); # select just the current thumb $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current'); # this is the new anchor $ltw->{canvas}->addtag('ANCHOR_MH', 'withtag', 'current'); # update the selection frames light_table_update_selection(); } ############################################################## # remove_tag_from_all - delete a certain tag from all elements # in the canvas ############################################################## sub remove_tag_from_all { my $tag = shift; #print "remove_tag_from_all: $tag\n"; # build a list of all thumbs with this tag #my @sel = $ltw->{canvas}->find( qw|withtag $tag| ); my @sel = $ltw->{canvas}->find('withtag', $tag); # remove the tag from these thumbs foreach my $id (@sel) { #print "remove_tag_from_all: removing $tag\n"; $ltw->{canvas}->dtag($id, $tag); } } ############################################################## # light_table_select_add - toggle selection of single thumbnail ############################################################## sub light_table_select_add { my @tags = $ltw->{canvas}->gettags('current'); if (isInList('THUMBSELECT_MH', \@tags)) { $ltw->{canvas}->dtag('current', 'THUMBSELECT_MH'); } else { $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current'); } light_table_update_selection(); } ############################################################## # light_table_select_all - select all thumbnail ############################################################## sub light_table_select_all { remove_tag_from_all('THUMBSELECT_MH'); my @all = $ltw->{canvas}->find('all'); foreach my $id (@all) { $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $id); } light_table_update_selection(); } ############################################################## # light_table_select_range - select range of thumbnail ############################################################## sub light_table_select_range { # build a list of all thumbs with tag ANCHOR_MH my @sel = $ltw->{canvas}->find('withtag', 'ANCHOR_MH'); if (@sel < 1) { print "no anchor found!\n"; return; } if (@sel > 1) { print "error ".scalar @sel." anchors found! - removing anchors\n"; remove_tag_from_all('ANCHOR_MH'); return; } my $start_id = $sel[0]; my $start_dpic = get_path_from_id($start_id); my $start_index = index_in_list($start_dpic, \@light_table_list); @sel = $ltw->{canvas}->find('withtag', 'current'); my $end_id = $sel[0]; my $end_dpic = get_path_from_id($end_id); my $end_index = index_in_list($end_dpic, \@light_table_list); print "light_table_select_range: select from $start_dpic ($start_index) to $end_dpic ($end_index)\n"; # do we need to swap? if ($end_index < $start_index) { my $tmp = $start_index; $start_index = $end_index; $end_index = $tmp; } foreach ($start_index .. $end_index) { $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $light_table_list[$_]); } #$ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', 'current'); #$ltw->{canvas}->dtag($id, 'THUMBSELECT_MH'); light_table_update_selection(); } ############################################################## # light_table_update_selection - draw a frame around each selected # thumbnail (with tag THUMBSELECT_MH) ############################################################## sub light_table_update_selection { # first we remove all frames $ltw->{canvas}->delete('withtag', 'FRAME'); # find all selected thumbs my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); # draw a frame foreach my $thumb (@sel) { my ($x, $y) = $ltw->{canvas}->coords( $thumb ); $ltw->{canvas}->createRectangle( $x, $y, $x+$ltw->{thumb_size}+1, $y+$ltw->{thumb_size}+1, -tags => ['FRAME'], -outline => $config{ColorSel}, -width => 3, ); } $ltw->{label} = scalar @light_table_list.' pictures, '.scalar @sel.' selected'; } ############################################################## # light_table_delete - remove the selected thumbs from the list # will - of course - not remove the files!!! ############################################################## sub light_table_delete { # find all selected thumbs my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); # remove them from the list and the canvas foreach my $id (@sel) { my $dpic = get_path_from_id($id); my $index = index_in_list($dpic, \@light_table_list); print "deleting index $index ($dpic)\n"; # remove this pic from the list splice @light_table_list, $index, 1; # delete item from canvas $ltw->{canvas}->delete($id); $light_table_thumbs{$dpic}->delete if (defined $light_table_thumbs{$dpic}); # delete photo object delete $light_table_thumbs{$dpic}; # delete hash entry } light_table_reorder(); light_table_update_selection(); } ############################################################## # light_table_shift - move the selected thumbs to the top or # bottom of the list ############################################################## sub light_table_shift { my $where = shift; # must be 'top' or 'bottom' return unless (defined $where); return if (($where ne 'top') and ($where ne 'bottom')); # find all selected thumbs my @sel = $ltw->{canvas}->find('withtag', 'THUMBSELECT_MH'); my @shift_pics; # pics to move # remove them from the list foreach my $id (@sel) { my $dpic = get_path_from_id($id); my $index = index_in_list($dpic, \@light_table_list); # remove this pic from the list and add it to @shift_pics push @shift_pics, splice @light_table_list, $index, 1; } if ($where eq 'top') { unshift @light_table_list, @shift_pics; # add them at the start of the list } elsif ($where eq 'bottom') { push @light_table_list, @shift_pics; # add them to the end of the list } else { warn "light_table_shift: should not be reached where = $where"; } light_table_reorder(); light_table_update_selection(); } ############################################################## # light_table_move - called if a thumbnail is dragged inside the light table ############################################################## sub light_table_move { # stop repeat timer $ltw->{SCROLL_MH}->cancel if $ltw->{SCROLL_MH}; my $id = shift; # if the last selection happened just 400ms ago and the clicked # thumb was inside the last selection, we reselect the last selection if (((Tk::timeofday() - $ltw->{sel_time}) < 0.4) and isInList($id, $ltw->{sel_IDs})) { # reset time $ltw->{sel_time} = 0; # first remove the tags remove_tag_from_all('THUMBSELECT_MH'); # then add the selection from the saved list foreach my $id (@{$ltw->{sel_IDs}}) { my $dpic = get_path_from_id($id); $ltw->{canvas}->addtag('THUMBSELECT_MH', 'withtag', $dpic); } light_table_update_selection(); } $ltw->{canvas}->raise($id); # get mouse coordinates my $ex = $Tk::event->x(); my $ey = $Tk::event->y(); my $x = $ltw->{canvas}->canvasx($ex); my $y = $ltw->{canvas}->canvasy($ey); my $offset = int($ltw->{thumb_size}/2); # move thumb to mouse position $ltw->{canvas}->coords($id, $x-$offset, $y-$offset); # autoscroll: scroll up or down if needed # get actual scroll state my ($y1,$y2) = $ltw->{canvas}->yview; my $cy = $Tk::event->y; print "light_table_move cy:$cy\n" if $verbose; # everything is visible no scrolling needed return if ($y1 == 0 and $y2 == 1); my $c_h = $ltw->{canvas}->height; # the visible height #my @sr = $ltw->{canvas}->cget(-scrollregion); #my @sr = $ltw->{frame}->cget(-scrollregion); #my $c_h_all = $sr[3] - $sr[1]; # the height of the scrollregion # scroll up if mouse is less then a half thumbnailsize away from the upper border # and there is still room to scroll ($y1 > 0) and no button release has happened if (($cy < $offset) and ($y1 > 0)) { $ltw->{SCROLL_MH} = $ltw->repeat(100, sub { print "scroll up\n"; $ltw->{canvas}->yview('scroll',-1,'units'); # move thumb to mouse position my $x = $ltw->{canvas}->canvasx($ex); my $y = $ltw->{canvas}->canvasy($ey); $ltw->{canvas}->coords($id, $x-$offset, $y-$offset); $ltw->idletasks; }); } # scroll down if mouse is less then a half thumbnailsize away from the lower border # and there is still room to scroll ($y2 < 1) and no button release has happened if (($cy > $c_h - $offset) and ($y2 < 1)) { $ltw->{SCROLL_MH} = $ltw->repeat(100, sub { print "scroll down\n"; $ltw->{canvas}->yview('scroll',1,'units'); # move thumb to mouse position my $x = $ltw->{canvas}->canvasx($ex); my $y = $ltw->{canvas}->canvasy($ey); $ltw->{canvas}->coords($id, $x-$offset, $y-$offset); $ltw->idletasks; }); } } ############################################################## # nop - a do nothing function, needed from Tk::IO ############################################################## sub nop { return; } ############################################################## # getThumbCaption - return the appropriate caption for the # thumbnail of a picture, possibly empty ############################################################## sub getThumbCaption { my $dpic = shift; if (($config{ThumbCapt} eq '') or ($config{ThumbCapt} eq 'none')) { return ''; } elsif ($config{ThumbCapt} eq 'filename') { my $capt = basename($dpic); $capt =~ s/(.*)\.jp(g|eg)$/$1/i; # remove suffix return $capt; } elsif ($config{ThumbCapt} eq 'filenameSuffix') { my $capt = basename($dpic); return $capt; } elsif ($config{ThumbCapt} eq 'objectname') { return getIPTCObjectName($dpic); } else { warn 'getThumbCaption: ThumbCapt has unexpected value: "'.$config{ThumbCapt}.'"'; return ""; } } ############################################################## # updateOneThumb - this function is called when a convert # process is finished; replaces the default # thumbnail with the actual thumbnail ############################################################## sub updateOneThumb { my $thumb = shift; my $dpic = shift; # the index (entrypath) of the hlist element my $show = shift; # SHOW, NO_SHOW proccount(-1); $nrToConvert--; $nrToConvert = 0 if ($nrToConvert < 0); # check if we are still in the same dir if (dirname($thumb) ne dirname(getThumbFileName("$actdir/dummy.jpg"))) { return; # no, we are not so do not display the generated thumbs } if (($show == SHOW) and (-f $thumb)) { $thumbs{$thumb} = $picLB->Photo(-format => "jpeg", -file => $thumb, -gamma => $config{Gamma}); # if there is already an image ... if ($picLB->itemCget($dpic, $picLB->{thumbcol}, -itemtype) eq "imagetext") { # ... configure it $picLB->itemConfigure($dpic, $picLB->{thumbcol}, -image => $thumbs{$thumb}, -itemtype => "imagetext"); } else { $picLB->itemCreate($dpic, $picLB->{thumbcol}, -style => $thumbS, -itemtype => 'imagetext', -image => $thumbs{$thumb}, -text => getThumbCaption($dpic)); } } } ############################################################## # proccount - count the spawned processes # returns the number of running processes if no # parameter is given ############################################################## sub proccount { my $diff = shift; # optional parameter return $proccount unless (defined $diff); $proccount = 0 unless (defined $proccount); # todo why? $proccount += $diff; $proccount = 0 if ($proccount < 0); # should never happen! $top->update; print "proccount = $proccount\n" if $verbose; } ############################################################## # showPicViewList ############################################################## sub showPicViewList { my $fs = $top->FileSelect(-title => "read picture view list from file", -directory => $actdir, -width => 30, -height => 30); my $file = $fs->Show; return if ((!defined $file) or ($file eq "") or (!-f $file)); my @pics = readArrayFromFile($file); # todo: handle absolute and relative paths in lists # check pic list my $error_text = ''; foreach (@pics) { $error_text .= "$_\n" unless (-f $_); } if ($error_text ne '') { $error_text = "These pictures of the list in $file are missing:\n".$error_text; showText('Info about picture view list', $error_text, NO_WAIT); } $userinfo = "loading thumbnails ..."; $top->update; checkCachedPics(); canvasHide(); # delete all photo objects (thumbnnails) foreach (keys %thumbs) { print "updateThumbs: deleting thumbnail object of $_\n" if $verbose; $thumbs{$_}->delete if (defined $thumbs{$_}); # delete photo object delete $thumbs{$_}; # delete hash entry } if ($verbose) { my @check = $top->imageNames; print " there are ".scalar @check." pics left\n"; } # clean the thumbnail table # with this step all references to the already deleted photo objects are cleared # so the memory is now free again $picLB->delete("all"); if (showThumbsInList($picLB, \@pics)) { $userinfo = "loading thumbnails ... ready"; $userInfoL->update; #generateThumbs(ASK, SHOW); } else { $userinfo = "user abord (not all pictures are loaded!)"; $userInfoL->update; } showNrOf(); } ############################################################## # smart_update - reread actual directory, add new and remove # deleted pics, without reloading the existing # thumbnails; the goal is to have a faster # update for large folders ############################################################## sub smart_update { # get the new list of pics in the actual folder my @act_pics = getPics($actdir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@act_pics); # get the displayed pics from the listbox my @disp_pics = $picLB->info('children'); my $removed_pics = 0; my $new_pics = 0; # remove deleted pictures first foreach my $dpic (@disp_pics) { if ((!isInList($dpic, \@act_pics)) and ($picLB->info('exists', $dpic))) { print "deleting $dpic from picLB\n" if $verbose; $removed_pics++; $picLB->delete('entry', $dpic); } } # get the displayed pics from the listbox again after the deletion @disp_pics = $picLB->info('children'); # count new pictures first foreach my $dpic (@act_pics) { $new_pics++ if (!$picLB->info('exists', $dpic)); } if ($new_pics > 0) { # todo this init is not the perfect solution as a rename of the # first pic will be shown as second pic my $after = $disp_pics[0]; my $pw = progressWinInit($picLB, "Smart update"); my $n = 0; # add the new pics to the listbox foreach my $dpic (@act_pics) { last if progressWinCheck($pw); if (!$picLB->info('exists', $dpic)) { $n++; progressWinUpdate($pw, "adding new picture ($n/$new_pics) ...", $n, $new_pics); print "adding $dpic to picLB\n" if $verbose; addOneRow($picLB, $dpic, 1, $after); } $after = $dpic; } progressWinEnd($pw); } showNrOf(); $userinfo = "ready! removed $removed_pics and added $new_pics picture(s)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # showThumbs - display all thumbnail pictures of the actual # directory in the listbox ############################################################## sub showThumbs { # clean the thumbnail table # with this step all references to the already deleted photo objects are cleared # so the memory is now free again $picLB->delete('all'); if ($verbose) { my @check = $top->imageNames; print " there are ".scalar @check." pics left\n"; } my @pics = getPics($actdir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@pics); cleanOneDir($actdir) if (@pics == 0); # remove .thumbs subdir etc. my $rc = showThumbsInList($picLB, \@pics); return $rc; } ############################################################## # showThumbsInList ############################################################## sub showThumbsInList { my $lb = shift; # the listbox widget my $listR = shift; # the list of pics to show # show some infos to the user while loading my $n = 0; # actual number my $nr = @$listR; # total number if (@$listR > $config{ThumbMaxLimit}) { $lb->messageBox(-icon => 'info', -message => "There are $nr pictures to show. The thumbnail limit is set to ".$config{ThumbMaxLimit}.". ".($nr - $config{ThumbMaxLimit})." pictures will be displayed with a default thumbnail.", -title => "Info", -type => 'OK'); } my $pw = progressWinInit($lb, "Load pictures"); foreach my $dpic (@$listR) { last if progressWinCheck($pw); $n++; progressWinUpdate($pw, "loading picture ($n/$nr) ...", $n, $nr); my $with_thumb = 0; $with_thumb = 1 if ($n <= $config{ThumbMaxLimit}); addOneRow($lb, $dpic, $with_thumb); } progressWinEnd($pw); if (($lb == $picLB) and ($n != $nr)) { $userinfo = "user abord at $n of $nr"; $userInfoL->update; $lb->after(1000); # just a litte delay to show the message above return 0; } return 1; } ############################################################## # addOneRow - adds a new row, or updates an existing row ############################################################## sub addOneRow { my $lb = shift; my $dpic = shift; my $with_thumb = shift; # bool 1 = thumb, 0 = defaultthumb my $after; $after = shift; # optional unless ($lb->info("exists", $dpic)) { # create new row, we use the path and file name (=$dpic) as unique index for the hlist entry if (($after) and ($lb->info("exists", $after))) { $lb->add($dpic, -after => $after); } else { $lb->add($dpic); } } my $thumb = getThumbFileName($dpic); my $thumbP = undef; if ($config{ShowThumbs} and -f $thumb) { $thumbP = $lb->Photo(-format => "jpeg", -file => $thumb, -gamma => $config{Gamma}); $thumbs{$dpic} = $thumbP; # save all thumb photo objects in global hash %thumbs to delete them when changing the dir } # test feature to improve speed: read meta info only if there is no info in the DB or the modification date has changed # on windows this is 10 times faster to read in a folder with 200 pics (34 secs vs. 3 secs) # todo there should be a possibility to force a reread, if somebody added metainfo without changing the modification date - however this is still possible using add to database if ($searchDB{$dpic} and $searchDB{$dpic}{MOD}) { if ($searchDB{$dpic}{MOD} != getFileDate($dpic, NO_FORMAT)) { addToSearchDB($dpic); # save the infos into the search data base } } else { # branch for pics not yet stored in the database or with missing modification dates addToSearchDB($dpic); # save the infos into the search data base } my $iptc = ''; my $exif = ''; my $com = ''; my $size = ''; my $pic = basename($dpic); my $dir = dirname($dpic); $com = $searchDB{$dpic}{COM}; $exif = $searchDB{$dpic}{EXIF}; $iptc = displayIPTC($dpic); $size = getAllFileInfo($dpic); $com = formatString($com, $config{LineLength}, , $config{LineLimit}); # format the comment for the list $iptc = formatString($iptc, $config{LineLength},, $config{LineLimit}); # format the IPTC info for the list my $image; if ((defined $thumbP) and $with_thumb) { $image = $thumbP; } else { if ($config{UseDefaultThumb} and $defaultthumbP) { $image = $defaultthumbP; } else { undef $image; } } if (defined $image) { $lb->itemCreate($dpic, $lb->{thumbcol}, -style => $thumbS, -itemtype => 'imagetext', -image => $image, -text => getThumbCaption($dpic)); } # insert items in the table row $lb->itemCreate($dpic, $lb->{filecol}, -text => $size, -style => $fileS); $lb->itemCreate($dpic, $lb->{iptccol}, -text => $iptc, -style => $iptcS); $lb->itemCreate($dpic, $lb->{comcol}, -text => $com, -style => $comS); $lb->itemCreate($dpic, $lb->{exifcol}, -text => $exif, -style => $exifS); $lb->itemCreate($dpic, $lb->{dircol}, -text => $dir, -style => $dirS); } ############################################################## # displayIPTC - convert the searchdb info into a formated string ############################################################## sub displayIPTC { my $dpic = shift; my $iptc = ""; $iptc = displayUrgency($searchDB{$dpic}{URG}); $iptc .= "Keywords: ".$searchDB{$dpic}{KEYS}."\n" if (defined $searchDB{$dpic}{KEYS}); $iptc .= $searchDB{$dpic}{IPTC} if (defined $searchDB{$dpic}{IPTC}); return $iptc; } ############################################################## # displayUrgency - convert the integer value into a string with stars (*) ############################################################## sub displayUrgency { my $urg = shift; return '' unless (defined $urg); my $durg = ''; for (my $x = 8; $x >= $urg; $x -= 1) { $durg .= '*'; } return "Rating : $durg ($urg)\n"; } ############################################################## # addToSearchDB - add a picture to the search data base # this function can be called with one or four # parameters ############################################################## sub addToSearchDB { my $dpic = shift; # normalize the path $dpic =~ s/\\/\//g; # replace Windows path delimiter with UNIX style \ -> / $dpic =~ s/\/+/\//g; # replace multiple slashes with one // -> / $dpic =~ s/\/\.\//\//g; # replace dot dir /./ -> / if (!-f $dpic) { warn "addToSearchDB: $dpic not found!"; return undef; } #print "addToSearchDB $dpic\n"; # do not save pics to the database which are located in .thumbs/ .xvpics/ .exif/ my $dir = dirname($dpic); $dir =~ s!/$!!g; # remove trailing / if ($dir =~ m/$thumbdirname|$exifdirname|$xvpicsdirname$/) { print "addToSearchDB: ignoring $dpic\n" if $verbose; return undef; } my ($com, $exif, $ctime, $mtime, $iptc, $urgency, $size, $x, $y, $keys, @keys, $pop); # $meta is returned at the end of the sub, # the SOF segment is needed for the latter call of getAllFileInfo my $meta = getMetaData($dpic, "COM|APP1|APP13|SOF", 'FASTREADONLY'); $exif = getShortEXIF( $dpic, WRAP, $meta); $com = getComment( $dpic, LONG, $meta); $iptc = getIPTC( $dpic, SHORT, $meta); $size = getFileSize( $dpic, NO_FORMAT); ($x,$y) = getSize( $dpic, $meta); $mtime = getFileDate( $dpic, NO_FORMAT); @keys = getIPTCkeywords($dpic, $meta); $pop = 0; $pop = $searchDB{$dpic}{POP} if (defined $searchDB{$dpic}{POP}); # handling of non-printables is already done in getIPTC and getIPTCkeywords # todo: It is needed here too, but why? $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline foreach (@keys) { $_ =~ tr/ -~//cd; # remove all non-printable chars (Picasa adds one to each keyword) } # build a space separated string from the keyword list # todo find a better separator, so that keywords with spaces can be supported better foreach (@keys) { $keys .= "$_ "; } # check if the pictures contain new keywords if ($config{CheckNewKeywords}) { foreach (@keys) { # store all keywords in a hash and count them if (defined $new_keywords{$_}) { $new_keywords{$_}++; } else { $new_keywords{$_} = 1; } } } # try to get the EXIF date from the short EXIF info format: "dd.mm.yyyy hh:mm:ss" # there may be [t] or [s] before the date! undef $ctime; if (defined($exif)) { my $year; my $mon; my $day; my $hour; my $min; my $sec; # support three different date formats # dd.mm.yyyy hh:mm:ss if ($exif =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) { $day = $1; $mon = $2; $year = $3; $hour = $4; $min = $5; $sec = $6; } # mm/dd/yyyy hh:mm:ss if ($exif =~ m/(\d\d)\/(\d\d)\/(\d\d\d\d)\s(\d\d):(\d\d):(\d\d)/) { $mon = $1; $day = $2; $year = $3; $hour = $4; $min = $5; $sec = $6; } # yyyy-mm-dd hh:mm:ss if ($exif =~ m/(\d\d\d\d)-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)/) { $year = $1; $mon = $2; $day = $3; $hour = $4; $min = $5; $sec = $6; } $mon--; if (defined $year) { if ($year > $copyright_year) { # fix wrong dates print "Mapivi warning: $dpic: EXIF year: $year is in the future, correcting to $copyright_year\n"; $year = $copyright_year; } $year -= 1900; if ($mon >= 0 and $mon <= 11) { # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970) $ctime = timelocal($sec,$min,$hour,$day,$mon,$year); #warn "using exifdate for $dpic: $ctime\n" if $verbose; # optional checks #my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; #$y += 1900; $mo++; # do some adjustments # build up the date time string, sim#lar to the EXIF format #my $date1 = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s; #my $date2 = "$3:$2:$1 $4:$5:$6"; #print "$date2 $date $dpic\n" if ($date1 ne $date2); } } #else { print "mon = $mon $3:$2:$1 $4:$5:$6\n";} } #else { print "no exif date: $exif" if $verbose; } # if there is no exif time available use the file modification date unless (defined $ctime) { $ctime = (lstat $dpic)[9]; # 9 is the modification date time #warn "using filedate for $dpic: $ctime\n" if $verbose; } # replace all newlines with space before adding to the database #$com =~ s/\n/ /g if (defined $com); #$exif =~ s/\n/ /g if (defined $exif); #$iptc =~ s/\n/ /g if (defined $iptc); # maybe there was something defined before, so we better overwrite it with "" $com = '' unless (defined $com); $exif = '' unless (defined $exif); $iptc = '' unless (defined $iptc); $iptc =~ s/urgency\s*:\s*\d*\s*//i; # remove urgency from the IPTC field $iptc =~ s/keywords\s*:\s*.*\n//i; # remove keywords from the IPTC field $urgency = getIPTCurgency($dpic, $meta); $urgency = undef if ($urgency == 9); delete $searchDB{$dpic}; # clear hash item first #print "adding: IPTC: $iptc\n"; #print "adding: Keys: $keys\n"; #print "adding: URG : $urgency\n"; $searchDB{$dpic}{COM} = $com; # save (complete!) comment $searchDB{$dpic}{EXIF} = $exif; # save short EXIF info $searchDB{$dpic}{SIZE} = $size; # save file size in Bytes $searchDB{$dpic}{PIXX} = $x; # save pixel size (x = width) $searchDB{$dpic}{PIXY} = $y; # save pixel size (y = height) $searchDB{$dpic}{TIME} = $ctime; # save EXIF/file creation time $searchDB{$dpic}{MOD} = $mtime; # save file modification time $searchDB{$dpic}{IPTC} = $iptc; # save complete IPTC info $searchDB{$dpic}{URG} = $urgency; # save IPTC urgency $searchDB{$dpic}{KEYS} = $keys; # save IPTC keywords $searchDB{$dpic}{POP} = $pop if ($config{trackPopularity}); # save popularity (how often the pic was shown) #print "---IPTC: $searchDB{$dpic}{IPTC}---\n"; return $meta; } ############################################################## # getMetaData - returns the Image::MetaData::JPEG # object of $dpic ############################################################## sub getMetaData { my $dpic = shift; my $what = shift; # regex to match the needed segments e.g. "COM" for comment, # or "APP13|COM" for IPTC info and comment segments my $option = shift; # optional option, if set to 'FASTREADONLY' will speed things up return undef unless is_a_JPEG($dpic); # mapivi just needs the comments (COM), EXIF (APP1), IPTC (APP13) and size (SOF) segments my $meta = new Image::MetaData::JPEG($dpic, $what, $option); print "getMetaData: Kind:$what pic:$dpic\n" if $verbose; warn "Error: " . Image::MetaData::JPEG::Error() unless $meta; return $meta; } ############################################################## # getAllFileInfo ############################################################## sub getAllFileInfo { my $dpic = shift; my $bpic = buildBackupName($dpic); my $size = ''; my $w = 0; my $h = 0; return '' if (!-f $dpic); $size = basename($dpic)."\n\n"; $size .= int($searchDB{$dpic}{SIZE}/1024).'kB' if $searchDB{$dpic}{SIZE}; $size .= '[bak]' if (-f $bpic); # show that there is a backup file my ($basename, $suffix) = getBasenameSuffix($dpic); $size .= '[raw]' if ((-f $basename.'.nef') or (-f $basename.'.NEF')); # show that there is a raw file $size .= '[raw]' if ((-f $basename.'.crw') or (-f $basename.'.CRW')); # show that there is a raw file $size .= '[XMP]' if ((-f $basename.'.xmp') or (-f $basename.'.XMP')); # show that there is a XMP sidecar file $size .= '[WAV]' if ((-f $basename.'.wav') or (-f $basename.'.WAV')); # show that there is a WAV audio file $size .= "\n".buildDateTime($searchDB{$dpic}{MOD}) if ($config{ShowFileDate} and defined $searchDB{$dpic}{MOD}); $w = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX}; $h = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY}; # MP = MegaPixel my $p = sprintf "%.2f", ($w*$h/1000000); $size .= "\n${w}x$h (${p}MP)"; if ($config{BitsPixel}) { my $bitPix = getBitPix($dpic); $bitPix = sprintf "%.2f", $bitPix; $size .= "\n${bitPix}b/p"; } $size .= "\n".getAspectRatio($w, $h) if ($config{AspectRatio} and ($w > 0) and ($h > 0)); if (-l $dpic) { $size .= "\n(Link)"; } $size .= "\nViewed ".$searchDB{$dpic}{POP}.' times' if (($config{trackPopularity}) and (defined $searchDB{$dpic}{POP})); return $size; } ############################################################## # getAspectRatio ############################################################## sub getAspectRatio { my $w = shift; my $h = shift; return "" if (($h == 0) or ($w == 0)); my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100); # delta factor for aspect ratio my $r = $w/$h; # aspect ratio my $ratio = ""; if (($r <= $aspectdelta*4/3) and ($r >= (4/3)/$aspectdelta)) { $ratio = "[4:3]"; } elsif (($r <= $aspectdelta*3/4) and ($r >= (3/4)/$aspectdelta)) { $ratio = "[3:4]"; } elsif (($r <= $aspectdelta*2/3) and ($r >= (2/3)/$aspectdelta)) { $ratio = "[2:3]"; } elsif (($r <= $aspectdelta*3/2) and ($r >= (3/2)/$aspectdelta)) { $ratio = "[3:2]"; } elsif (($r <= $aspectdelta*5/4) and ($r >= (5/4)/$aspectdelta)) { $ratio = "[5:4]"; } elsif (($r <= $aspectdelta*4/5) and ($r >= (4/5)/$aspectdelta)) { $ratio = "[4:5]"; } elsif (($r <= $aspectdelta*7/5) and ($r >= (7/5)/$aspectdelta)) { $ratio = "[7:5]"; } elsif (($r <= $aspectdelta*5/7) and ($r >= (5/7)/$aspectdelta)) { $ratio = "[5:7]"; } elsif (($r <= $aspectdelta*16/9) and ($r >= (16/9)/$aspectdelta)) { $ratio = "[16:9]"; } elsif (($r <= $aspectdelta*9/16) and ($r >= (9/16)/$aspectdelta)) { $ratio = "[9:16]"; } elsif ($w == $h) { $ratio = "[1:1]"; } else { if ($w > $h) { $ratio = sprintf "[%.2f:1]", ($w/$h); } else { $ratio = sprintf "[1:%.2f]", ($h/$w); } } return $ratio; } ############################################################## # removeIPTC ############################################################## sub removeIPTC { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $rc = $top->messageBox(-icon => 'question', -message => "Please press Ok to remove all IPTC info of the ".scalar @sellist." selected pictures.\nThere is no undo!", -title => "Remove all IPTC info?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); my ($dpic, $ii, $iptcread, $iptcL); my $errors = ""; my $i = 0; my $pw = progressWinInit($top, "Remove IPTC info"); foreach $dpic (@sellist){ last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Removing IPTC info ($i/".scalar @sellist.") ...", $i, scalar @sellist); next unless (-f $dpic); next if (!checkWriteable($dpic)); my $meta = getMetaData($dpic, "APP13"); $meta->remove_app13_info(-1, 'IPTC'); # remove all APP13 IPTC segments unless ($meta->save()) { $errors .= "removeIPTC: save $dpic failed!\n"; } updateOneRow($dpic, $picLB); } progressWinEnd($pw); $userinfo = "ready! (removed IPTC info of $i/".scalar @sellist.")"; $userInfoL->update; showText("Errors while removing IPTC infos", $errors, NO_WAIT) if ($errors ne ""); return; } ############################################################## # cutString - cat a string to a given length, remove newline # and carriage return and add e.g. dots if cut # examples: cutString("elephant",20,"..") -> "elephant" # cutString("elephant", 7,"..") -> "eleph.." # cutString("elephant",-7,"..") -> "..phant" ############################################################## sub cutString { my $str = shift; # input string my $len = shift; # the max length my $dot = shift; # the dots (e.g. ".." or "...") return unless (defined $str); return if ($str eq ""); my $dotlen = length($dot); my $out = $str; if (length($dot) >= abs($len)) { warn "cutString: lenght of dots is longer or equal than length"; return $out; } if ($len >= 0) { $out = substr($out, 0, ($len-$dotlen)).$dot if (length($out) > $len); } else { $out = $dot.substr($out, ($len+$dotlen), length($str)) if (length($out) > -$len); } $out =~ s/\n//g; # remove newlines $out =~ s/\r//g; # remove \r (carriage return) return $out; } ############################################################## # formatString - cuts and formats a string to # a width of $linelenght chars and a length of # $line_nr_limit lines. # this function wont work as expected with # comments containing a lot of nearly empty lines ############################################################## sub formatString($$$) { my $string = shift; my $linelenght = shift; my $line_nr_limit = shift; # use -1 if there should be no line nr limit return '' if ((!defined $string) or ($string eq '')); $Text::Wrap::columns = $linelenght+1; $string =~ s/\r//g; # cut \r (carriage return) $string =~ tr[\200-\377][\000-\177]; # remove the eight bit $string = wrap('','',$string); # limit the number of lines (cut off the rest) if ($line_nr_limit > 0) { # split up in an array of single lines my @l = split /\n/, $string; my $max = $line_nr_limit; $max = @l if (@l < $max); $string = ''; # rebuild string by using the first $max lines for ( 0 .. ($max - 1)) { $string .= sprintf "%s\n", $l[$_]; } $string =~ s/\n+$//; # cut off trailing newline(s) } return $string; } ############################################################## # getFileSize - get the size in kB of a file, even if it is a link ############################################################## sub getFileSize { my $dpic = shift; my $format = shift; # NO_FORMAT = return size unformated in Bytes (integer) FORMAT = with "kB" added (string) my $size = ""; return $quickSortHashSize{$dpic} if ($quickSortSwitch and defined $quickSortHashSize{$dpic}); if (!-f $dpic) { warn "getFileSize: $dpic is no file!"; if ((defined $format) and ($format == NO_FORMAT)) { return 0; } else { return ""; } } if (-l $dpic) { $size = (lstat (getLinkTarget($dpic)))[7]; } else { $size = (lstat $dpic)[7]; } if ((defined $format) and ($format == FORMAT)) { $size = int($size/1024)."kB" if $size; } $quickSortHashSize{$dpic} = $size if $quickSortSwitch; return $size; } ############################################################## # makeDir - create the directory for storing the # thumbnail pictures or EXIF infos ############################################################## sub makeDir { my $dir = shift; my $ask = shift; # ASK = ask before creating a dir, NO_ASK return 1 if (-d $dir); if ( ($ask == ASK) and $config{AskMakeDir} ) { my $rc = checkDialog("Create new folder?", "MaPiVi would like to create this folder:\n$dir\nContinue?", \$config{AskMakeDir}, "ask every time", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); } # 0755 = rwxr.xr.x eval { mkpath($dir, 0, 0755) }; # 0 = no output, 0755 = access rights if ($@) { $top->messageBox(-icon => 'warning', -message => "makeDir: can not create $dir: $@", -title => 'Error', -type => 'OK'); return 0; } return 1; } ############################################################## # aNewerThanb - true if file a is newer than file b, or if # file a exists and file b does not ############################################################## sub aNewerThanb { my $afile = shift; my $bfile = shift; if (-f $afile) { if (-f $bfile) { # compare modification times return (lstat $afile)[9] > (lstat $bfile)[9]; } return 1; } return 0; } ############################################################## # nextPic - get the index of the next picture in the directory ############################################################## sub nextPic { my $actpic = shift; my @pics = $picLB->info('children'); # if there are no pics return an empty string return "" if (@pics == 0); # if there is no actpic we start with the first return $pics[0] if ($actpic eq ""); # try to get the next pic my $next = $picLB->info('next', $actpic); # if there is no next pic unless ($next) { # we have reached the end and start again with the first picture beep() if ($config{BeepWhenLooping}); $next = $pics[0]; } return $next; } ############################################################## # nextSelectedPic - get the index of the next selected picture # in the directory ############################################################## sub nextSelectedPic { my $actpic = shift; my @pics = $picLB->info('children'); my @sel = $picLB->info('selection'); # if there are no pics return an empty string return "" if (@pics == 0); return "" if (@sel == 0); my $start = 0; my $next = ""; my $nextsel = ""; foreach my $dpic (@pics) { # skip all pics until we reach the actual picture $start = 1 if ($dpic eq $actpic); next unless $start; # get the next picture $next = $picLB->info('next', $dpic); # check if it is selected if ($next and isInList($next, \@sel)) { $nextsel = $next; last; } } # if there is no next pic if ($nextsel eq "") { # we have reached the end and start again with the first selected picture #beep() if ($config{BeepWhenLooping}); $nextsel = $sel[0]; } return $nextsel; } ############################################################## # prevPic - show the previous picture in the directory ############################################################## sub prevPic { my $actpic = shift; my @pics = $picLB->info('children'); # if there are no pics return an empty string return "" if (@pics == 0); # if there is no actpic we start with the first return $pics[-1] if ($actpic eq ""); # try to get the previous pic my $prev = $picLB->info('prev', $actpic); # if there is no prev pic unless ($prev) { # we have reached the start and jump to the last picture beep() if ($config{BeepWhenLooping}); $prev = $pics[-1]; } return $prev; } ############################################################## # gotoPic ############################################################## sub gotoPic { my $lb = shift; return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $lb->info('children'); return if (!@childs); my $goto = ""; my $rc = myEntryDialog("Go to picture/select pictures", "Please enter a part of the name or the index number of the picture(s) to select/show.\nIndex number are entered like this: /number.\nUse /c to switch to case sensitive and /s if the filename starts with the search string.\n\nExamples:\nabc show and select all pictures containing abc (any case)\n/10 show picture number 10\n/sabc show and select all pictures starting with abc (any case)\n/cABC show and select all pictures containing an upper case ABC\n/s/cABC show and select all pictures starting with an upper case ABC", \$goto); return if (($rc ne 'OK') or ($goto eq "")); if ($goto =~ m/(\/)(\d+)/) { # $goto is a number if (($2 > 0) and ($2 < @childs + 1)) { # saved here for undo function @savedselection2 = @savedselection; @savedselection = $lb->info('selection'); $lb->selectionClear(); showPic($childs[$2-1]) if ($lb == $picLB); } else { $userinfo = "number $2 is out of range!"; $userInfoL->update; } } else { # $goto is a string my @pics; my $case = "i"; my $start = ".*"; if ($goto =~ m/.*\/c/) { $case = ""; $goto =~ s/\/c//; } if ($goto =~ m/.*\/s/) { $start = "^"; $goto =~ s/\/s//; } foreach (@childs) { if (basename($_) =~ m/(?$case)$start$goto.*/) { push @pics, $_; } } if (@pics) { # saved here for undo function @savedselection2 = @savedselection; @savedselection = $lb->info('selection'); $lb->selectionClear(); showPic($pics[0]) if ($lb == $picLB); reselect($lb, @pics); $userinfo = "selected ".scalar @pics." pictures matching \"$goto\""; $userInfoL->update; } else { $userinfo = "string $goto was not found in the picture names"; $userInfoL->update; } } } ############################################################## # showImageInfo - display infos and comment of given image # if availabel ############################################################## sub showImageInfo { my $dpic = shift; if (!-f $dpic) { $widthheight = ""; $size = ""; $exif = ""; $urgencyStr = ""; $urgencyScale = 0; $commentText->delete( 0.1, 'end') if ($config{ShowCommentField}); } else { my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY'); ($width, $height) = getSize($dpic, $meta); $widthheight = $width.'x'.$height; if ($config{ShowEXIFField}) { $exif = getShortEXIF($dpic, NO_WRAP, $meta); } if ($config{ShowCommentField}) { my $comment = getComment($dpic, LONG, $meta); # does not work! mh 14.07.03 # # determine the height of the textbox by counting the number of lines # my $height = ($comment =~ tr/\n//); # $height++; # $height = 10 if ($height > 10); # not to big, we have scrollbars # print "h = $height\n"; # $commentText->configure(-height => $height); $commentText->delete( 0.1, 'end'); # remove old comment $commentText->insert('end', $comment); # insert new comment } if ($config{ShowCaptionField}) { my $caption = getIPTCCaption($dpic); $captionText->delete( 0.1, 'end'); # remove old caption $captionText->insert('end', $caption); # insert new caption } $urgencyStr = getIPTCurgency($dpic, $meta); $urgencyScale = 9 - $urgencyStr; $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8)); $urgencyStr = "" if ($urgencyStr > 8); $size = getFileSize($dpic, FORMAT); } setTitle(); } ############################################################## # showImageInfoCanvas - display infos on the canvas ############################################################## sub showImageInfoCanvas { my $dpic = shift; $c->delete('withtag', 'TEXT'); return unless (defined $dpic); return unless (-f $dpic); return unless ($config{ShowInfoInCanvas}); my $info = ""; my $meta = getMetaData($dpic, "COM|APP13|APP1|SOF", 'FASTREADONLY'); my $exif = formatString(getShortEXIF($dpic, NO_WRAP, $meta), 80, -1); my $comm = formatString(getComment($dpic, LONG, $meta), 80, -1); my $iptc = formatString(getIPTC($dpic, LONG, $meta), 80, -1); $info .= "EXIF:\n$exif\n" if ($exif ne ""); $info .= "--------------------\n" if (($exif ne "") and (($comm ne "") or ($iptc ne ""))); $info .= "IPTC:\n$iptc" if ($iptc ne ""); $info .= "--------------------\n" if (($comm ne "") and ($iptc ne "")); $info .= "Comment:\n$comm" if ($comm ne ""); return if ($info eq ''); # show image info on canvas white font with black shadow $c->createText( 5, 5, -font => $font, -text => $info, -anchor => 'nw', -fill => 'black', -tags => ['TEXT']); $c->createText( 4, 4, -font => $font, -text => $info, -anchor => 'nw', -fill => 'white', -tags => ['TEXT']); } ############################################################## # showZoomInfo - calculate the zoom factor of the displayed # pic by messuring the size of the file # and the size on the canvas ############################################################## sub showZoomInfo { my $dpic = shift; my $id = shift; if (-f $dpic) { my ($width, $height) = getSize($dpic); my ($x1, $y1, $x2, $y2) = $c->bbox($id); if (defined $x2 and defined $x1 and ($x2 - $x1 != 0)) { my $z = $width/($x2 - $x1); if ($z > 0) { # avoid divison by zero $zoomFactorStr = int(1/$z * 100)."%"; return; } } } $zoomFactorStr = "?%"; } ############################################################## # handleNonJPEG ############################################################## sub handleNonJPEG { my $dir = shift; my @pics = @_; my $changed = 0; # counter return 0 if ((defined $nonJPEGdirNoAskAgain{"$dir"}) and ($nonJPEGdirNoAskAgain{"$dir"} == 1)); # open window my $myDiag = $top->Toplevel(); $myDiag->title('Non-JPEG pictures'); $myDiag->Label(-text => "There are ".scalar @pics." non-JPEG pictures in folder ".basename($dir).".\nShould I convert these pictures to JPEG format?\n(After convertion these pictures will be visible in Mapivi.)", -bg => $config{ColorBG} )->pack(-fill => 'x', -padx => 3, -pady => 3); my $qS = labeledScale($myDiag, 'top', 40, "Quality of JPEG picture when converting", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); my $removeOrig = 0; $myDiag->Checkbutton(-variable => \$removeOrig, -text => "Remove the original pictures after conversion")->pack(-anchor=>'w'); my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $myDiag->withdraw(); $myDiag->destroy(); $changed = convertToJPEG($dir, $removeOrig, @pics); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); $ButF->Button(-text => "Show picture list", -command => sub { my $info = "Non-JPEG pictures in $dir:\n\n"; foreach (sort @pics) { my $size = getFileSize("$dir/$_", NO_FORMAT); $info .= sprintf "%-45s %12s Bytes\n", $_, $size; } showText("Non-JPEG pictures", $info, WAIT); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); $ButF->Button(-text => 'Cancel', -command => sub { # save dir in hash, so we don't bother the user again if he reopens the dir $nonJPEGdirNoAskAgain{"$dir"} = 1; $myDiag->withdraw(); $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); $myDiag->Popup(-popover => 'cursor'); repositionWindow($myDiag); if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab $myDiag->grab; $myDiag->after(50, sub{$myDiag->grabRelease}); } $myDiag->waitWindow; my $reread = ($changed > 0) ? 1 : 0; return $reread; } ############################################################## # convertToJPEG - convert the piclist to JPEG format ############################################################## sub convertToJPEG { my $dir = shift; my $del = shift; # delete orig after conversion (bool) my @pics = @_; my $converted = 0; foreach (@pics) { my $dpic = "$dir/$_"; my $tpic = $dpic; $tpic =~ s/($nonJPEGsuffixes)$/jpg/i; print "convertToJPEG: $_ -> $tpic\n" if $verbose; if (-f $tpic) { $top->messageBox(-icon => 'warning', -message => "$tpic exists - skipping!", -title => 'Warning', -type => 'OK'); next; } $userinfo = "converting $_ to JPEG $tpic ..."; $userInfoL->update; my $command = "convert"; $command .= " -quality ".$config{PicQuality}." \"$dpic\" \"$tpic\""; $top->Busy; #(system "$command") == 0 or warn "$command failed: $!"; execute($command); $top->Unbusy; $converted++ if ((-f $tpic) and (!-z $tpic)); if (($del) and ((-f $tpic) and (!-z $tpic))) { removeFile($dpic); } } return $converted; } ############################################################## # showNonJPEGS - show all non JPEG files of the actual dir ############################################################## sub showNonJPEGS { my @files = getFiles($actdir); # put just the files not matching jpg, jpeg, JPG or JPEG in the file list my @nonjpeg = grep {!m/.*\.jp(g|eg)$/i} @files; my $info = "There are ".scalar @nonjpeg." non-JPEGs in $actdir:\n\n"; foreach (sort @nonjpeg) { my $size = getFileSize("$actdir/$_", NO_FORMAT); $info .= sprintf "%-45s %12s Bytes\n", $_, $size; } showText("Non-JPEGs", $info, WAIT); } ############################################################## # convertNonJPEGS ############################################################## sub convertNonJPEGS { my @files = getFiles($actdir); # put just the files not matching jpg, jpeg, JPG or JPEG in the file list my @nonjpeg = grep {!m/.*\.jp(g|eg)$/i} @files; handleNonJPEG($actdir, @nonjpeg); updateThumbs(); } ############################################################## # getPics - returns the piclist of the given dir ############################################################## sub getPics { my $dir = shift; my $with_path = shift; # WITH_PATH or JUST_FILE my @other; my @files = getFiles($dir); # are there non-JPEG pictures in this directory? if ($config{CheckForNonJPEGs}) {# and !$dirHotlist{$dir}) { @other = grep {m/.*\.($nonJPEGsuffixes)$/i} @files; my @otherNoJPEG; foreach (@other) { $_ =~ m/(.*)\.($nonJPEGsuffixes)$/i; # separate the name from the suffix my $jpeg = "$1.jpg"; # built the corresponding jpeg file name if (!-f "$dir/$jpeg") { # if this doesn't exists push @otherNoJPEG, $_ # we push it to this list } } # are there some non-JPEGs without corresponding JPEGs? if (@otherNoJPEG > 0) { my $reread = handleNonJPEG($dir, @otherNoJPEG); # ask the user to convert them @files = getFiles($dir) if $reread; # reread file list if necessary } } # put just the files matching jpg, jpeg, JPG or JPEG in the file list #my @jpegs = grep {m/.*\.(jp(g|eg))|(gif)|(xpm)|(ppm)|(xbm)|(ti(f|ff))|(svg)|(png)|(bmp)$/i} @files; my @jpegs; if ($config{supportOtherPictureFormats}) { @jpegs = grep {m/.*\.(jp(g|eg))|(gif)|(xpm)|(ppm)|(xbm)|(ti(f|ff))|(svg)|(png)|(bmp)|(nef)|(raw)$/i} @files; } else { @jpegs = grep {m/.*\.jp(g|eg)$/i} @files; } # if we are in the actual dir, display the number of non-JPEG files if ($dir eq $actdir) { $otherFiles = @files - @jpegs; $otherFiles = "" if ($otherFiles == 0); } $dir =~ s|/*$||; # remove trailing slashes if ($with_path == WITH_PATH) { foreach (@jpegs) { $_ = "$dir/$_"; } # add the path to each file } return @jpegs; } ############################################################## # sortPics - sorts a list of pictures according to $sortby ############################################################## sub sortPics { my $sortby = shift; my $sortreverse = shift; my $pics = shift; # reference on array to sort print "sortby = $sortby\n" if $verbose; my $str = "sorting ".scalar @$pics." pictures by $sortby"; $str .= " (reverse)" if $sortreverse; $userinfo = "$str ..."; $userInfoL->update; clearQuickSortHashes(); # remove old values $quickSortSwitch = 1; # activate quick sort/buffering if ($sortby eq "name") { # sort alphabetical with no case @$pics = sort { uc(basename($a)) cmp uc(basename($b)) } @$pics; } elsif ($sortby eq "date") { # sort by file date and name #@$pics = sort { getFileDate($b, NO_FORMAT) <=> getFileDate($a, NO_FORMAT) || #uc($a) cmp uc($b) } @$pics; @$pics = sort { $searchDB{$b}{MOD} <=> $searchDB{$a}{MOD} || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "exifdate") { #@$pics = sort { getEXIFDate($b) cmp getEXIFDate($a) || #uc($a) cmp uc($b) } @$pics; @$pics = sort { $searchDB{$b}{TIME} <=> $searchDB{$a}{TIME} || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "aperture") { @$pics = sort { getEXIFAperture($a, NUMERIC) <=> getEXIFAperture($b, NUMERIC) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "exposuretime") { @$pics = sort { getEXIFExposureTime($a, NUMERIC) <=> getEXIFExposureTime($b, NUMERIC) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "model") { @$pics = sort { uc(getEXIFModel($a)) cmp uc(getEXIFModel($b)) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "artist") { @$pics = sort { uc(getEXIFArtist($a)) cmp uc(getEXIFArtist($b)) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "size") { #@$pics = sort { getFileSize($a, NO_FORMAT) <=> getFileSize($b, NO_FORMAT) || #uc($b) cmp uc($a) } @$pics; @$pics = sort { $searchDB{$b}{SIZE} <=> $searchDB{$a}{SIZE} || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "pixel") { @$pics = sort { getPixels($a) <=> getPixels($b) || uc($b) cmp uc($a) } @$pics; } elsif ($sortby eq "bitpix") { @$pics = sort { getBitPix($a) <=> getBitPix($b) || uc($b) cmp uc($a) } @$pics; } elsif ($sortby eq "urgency") { @$pics = sort { getIPTCurgencyDB($a) <=> getIPTCurgencyDB($b) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "popularity") { @$pics = sort { $searchDB{$b}{POP} <=> $searchDB{$a}{POP} || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "byline") { @$pics = sort { uc(getIPTCByLine($a)) cmp uc(getIPTCByLine($b)) || uc($a) cmp uc($b) } @$pics; } elsif ($sortby eq "random") { fisher_yates_shuffle($pics); #@$pics = @$pics; } else { my $sort = "undefined!"; $sort = $sortby if (defined $sortby); warn "sortPics: error: wrong sort: $sort - sorting by name"; @$pics = sort { uc($a) cmp uc($b); } @$pics; } clearQuickSortHashes(); # free mem $quickSortSwitch = 0; # stop quick search if ($sortreverse and ($sortby ne "random")) { @$pics = reverse @$pics; } } ############################################################## # clearQuickSortHashes - reset all sort hashes ############################################################## sub clearQuickSortHashes { undef %quickSortHash; undef %quickSortHashSize; undef %quickSortHashPixel; undef %quickSortHashBitsPixel; } ############################################################## # getFileDate - parameter: file (with absolute path) # format ############################################################## sub getFileDate { my $dpic = shift; my $format = shift; # FORMAT = the date is returned in this date format (dd.mm.yyyy hh:mm:ss); NO_FORMAT return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (-f $dpic) { warn "$dpic is no file!" if $verbose; return 0; } my $filedate = (lstat $dpic)[9]; # 9 is the modify time $filedate = buildDateTime($filedate) if ((defined $format) and ($format == FORMAT)); $quickSortHash{$dpic} = $filedate if $quickSortSwitch; return $filedate; } ############################################################## # getEXIFDate - parameter: file (with absolute path) # image info (optional) # returns yyyy:mm:dd hh:mm:ss ############################################################## sub getEXIFDate { my $dpic = shift; my $er = shift; # optional, the EXIF hash ref if available return "" unless (is_a_JPEG($dpic)); return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (defined($er)) { my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ; $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); warn "$dpic has no exif info" if ($verbose and (!defined($er))); } my $date = []; my $datestr = ""; if (defined $er->{'SUBIFD_DATA'}->{DateTimeOriginal}) { $datestr = ${$er->{'SUBIFD_DATA'}->{DateTimeOriginal}}[0]; } elsif (defined $er->{'SUBIFD_DATA'}->{DateTimeDigitized}) { $datestr = ${$er->{'SUBIFD_DATA'}->{DateTimeDigitized}}[0]; } elsif (defined $er->{'IFD0_DATA'}->{DateTime}) { $datestr = ${$er->{'IFD0_DATA'}->{DateTime}}[0]; } else { } $datestr =~ tr/\000/ /; # remove null termination (\000) chars $datestr =~ s/( )*$//g; # remove trailing space printf "getEXIFDate: -%s- (%s)\n", $datestr, basename($dpic) if $verbose; $quickSortHash{$dpic} = $datestr if $quickSortSwitch; return $datestr; } ############################################################## # getEXIFModel - parameter: file (with absolute path) # image info (optional) ############################################################## sub getEXIFModel { my $dpic = shift; my $er = shift; # optional, the EXIF hash ref if available return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (defined($er)) { my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ; $er = $meta->get_Exif_data('ALL', "TEXTUAL"); warn "$dpic has no exif info" unless (defined $er); } my $maker = ""; if (defined $er->{'IFD0_DATA'}->{'Make'}) { $maker = ${$er->{'IFD0_DATA'}->{'Make'}}[0]; $maker =~ s/( co\.,ltd)//i; # some companies are a little to verbose here, $maker =~ s/( co\., ltd\.)//i; $maker =~ s/( optical)//i; # so we try to short some words $maker =~ s/( electric)//i; $maker =~ s/(\.)//i; $maker =~ s/( corporation)//i; $maker =~ s/(eastman kodak company)/KODAK/i; $maker =~ s/(hewlett-packard company)/Hewlett-Packard/i; $maker =~ s/(konica)/Konica/i; $maker =~ s/(pentax)/Pentax/i; $maker =~ s/(nikon)/Nikon/i; } my $model = ""; if (defined $er->{'IFD0_DATA'}->{'Model'}) { $model = ${$er->{'IFD0_DATA'}->{'Model'}}[0]; $model =~ s/(digital camera )//i; # uh, really! :) - ok it could also be a scanner ... $model =~ s/(digital camera)//i; # sometimes with trailing space, sometimes not ... $model =~ s/(digital science )//i; # this is really to verbose ... $model =~ s/(digital science)//i; # sometimes with trailing space, sometimes not ... $model =~ s/( digital)//i; # $model =~ s/(kodak )//i; # hello! we already had this in the Make field ... $model =~ s/(canon )//i; $model =~ s/(konica )//i; $model =~ s/(pentax )//i; $model =~ s/(nikon )//i; $model =~ s/(sigma )//i; $model =~ s/(HP )//; } $quickSortHash{$dpic} = "$maker $model" if $quickSortSwitch; return "$maker $model"; } ############################################################## # getEXIFArtist - parameter: file (with absolute path) # image info (optional) ############################################################## sub getEXIFArtist { my $dpic = shift; my $er = shift; # optional, the EXIF hash ref if available return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (defined($er)) { my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ; $er = $meta->get_Exif_data('ALL', "TEXTUAL"); warn "$dpic has no exif info" unless (defined $er); } my $artist = ""; if (defined $er->{'IFD0_DATA'}->{Artist}) { $artist = ${$er->{'IFD0_DATA'}->{Artist}}[0]; } $quickSortHash{$dpic} = $artist if $quickSortSwitch; print "Artist: $artist pic:$dpic\n" if $verbose; return $artist; } ############################################################## # getEXIFAperture - parameter: file (with absolute path) # format (boolean) # image info (optional) ############################################################## sub getEXIFAperture { my $dpic = shift; my $format = shift; # NUMERIC or STRING my $er = shift; # optional, the EXIF hash ref if available return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (defined($er)) { my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ; $er = $meta->get_Exif_data('ALL', "TEXTUAL"); warn "$dpic has no exif info" unless (defined $er); } # FNumber: The actual F-number (F-stop) of lens when the image was taken. my $aperture = 0; if (defined $er->{'SUBIFD_DATA'}->{FNumber}) { $aperture = calc($er->{'SUBIFD_DATA'}->{FNumber}); } elsif (defined $er->{'SUBIFD_DATA'}->{ApertureValue}) { $aperture = calc($er->{'SUBIFD_DATA'}->{ApertureValue}); } else { } $aperture = sprintf("F%02.1f ", $aperture) if (($format == STRING) and ($aperture != 0)); $quickSortHash{$dpic} = $aperture if $quickSortSwitch; return $aperture; } ############################################################## # getEXIFExposureTime - parameter: file (with absolute path) # format (boolean) # image info (optional) ############################################################## sub getEXIFExposureTime { my $dpic = shift; my $format = shift; # STRING -> return a string ("1/20s "), NUMERIC -> return a value (0,05) my $er = shift; # optional, EXIF hash ref my $exti = ""; # exposure time as string my $extiN = 0; # exposure time as number return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); unless (defined($er)) { my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') ; $er = $meta->get_Exif_data('ALL', "TEXTUAL"); if ($verbose) { warn "$dpic has no exif info" unless (defined $er); } } if (defined $er->{'SUBIFD_DATA'}->{'ExposureTime'}) { my $time = $er->{'SUBIFD_DATA'}->{'ExposureTime'}; warn "getEXIFExposureTime: not enough numbers!" if (@{$time} < 2); # this should not happen if ($$time[1] == 0) { warn "error ".basename($dpic)." wrong EXIF exposure time t0:$$time[0] t1:$$time[1]"; $format == STRING ? return "" : return 0; } if (($$time[0]/$$time[1]) >= 1) { # handle long time exposure (e.g. 800/100) $exti = sprintf "%.2f",($$time[0]/$$time[1]); $extiN = $exti; } else { # handle everything faster than one second if ($$time[0] != 1) { # some cameras use the format 10/600 if ($$time[0] == 0) { print "error ".basename($dpic)." div by zero exti:$exti t0: $$time[0] t1:$$time[1]\n" if $verbose; $exti = "1/$$time[1]?"; $extiN = 0; } else { $exti = "1/".int($$time[1]/$$time[0]); # instead of 1/60 so we have to normalize this $extiN = 1/int($$time[1]/$$time[0]); } } else { $exti = "1/".$$time[1]; $extiN = 1/$$time[1]; } } } elsif (defined $er->{'SUBIFD_DATA'}->{'ShutterSpeedValue'}) { my $time = $er->{'SUBIFD_DATA'}->{'ShutterSpeedValue'}; $exti = ($$time[0]/$$time[1]); $exti = int(2**$exti); $extiN = 1/$exti; $exti = "1/".$exti; } else { $exti = ""; $extiN = 0; } my $rc = 0; if ($format == STRING) { if ($exti eq "") { $rc = ""; } else { $rc = $exti."s "; # add the time unit (s = second) } } else { #$format == NUMERIC $rc = $extiN; } $quickSortHash{$dpic} = $rc if $quickSortSwitch; return $rc; } ############################################################## # getFiles - returns the filelist of the given dir ############################################################## sub getFiles { my $dir = shift; print " getFiles: in $dir\n" if $verbose; my @fileDirList = readDir($dir); my @fileList; foreach (@fileDirList) { # put only files which are not empty into the filelist push @fileList, $_ if ((-f "$dir/$_") and (!-z "$dir/$_")); } return @fileList; } ############################################################## # getDirs - returns the dir list of the given dir ############################################################## sub getDirs { my $dir = shift; my @fileDirList = readDir($dir); my @dirList; foreach (@fileDirList) { next if (($_ eq '.') or ($_ eq '..')); my $item = Encode::encode('iso-8859-1', "$dir/$_"); #my $d2 = Encode::encode('iso-8859-1', $d); #print "getDirs: encoded: $item"; #if (-d $item) { print " is a dir\n"; } #else { print " is not a dir\n"; } push @dirList, $item if (-d $item); } @dirList = sort { uc($a) cmp uc($b) } @dirList; return @dirList; } ############################################################## # getDirsRecursive - returns all subdirs of the given dir # $dir is also included in list # mapivi and gimp subdirs are skipped # dirs starting with "." are skipped ############################################################## sub getDirsRecursive { my $dir = shift; my @dirs; find(sub { if (-d and ($_ !~ m|^\.|) and ($_ ne $thumbdirname) and ($_ ne $exifdirname)) { push @dirs, $File::Find::name; } }, $dir); return @dirs; } ############################################################## # readDir - reads the contents of the given directory ############################################################## sub readDir { my $dir = shift; $dir = Encode::encode('iso-8859-1', $dir); if (! -d $dir) { warn "readDir: $dir is no dir!: $!" unless (($dir =~ m/.*$thumbdirname$/) or ($dir =~ m/.*$plugindir$/)); return 0; } my @fileDirList; # open the directory if (!opendir ACTDIR, "$dir") { warn "Can't open folder $dir: $!"; return 0; } # show no files starting with a '.', but '..' @fileDirList = grep /^(\.\.)|^[^\.]+.*$/, readdir ACTDIR; closedir ACTDIR; return @fileDirList; } ############################################################## # restart ############################################################## sub restart { saveAllConfig(); freeMem(); system "mapivi &"; exit; } ############################################################## # quitMain ############################################################## sub quitMain { saveAllConfig(); freeMem(); exit; } ############################################################## # freeMem ############################################################## sub freeMem { # clean up all photo objects $userinfo = "free mem ..."; $userInfoL->update; foreach ($top->imageNames) { if (defined $_) { print "cleaning up: $_\n" if $verbose; $_->delete; } else { warn "image $_ is not defined!"; } } $userinfo = "exit ..."; $userInfoL->update; } ############################################################## # saveAllConfig ############################################################## sub saveAllConfig { $userinfo = "saving configuration ..."; $userInfoL->update; $config{Geometry} = $top->geometry; $keyXBut->invoke if (Exists($keyw)); # this will trigger the saving of the treemode and win geometry saveAdjusterPos(); $config{LastDir} = $actdir if (-d $actdir); $config{ActPic} = $actpic; # we don't want to start in full screen mode # so if we've been in fullscreen mode, we save the settings from before the fullscreen switch if ($topFullScreen) { print "saveAllConfig called in full screen mode\n" if $verbose; $config{Geometry} = $topFullSceenConf{Geometry}; $config{ShowMenu} = $topFullSceenConf{ShowMenu}; $config{ShowInfoFrame} = $topFullSceenConf{ShowInfoFrame}; $config{ShowCommentField} = $topFullSceenConf{ShowCommentField}; $config{ShowCaptionField} = $topFullSceenConf{ShowCaptionField}; $config{ShowEXIFField} = $topFullSceenConf{ShowEXIFField}; $config{Layout} = $topFullSceenConf{Layout}; } else { print "saveAllConfig called in normal screen mode\n" if $verbose; } $userinfo = "saving options ..."; $userInfoL->update; saveConfig($configFile, \%config); if ($config{SaveDatabase}) { $userinfo = "saving search database ..."; $userInfoL->update; nstore(\%searchDB, "$configdir/SearchDataBase") or warn "could not store searchDB in file $configdir/SearchDataBase: $!"; } $userinfo = "saving dir hotlist ..."; $userInfoL->update; nstore(\%dirHotlist, "$configdir/hotlist") or warn "could not store $configdir/hotlist: $!"; my $datetime = getDateTime(); # save a copy of the old hash in the trash # todo: remove very old backups $userinfo = "saving dir check list ..."; $userInfoL->update; mycopy("$configdir/dirProperties", "$trashdir/dirProperties-$datetime", OVERWRITE) if (-f "$configdir/dirProperties"); nstore(\%dirProperties, "$configdir/dirProperties") or warn "could not store $configdir/dirProperties: $!"; nstore(\%ignore_keywords, "$configdir/keywords_ignore") or warn "could not store $configdir/keywords_ignore: $!"; if (MatchEntryAvail) { $userinfo = "saving entry values ..."; $userInfoL->update; nstore(\%entryHistory, $file_Entry_values) or warn "could not store $file_Entry_values: $!"; } $userinfo = "saving categories ..."; $userInfoL->update; saveArrayToFile("$configdir/categories", \@precats); $userinfo = "saving keywords ..."; $userInfoL->update; saveArrayToFile("$configdir/keywords", \@prekeys); $userinfo = "ready!"; $userInfoL->update; } ############################################################## # getComment - returns a string containing all Comments # (if available) of the given pic (up to 64K per # block, nr of blocks is not limited, so this can # get pretty huge!) ############################################################## sub getComment { my $dpic = shift; my $format = shift; # LONG or SHORT my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available return "" unless is_a_JPEG($dpic); # todo support GIF and PNG comments my @comments = getComments($dpic, $meta); return "" if (@comments <= 0); my $comment = ""; # put the comments togehter, adding a newline after each comment foreach (@comments) { $comment .= "$_\n"; } $comment =~ s/\r*//g; # remove \r (carriage return) $comment =~ s/\n+$//; # cut off last newline(s) $comment = formatString($comment, $config{LineLength}, $config{LineLimit}) if ($format == SHORT); print "getComment: $comment $dpic\n" if $verbose; return $comment; } ############################################################## # getComments - returns an array containing all Comments # (if available) of the given pic (up to 64K per # block, nr of blocks is not limited, so this can # get pretty huge!) ############################################################## sub getComments { my $dpic = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available $meta = getMetaData($dpic, "COM", 'FASTREADONLY') unless (defined($meta)); my @coms = (); if ($meta) { @coms = $meta->get_comments(); #print "getComments: $dpic:\n"; foreach (@coms) { print " com: $_\n"; } print "\n"; #foreach (@coms) { # if (Encode::is_utf8($_)) { # $_ = decode("utf8", $_); # #print "getComments: decoded UTF8: $_\n"; # } #} } else { warn "*** getComments: no meta for $dpic available!" if ($verbose); } #foreach (@coms) { print "getComments: $_\n"; } return @coms; } ############################################################## # getShortEXIF - returns a string containing some of the # EXIF-Data (if available) of the given pic # if wrap is true the string is broken in # several lines (for thumbnail view) ############################################################## sub getShortEXIF { my $dpic = shift; my $wrap = shift; # WRAP or NO_WRAP my $meta = shift; # optional my $exif = ""; return $exif unless is_a_JPEG($dpic); $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY') unless (defined($meta)); # add a symbol ([s]) to the exif column for each picture with saved EXIF data if (-f dirname($dpic)."/$exifdirname/".basename($dpic)) { $exif .= "[s] "; } return unless (defined($meta)); my $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); # er = exif hash ref todo: use IMAGE_DATA instead of ALL? unless (defined $er) { return $exif; } # Some cameras store settings in Maker Notes, so it is important to know # the make of the camera. my $make = ""; if (defined $er->{'IFD0_DATA'}->{'Make'}) { $make = ${$er->{'IFD0_DATA'}->{'Make'}}[0]; } # check for thumbnail if (defined $er->{ROOT_DATA}->{ThumbnailData}) { $exif .= "[t] "; } my $datestr = ""; $datestr = getEXIFDate($dpic, $er); if ($datestr ne "") { if (my ($y, $M, $d, $h, $m, $s) = $datestr =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { #$exif .= "$d.$M.$y $h:$m:$s "; # german date format #$exif .= "$M/$d/$y $h:$m:$s "; # american date format $exif .= "$y-$M-$d $h:$m:$s "; # ISO 8601 date format $exif .= "\n" if $wrap; } else { warn "picture has an unusual EXIF date: \"$datestr\" ($dpic)\n" if $config{MetadataWarn}; } } if (defined $er->{'SUBIFD_DATA'}->{FocalLength}) { my $flength = int(calc($er->{'SUBIFD_DATA'}->{FocalLength})); $exif .= $flength."mm "; } if (defined $er->{'SUBIFD_DATA'}->{'FocalLengthIn35mmFilm'}) { $exif .= "(".join('', @{$er->{'SUBIFD_DATA'}->{'FocalLengthIn35mmFilm'}})."mm) "; } my $aperture = getEXIFAperture($dpic, STRING, $er); $exif .= $aperture if ($aperture ne "0"); my $exti = getEXIFExposureTime($dpic, STRING, $er); $exif .= "$exti"; if (defined $er->{'SUBIFD_DATA'}->{'ExposureBiasValue'}) { my $bias = calc($er->{'SUBIFD_DATA'}->{'ExposureBiasValue'}); if (($bias eq "-") and $config{MetadataWarn}) { warn "unusal EXIF ExposureBiasValue (".$er->{'SUBIFD_DATA'}->{'ExposureBiasValue'}.") in picture $dpic\n"; } $exif .= sprintf("+%1.1f ", $bias) if (($bias ne "-") and ($bias > 0)); $exif .= sprintf( "%1.1f ", $bias) if (($bias ne "-") and ($bias < 0)); } if (defined $er->{'SUBIFD_DATA'}->{'ISOSpeedRatings'}) { $exif .= "ISO".${$er->{'SUBIFD_DATA'}->{'ISOSpeedRatings'}}[0]." "; } else{ # Same as ISOSpeedRatings. Only Kodak's camera uses this tag instead of ISOSpeedRating if (defined $er->{'SUBIFD_DATA'}->{'ExposureIndex'}) { my $iso = calc($er->{'SUBIFD_DATA'}->{'ExposureIndex'}); $exif .= "ISO$iso "; } else { # Nikon and Canon hide the ISO settings in the Makernotes my $seg = $meta->retrieve_app1_Exif_segment(); if ($seg) { my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL'); if ($make =~ m/Canon/) { if (exists $makernote->{'CameraSettings'}) { my $iso = $makernote->{'CameraSettings'}[16]; if ($iso == 15) { $exif .= "ISO-Auto "; } elsif (16 <= $iso && $iso <= 19) { $exif .= "ISO".(50 * (1 << ($iso - 16)))." "; } } } elsif (exists $makernote->{'ISOSetting'}) { my $iso = $makernote->{'ISOSetting'}; $exif .= "ISO$$iso[1] "; } } } } # this part will repair Nikon D70 files (ISO info is just available in the Makernotes) # by setting the ISO value in the right EXIF tag (ISOSpeedRatings) #if (($iso_value > 1) and ($iso_value < 30000)) { #print "adding ISO value $iso_value to $dpic\n"; ## the other $meta is read only #my $meta2= new Image::MetaData::JPEG($dpic, 'APP1$'); #my $hash = $meta2->set_Exif_data({'ISOSpeedRatings' => $iso_value}, 'IMAGE_DATA', 'ADD'); #if (%$hash) { # print "ISO record rejected\n"; #} #else { # unless ($meta2->save()) { # print "Save ISO failed for $dpic\n"; # } #} $exif .= "\n" if $wrap; my $exposureStr = ""; # Canon places specific exposure program in maker note. if ($make =~ m/Canon/) { my $seg = $meta->retrieve_app1_Exif_segment(); if ($seg) { my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL'); if (exists $makernote->{'CameraSettings'}) { my %CanonExp = ( 0 => "Easy shooting", 1 => "Program", 2 => "Shutter priority", 3 => "Aperture priority", 4 => "Manual", 5 => "Auto-DEP", 6 => "DEP" ); my %CanonEasy = ( 0 => "Auto", 1 => "Manual", 2 => "Landscape", 3 => "Fast shutter", 4 => "Slow shutter", 5 => "Night", 6 => "B/W", 7 => "Sepia", 8 => "Portrait", 9 => "Sports", 10 => "Macro/Close-Up", 11 => "Pan focus" ); my $exp = $makernote->{'CameraSettings'}[20]; if (defined $exp) { $exposureStr = $CanonExp{$exp} if (defined $CanonExp{$exp}); if ($exp == 0) { # Find more specific "Easy shooting" mode $exp = $makernote->{'CameraSettings'}[11]; $exposureStr = "\$" . $exp; $exposureStr = $CanonEasy{$exp} if (defined $CanonEasy{$exp}); } } } } } if (($exposureStr eq "") && defined $er->{'SUBIFD_DATA'}->{'ExposureProgram'}) { my @ExposureProgram = ("Not defined", "Manual", "Program", "Aperture priority", "Shutter priority", "Creative program", "Action program", "Portrait mode", "Landscape mode"); my $prog = ${$er->{'SUBIFD_DATA'}->{ExposureProgram}}[0]; #print "$dpic: ".$ExposureProgram[$prog]; foreach (@{$er->{'SUBIFD_DATA'}->{ExposureProgram}}) { print " +Expo : $_"; } print "\n"; $exposureStr = $ExposureProgram[$prog] if ($prog > 0); } if ($exposureStr eq "") { # some camera uses this tag instead of ExposureProgram if (defined $er->{'SUBIFD_DATA'}->{ExposureMode}) { my @ExposureMode = ("Auto exposure", "Manual exposure", "Auto bracket"); my $mode = ${$er->{'SUBIFD_DATA'}->{ExposureMode}}[0]; $exposureStr = $ExposureMode[$mode] if ($mode >= 0); } } $exif .= $exposureStr." " if ($exposureStr ne ""); if (defined $er->{'SUBIFD_DATA'}->{'Flash'}) { if (${$er->{'SUBIFD_DATA'}->{'Flash'}}[0] & 1) { $exif .= "flash "; } } if ($config{ShowMoreEXIF}) { # show contrast sharpness saturation metering white balance my @automanual = ("Auto", "Manual"); my @saturation = ("Normal", "Low", "High"); my @contrast = ("Normal", "Soft", "Hard"); my @metering = ("unknown", "Average", "CenterWeightedAverage", "Spot", "MultiSpot", "Pattern", "Partial", "Other"); my $exifplus = ""; if (defined $er->{'SUBIFD_DATA'}->{Contrast}) { my $con = ${$er->{'SUBIFD_DATA'}->{Contrast}}[0]; $exifplus .= "Contrast: ".$contrast[$con]." " if ($con > 0); } if (defined $er->{'SUBIFD_DATA'}->{Sharpness}) { my $sha = ${$er->{'SUBIFD_DATA'}->{Sharpness}}[0]; $exifplus .= "Sharpness: ".$contrast[$sha]." " if ($sha > 0); } if (defined $er->{'SUBIFD_DATA'}->{Saturation}) { my $sat = ${$er->{'SUBIFD_DATA'}->{Saturation}}[0]; $exifplus .= "Saturation: ".$saturation[$sat]." " if ($sat > 0); } $exifplus = "\n$exifplus" if ($wrap and ($exifplus ne "")); if (defined $er->{'SUBIFD_DATA'}->{MeteringMode}) { my $met = ${$er->{'SUBIFD_DATA'}->{MeteringMode}}[0]; $exifplus .= "\n" if $wrap; $met = 7 if ($met > 7); $exifplus .= "Metering: ".$metering[$met]." " if ($met >= 0); } if ($verbose and (defined $er->{'SUBIFD_DATA'}->{'OwnerName'})) { print "*** Owner $dpic: ".join('', @{$er->{'SUBIFD_DATA'}->{'OwnerName'}})."\n"; } if ($verbose and (defined $er->{'SUBIFD_DATA'}->{'UserComment'})) { print "*** EXIF comment $dpic: -".join('', @{$er->{'SUBIFD_DATA'}->{'UserComment'}})."-\n"; } my $wbStr = ""; # white balance string # Canon places specific white balance in maker note. if ($make =~ m/Canon/) { my $seg = $meta->retrieve_app1_Exif_segment(); if ($seg) { my $makernote = $seg->get_Exif_data('MAKERNOTE_DATA', 'TEXTUAL'); if (exists $makernote->{'ShotInfo'}) { my %CanonWB = ( 0 => "Auto", 1 => "Daylight", 2 => "Cloudy", 3 => "Tungsten", 4 => "Fluorescent", 5 => "Flash", 6 => "Custom", 7 => "B/W", 8 => "Shade", 9 => "Manual Temperature", 14 => "FluorescentH" ); my $wb = $makernote->{'ShotInfo'}[7]; $wbStr = $CanonWB{$wb} if exists $CanonWB{$wb}; } } } if (($wbStr eq "") && defined $er->{'SUBIFD_DATA'}->{WhiteBalance}) { my $wb = ${$er->{'SUBIFD_DATA'}->{WhiteBalance}}[0]; $wbStr = $automanual[$wb] if ($wb >= 0); } if ($wbStr ne "") { $exifplus .= "\n" if $wrap; $exifplus .= "WB: $wbStr "; } #if (defined $er->{'SUBIFD_DATA'}->{'Orientation'}) { # $exifplus .= "Orientation: ".$er->{'SUBIFD_DATA'}->{'Orientation'}." "; #} my $artist = getEXIFArtist($dpic, $er); $exifplus .= "\nArtist: $artist" if ($artist ne ""); if ($exifplus ne "") { $exif .= "$exifplus" ; } } my $exmod = getEXIFModel($dpic, $er); $exif .= "\n$exmod" if ($exmod ne ""); $exif =~ tr/\000/ /; # remove null termination (\000) chars $exif =~ s/( )+/ /g; # replace more than one space with one my $tmp = $exif; $tmp =~ s/\n//g; # remove newlines $tmp =~ s/\s//g; # remove whitespaces # if there are just newlines and spaces we return an empty string $exif = "" if ($tmp eq ""); return $exif; } ############################################################## # getEXIFMeta ############################################################## sub getEXIFMeta { my $dpic = shift; my $exif = ''; return $exif unless is_a_JPEG($dpic); my $pic = basename($dpic); my $meta = getMetaData($dpic, 'APP1$', 'FASTREADONLY'); my $hash_ref = $meta->get_Exif_data('ALL', "TEXTUAL"); #if (defined $hash_ref->{APP1}->{ThumbnailData}) { #printf "[t] %s\n", basename($dpic); #} #return unless ($verbose); my $num = $meta->retrieve_app1_Exif_segment(-1); print "getEXIFMeta: $pic has $num EXIF APP1 segments\n" if $verbose; my $ref = $meta->retrieve_app1_Exif_segment(); unless (defined $ref) { print "getEXIFMeta: $pic has no EXIF APP1 segments\n" if $verbose; return $exif; } while (my ($d, $h) = each %$hash_ref) { while (my ($t, $a) = each %$h) { my $a2 = ''; foreach (@$a) { $_ =~ tr/ -~//cd; # remove all non-printable chars $a2 .= sprintf "%-5s", $_; } $a2 = cutString($a2, 30 , '..'); $exif .= sprintf "%-25s\t%-25s\t-> %-s\n", $d, $t, $a2; } } return $exif; } ############################################################## # calc - make a number from an array ref containing two numbers # input e.g. [28, 10] -> output: 2.8 ############################################################## sub calc { my $value = shift; if (@{$value} != 2) { warn "calc: no separator -> no values! or division by zero\n" if $config{MetadataWarn}; return join("/", $value); } if ($$value[1] == 0) { if ($$value[0] == 0) { return 0; } else { warn "calc: division by zero" if $config{MetadataWarn}; return 0; } } return ($$value[0] / $$value[1]); #return the calculated number } ############################################################## # displayEXIFData - displays all EXIF-Data in a window ############################################################## sub displayEXIFData($) { my $lb = shift; my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return unless askSelection(\@sellist, 10, "EXIF info"); my $selected = @sellist; my ($pic, $dpic, $i, $thumb); $userinfo = "displaying EXIF data of $selected pictures"; $userInfoL->update; my $pw = progressWinInit($lb, "Display EXIF data"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Display EXIF data ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $thumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $ii = getImageInfo($dpic); if ($ii eq "") { $lb->messageBox(-icon => 'warning', -message => "There are no EXIF-Infos in $dpic!", -title => "No EXIF infos", -type => 'OK'); next; } my $title = "EXIF info of $pic"; my $exifs = getShortEXIF($dpic, NO_WRAP); my $exif = "compact EXIF info:\n$exifs\n\n" if ($exifs ne ""); $exif .= "detailed EXIF info (from Image::Info):\n"; foreach (sort { uc($a) cmp uc($b); } keys %{$ii}) { next if (($_ eq "MakerNote") or ($_ eq "ColorComponentsDecoded") or ($_ =~ m/^App.*/)); if (ref($ii->{$_}) eq "ARRAY") { # handle array entries $exif .= sprintf "%-25s ",$_; foreach (@{$ii->{$_}}) { if (ref($_) eq "ARRAY") { # handle array in array entries foreach (@{$_}) { $exif .= "$_, "; } } elsif (ref($_) eq "HASH") { # handle hash in array entries my %hash = %{$_}; foreach (sort keys %hash) { $exif .= "$_=".$hash{$_}.", "; } } else { # handle normal strings in array entries $exif .= "$_, "; } } $exif =~ s/, $//; # remove trailing comma and space } else { # handle normal string entries $exif .= sprintf "%-25s %s",$_, $ii->{$_}; } $exif .= "\n"; } if ($config{EXIFshowApp}) { foreach (sort { uc($a) cmp uc($b); } keys %{$ii}) { next unless (($_ eq "MakerNote") or ($_ eq "ColorComponentsDecoded") or ($_ =~ m/^App.*/)); if (ref($ii->{$_}) eq "ARRAY") { # handle array entries $exif .= sprintf "%-25s ",$_; foreach (@{$ii->{$_}}) { if (ref($_) eq "ARRAY") { # handle array in array entries foreach (@{$_}) { $exif .= "$_, "; } } elsif (ref($_) eq "HASH") { # handle hash in array entries my %hash = %{$_}; foreach (sort keys %hash) { $exif .= "$_=".$hash{$_}.", "; } } else { # handle normal strings in array entries $exif .= "$_, "; } } $exif =~ s/, $//; # remove trailing comma and space } else { # handle normal string entries my $part = sprintf "%-25s %s",$_, $ii->{$_}; $part =~ s/\n//g; $exif .= $part; } $exif .= "\n"; } } $exif .= "\ndetailed EXIF info (from Image::MetaData::JPEG):\n"; $exif .= getEXIFMeta($dpic); $exif =~ tr/\n -~//cd; # remove non-printable characters (but not \n) showText($title, $exif, NO_WAIT, $thumb); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected displayed)"; $userInfoL->update; } ############################################################## # removeEXIFData - remove all EXIF data in all selected pictures ############################################################## sub removeEXIFData { my $mode = shift; if (!defined $mode) { warn "removeEXIFData: Missing a mode, should be thumb or all!"; return; } my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb, $text); if ($mode eq "all") { $text = "Remove all EXIF infos (picture and camera data and embedded thumbnail picture) of $selected selected pictures."; } elsif ($mode eq "thumb") { $text = "Remove the embedded EXIF thumbnails and other non-camera settings from the EXIF headers of $selected selected pictures."; } else { warn "removeEXIFData: Wrong mode ($mode), should be thumb or all!"; return; } my $rc = $top->messageBox(-icon => 'question', -message => "$text\nOk to continue?", -title => "Question", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); $userinfo = "removing EXIF data of $selected pictures"; $userInfoL->update; $i = 0; my $errors = ""; my $pw = progressWinInit($top, "Remove EXIF data"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Remove EXIF data ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); next if (!removeEXIF($dpic, $mode, \$errors)); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected infos removed)"; $userInfoL->update; showText("Errors while removing EXIF data", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # removeEXIF ############################################################## sub removeEXIF { my $dpic = shift; my $mode = shift; my $errors = shift; # reference my $meta = getMetaData($dpic, "APP1"); unless ($meta) { $$errors .= "No EXIF data in $dpic\n"; return 0; } if ($mode eq "all") { $meta->remove_app1_Exif_info(-1); } elsif ($mode eq "thumb") { my $nothumb = ""; my $hash = $meta->set_Exif_data(\$nothumb, 'THUMBNAIL', 'REPLACE'); $$errors .= "Thumbnail record rejected for $dpic\n" if (keys %$hash); } else { die; } unless ($meta->save()) { $$errors .= "Save failed $dpic\n"; return 0; } return 1; } ############################################################## # getEXIFThumb - extract the embedded EXIF thumbnail ############################################################## sub getEXIFThumb { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my $rc = $top->messageBox(-icon => 'question', -message => "Extract embedded EXIF thumbnails of $selected selected pictures and write them to a (new created) subfolder \"EXIFThumbs/\" in the current folder.\nShould I continue?", -title => "Question", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); $userinfo = "extracting embedded EXIF thumbnails of $selected pictures"; $userInfoL->update; if (!-d "$actdir/EXIFThumbs") { if ( !mkdir "$actdir/EXIFThumbs", 0755) { warn "makedir: can not create $actdir/EXIFThumbs: $!"; return; } } my $i = 0; my $errors = ""; my $pw = progressWinInit($top, "Extracting EXIF thumbnails"); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Extracting EXIF thumbnail ($i/$selected) ...", $i, $selected); my $pic = basename($dpic); my $dthumb = "$actdir/EXIFThumbs/$pic"; next if (!getRealFile(\$dpic)); extractThumb($dpic, $dthumb, \$errors); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected thumbs extracted)"; $userInfoL->update; showText("Errors while saving EXIF thumbnail", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # setEXIFDate - adjust the date and time field in the EXIF header ############################################################## sub setEXIFDate { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb, $rc, $command); my $count = 0; if (!$config{setEXIFDateAskAgain}) { $rc = checkDialog("Change EXIF date/time?", "Change the date and time info (EXIF: DateTimeOriginal) of $selected selected pictures. The previous information will be lost!\nShould I continue?", \$config{setEXIFDateAskAgain}, "don't ask again", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); } my $datetime = $config{EXIFDateAbs}; $rc = setEXIFDateDialog(\$datetime); return if ($rc ne 'OK'); if (($config{EXIFAbsRel} eq "abs") and !($datetime =~ m/\d{4}:\d{2}:\d{2}-\d{2}:\d{2}:\d{2}/)) { $top->messageBox(-icon => 'warning', -message => "Sorry, but $datetime has a wrong format!\nShould be: yyyy:mm:dd-hh:mm:ss Aborting.", -title => 'Error', -type => 'OK'); return; } $config{EXIFDateAbs} = $datetime if ($config{EXIFAbsRel} eq "abs"); $userinfo = "changing the date and time of $selected pictures"; $userInfoL->update; $i = 0; my $errors = ""; my $pw = progressWinInit($top, "Changing EXIF date and time"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Changing EXIF date and time ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); if ($config{EXIFAbsRel} eq "abs") { # nothing to do, we just use $datetime $datetime =~ s/-/ /; # replace just the "-" with a space between date and time } elsif ($config{EXIFAbsRel} eq "rel") { my $exif = getEXIFDate($dpic); if (defined($exif) and ($exif =~ m/(\d\d\d\d):(\d\d):(\d\d)\s(\d\d):(\d\d):(\d\d)/)) { my $mon = $2; my $year = $1; $mon--; $year -= 1900; if ($mon >= 0 and $mon <= 11) { # calculate the time as value in seconds since the Epoch (Midnight, January 1, 1970) my $ctime = timelocal($6,$5,$4,$3,$mon,$year); my $hours = $config{EXIFyears} * 365 * 24 + $config{EXIFdays} * 24 + $config{EXIFhours}; my $seconds = $hours * 60 * 60 + $config{EXIFmin} * 60 + $config{EXIFsec}; if ($config{EXIFPlusMin} eq "+") { $ctime = $ctime + $seconds; } else { $ctime = $ctime - $seconds; } my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; $y += 1900; $mo++; # do some adjustments # build up the date time string, similar to the EXIF format $datetime = sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s; } else { $errors .= "Wrong month in EXIF date in $dpic\n"; } } else { $errors .= "No EXIF date in $dpic\n"; } } else { warn "setEXIFDate: wrong value: ", $config{EXIFAbsRel}; return 0; } print "set EXIF datetime: $datetime to $dpic\n" if $verbose; my $meta = getMetaData($dpic, 'APP1$'); unless (defined $meta) { $errors .= "No meta available: $dpic\n"; next; } #date time format: 2007:04:04 11:12:13 my $hash = $meta->set_Exif_data({'DateTime' => $datetime, 'DateTimeOriginal' => $datetime, 'DateTimeDigitized' => $datetime}, 'IMAGE_DATA', 'ADD'); if (keys %$hash) { $errors .= "DateTime record rejeced: $dpic\n"; next; } unless ($meta->save()) { $errors .= "Save failed $dpic\n"; next; } $count++; # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i/$selected)"; $userInfoL->update; showText("Errors while adjusting EXIF date", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # remap_abs_rel ############################################################## sub remap_abs_rel { my $tf = shift; my $af = shift; my $rf = shift; if ($config{EXIFAbsRel} eq 'abs') { $rf->packForget if ($rf->ismapped); $af->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($af->ismapped); } else { $af->packForget if ($af->ismapped); $rf->pack(-in => $tf, -fill => 'both', -padx => 3, -pady => 3) unless ($rf->ismapped); } } ############################################################## # setEXIFDateDialog - get the date/time info from the user # returns 'OK' or 'Cancel' ############################################################## sub setEXIFDateDialog { my $datetime = shift; # var ref date time string (absolute) my $rc = 'Cancel'; # open window my $dtw = $top->Toplevel(); $dtw->title('Set EXIF date and time'); $dtw->iconimage($mapiviicon) if $mapiviicon; $dtw->Label(-text => "You may set the date and time to an absolute or relative value", -bg => $config{ColorBG}, )->pack(-anchor => 'w'); # frame for the absolute/relative radio buttons my $arf = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3); # frame for the time/date adjustment my $tf = $dtw->Frame(-bd => 1, -relief => 'raised')->pack(-fill => 'both', -padx => 3, -pady => 3); my $af = $tf->Frame(); my $rf = $tf->Frame(); $arf->Radiobutton(-text => "use absolute value", -variable => \$config{EXIFAbsRel}, -value => 'abs', -command => sub { remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => "left"); $arf->Radiobutton(-text => "use relative value", -variable => \$config{EXIFAbsRel}, -value => 'rel', -command => sub {remap_abs_rel($tf, $af, $rf); })->pack(-anchor => 'w', -side => "left"); remap_abs_rel($tf, $af, $rf); ######### absolute $af->Label(-text => "Please enter the new date and time to store\nin the selected pictures\n(please use the format: yyyy:mm:dd-hh:mm:ss\nexample: 2008:05:21-11:07:59)", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w'); my $entry = $af->Entry(-textvariable => \$$datetime, -width => 40, )->pack(-fill => 'x', -padx => 3, -pady => 3); # todo that's not enough to switch when focusIn #$entry->bind('', sub { $config{EXIFAbsRel} = "abs"; $af->update(); } ); $entry->selectionRange(0,'end'); # select all $entry->icursor('end'); $entry->xview('end'); ######### relative $rf->Radiobutton(-text => "+ (add time)", -variable => \$config{EXIFPlusMin}, -value => "+")->pack(-anchor => 'w'); $rf->Radiobutton(-text => "- (subtract time)", -variable => \$config{EXIFPlusMin}, -value => "-", -command => sub {$config{EXIFAbsRel} = "rel"})->pack(-anchor => 'w'); labeledScale($rf, 'top', 8, "years", \$config{EXIFyears}, 0, 100, 1); labeledScale($rf, 'top', 8, "days", \$config{EXIFdays}, 0, 365, 1); labeledScale($rf, 'top', 8, "hours", \$config{EXIFhours}, 0, 24, 1); labeledScale($rf, 'top', 8, "minutes", \$config{EXIFmin}, 0, 59, 1); labeledScale($rf, 'top', 8, "seconds", \$config{EXIFsec}, 0, 59, 1); my $OKB; $entry->bind('', sub { $OKB->invoke; } ); $entry->focus; my $ButF = $dtw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 'OK'; $dtw->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $XBut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 'Cancel'; $dtw->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $dtw->bind('', sub { $XBut->invoke; }); $dtw->Popup; $dtw->waitWindow(); return $rc; } ############################################################## # showEXIFThumb - displays the embedded EXIF thumbnail ############################################################## sub showEXIFThumb { my $noThumbIn = ""; my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return unless askSelection(\@sellist, 10, "EXIF thumbnail"); if (!-d $trashdir) { # we need the trash dir for the temp files $top->messageBox(-icon => 'warning', -message => "Trash folder $trashdir not found!\nPlease create this folder (shell: mkdir $trashdir) and retry.\n\nAborting.", -title => "No trash folder", -type => 'OK'); return; } my $pw = progressWinInit($top, "Show EXIF thumbnail"); my $i = 0; foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Show EXIF thumbnail ($i/".scalar @sellist.") ...", $i, scalar @sellist); my $pic = basename($dpic); my $exifthumb = "$trashdir/EXIFthumb-$pic"; if (-f $exifthumb) { $top->messageBox(-icon => 'warning', -message => "There is something wrong, $exifthumb already exists.\nPlease delete it first.\nSkipping!", -title => 'Warning', -type => 'OK'); next; } my $errors = ""; extractThumb($dpic, $exifthumb, \$errors); if (!-f $exifthumb) { $noThumbIn .= "$pic\n"; next; } showPicInOwnWin($exifthumb); # show the thumb # remove the thumb removeFile($exifthumb); } progressWinEnd($pw); showText("No EXIF thumbnail", "Sorry, there seems to be no embedded EXIF thumbnail in the following pictures:\n\n$noThumbIn" ,NO_WAIT) if ($noThumbIn ne ""); $userinfo = "ready! ($i of ".scalar @sellist." thumbs)"; $userInfoL->update; } ############################################################## # copyEXIFData - copy the EXIF infos from one picture to others ############################################################## sub copyEXIFData { my $direction = shift; if (!defined $direction) { warn "copyEXIFData: Missing a direction, should be from or to!"; return; } #return if (!checkExternProgs("copyEXIFData", "jhead")); my @sellist = $picLB->info('selection'); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb); my $errors = ""; if ($direction eq "from") { # set the copy source if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture (the picture from which the EXIF info should be taken) for this function!", -title => 'Error', -type => 'OK'); return; } $copyEXIFDataSource = $sellist[0]; # save source pic to global variable $userinfo = "copy source set to ".basename($copyEXIFDataSource); $top->update; return; # that's all for now ;-) } elsif ($direction eq "to") { return unless checkSelection($top, 1, 0, \@sellist); if ((!defined $copyEXIFDataSource) or (!-f $copyEXIFDataSource)) { $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which the EXIF info should be taken) first, and than choose EXIF info->copy from!", -title => 'Error', -type => 'OK'); return; } my $exif = getShortEXIF($copyEXIFDataSource, WRAP); my $EXIFthumb = ""; # temp file holding the embedded EXIF thumbnail $EXIFthumb = "$configdir/".basename($copyEXIFDataSource); extractThumb($copyEXIFDataSource, $EXIFthumb, \$errors); my $message = "Copy the EXIF infos:\ -------------\ $exif\ -------------\ and the embedded thumbnail from\ \"".basename($copyEXIFDataSource)."\"\ to $selected selected pictures.\ The original EXIF infos and thumbnails of these pictures will be lost!\ Ok to continue?"; my $rc = myButtonDialog("Copy EXIF data", "$message", $EXIFthumb, 'OK', 'Cancel'); removeFile($EXIFthumb); # remove temp thumbnail file return if ($rc ne 'OK'); $userinfo = "transfering EXIF infos to $selected pictures"; $userInfoL->update; $i = 0; my $pw = progressWinInit($picLB, "Copy EXIF data"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "transfering EXIF info ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $rc = copyEXIF( $copyEXIFDataSource, $dpic); $errors .= "$rc\n" if ($rc ne "1"); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); } progressWinEnd($pw); } else { warn "copyEXIFData: Wrong direction ($direction), should be from or to!"; return; } $userinfo = "ready! ($i/$selected copied)"; $userInfoL->update; showText("Errors while copying EXIF infos", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # copyEXIF ############################################################## sub copyEXIF { my $from = shift; my $to = shift; if (!-f $from) { warn "copyEXIF: file $from does not exists!\n"; return; } if (!-f $to) { warn "copyEXIF: file $to does not exists!\n"; return; } # from file my $meta = getMetaData($from, '^APP1$', 'FASTREADONLY'); return "Could not get EXIF info of source $from!" unless (defined $meta); # to file my $meta2 = getMetaData($to, '^APP1$'); return "Could not get EXIF info of target $to!" unless (defined $meta2); # find the EXIF segment my $seg = extract_app1_Exif_segment($meta); return "Could not get EXIF segment of source $from!" unless (defined $seg); # insert the segment and save the picture insert_app1_Exif_segment($meta2, $seg); my $result = $meta2->save(); return "save failed for $to" unless ($result); return 1; } ############################################################## # extract_app1_Exif_segment - sub supplied from Stefano Bettelli ############################################################## sub extract_app1_Exif_segment { my ($this) = @_; my $segment = $this->retrieve_app1_Exif_segment(); return undef unless $segment; # this removes the segment from the picture (in memory) # you could skip this if the picture is no more used @{$this->{segments}} = grep { $_ != $segment } @{$this->{segments}}; # this unlinks the picture from the segment, orphaning it $segment->{parent} = undef; return $segment; } ############################################################## # insert_app1_Exif_segment - sub supplied from Stefano Bettelli ############################################################## sub insert_app1_Exif_segment { my ($this, $segment) = @_; # this locates or produces an Exif segment my $old = $this->provide_app1_Exif_segment(); for (@{$this->{segments}}) { # looking for the segment to replace ... next unless $_ == $old; # tell the segment it now belongs to the picture $segment->{parent} = $this; # tell the picture it now owns the segment $_ = $segment; last; } } ############################################################## # restoreComments - remove existing comments and store the # given list of comments ############################################################## sub restoreComments { my $dpic = shift; my @comments = @_; my $meta = getMetaData($dpic, "COM"); if ($meta) { # remove all existing comments, we want to restore exactly $meta->remove_all_comments(); # write the old comments back if (@comments) { foreach (@comments) { $meta->add_comment($_); } } unless ($meta->save()) { warn "restoreComments: save $dpic failed!"; } } } ############################################################## # EXIFsave - make a new subdir .exif, copy the thumbnail of # the selected pics to this dir, copy the EXIF # info from the original pics to the thumbs ############################################################## sub EXIFsave { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); # make EXIF subdir return if (!makeDir("$actdir/$exifdirname", ASK)); my ($pic, $dpic, $i, $exiffile); my $errors = ""; $i = 0; my $pw = progressWinInit($top, "Save EXIF infos"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Saving EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $exiffile = "$actdir/$exifdirname/$pic"; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $meta = getMetaData($dpic, '^APP1$', 'FASTREADONLY'); unless (defined $meta) { $errors .= "Could not get EXIF info of $pic!\n"; next; } my $seg = extract_app1_Exif_segment($meta); unless (defined $seg) { $errors .= "Could not get EXIF segment of $pic!\n"; next; } unless (nstore($seg, $exiffile)) { $errors .= "could not store EXIF segment in file $exiffile: $!\n"; next; } updateOneRow($dpic, $picLB); # display the new exif info (flag [s] is now set) showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i/".scalar @sellist." saved)"; $userInfoL->update; showText("Errors while saving EXIF infos", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # EXIFrestore - copy the saved EXIF info back to the selected # pics ############################################################## sub EXIFrestore { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); if (!-d "$actdir/$exifdirname") { $top->messageBox(-icon => 'warning', -message => "Found no saved EXIF infos in this folder!", -title => "No EXIF infos", -type => 'OK'); return; } # message for one picture my $message = "Restore saved EXIF infos to ".basename($sellist[0]).".\nThe actual EXIF infos of this picture will be lost!\nOk to continue?"; # message for more than one picture if (@sellist > 1) { $message = "Restore saved EXIF infos\nto the ".scalar @sellist." pictures.\nThe actual EXIF infos of this picture will be lost!\nOk to continue?" } return if (myButtonDialog("Restore EXIF data", "$message", undef, 'OK', 'Cancel') ne 'OK'); my $errors = ""; my $i = 0; my $pw = progressWinInit($top, "Restore EXIF info"); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Restore EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist); my $pic = basename($dpic); my $dirthumb = getThumbFileName($dpic); my $exiffile = "$actdir/$exifdirname/$pic"; unless (-f $exiffile) { $errors .= "Found no saved EXIF infos for $dpic!\n"; next; } # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $meta = getMetaData($dpic, '^APP1$'); unless (defined $meta) { $errors .= "Could not get EXIF info of $dpic!\n"; next; } # load stored EXIF segment from the file my $exif = retrieve($exiffile); unless (defined $exif) { $errors .= "could not retrieve saved EXIF info\n"; next; } insert_app1_Exif_segment($meta, $exif); unless ($meta->save()) { $errors .= "save failed for $dpic\n"; next; } updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); } progressWinEnd($pw); $userinfo = "ready! ($i/".scalar @sellist."restored)"; $userInfoL->update; showText("Errors while restoring EXIF data", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # EXIFremoveSaved - remove the saved exif info file ############################################################## sub EXIFremoveSaved { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); if (!-d "$actdir/$exifdirname") { $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos in this folder!", -title => "no EXIF infos", -type => 'OK'); return; } my $rc = $top->messageBox(-icon => 'warning', -message => "Remove the saved EXIF infos and the embedded thumbnails of ".scalar @sellist." pictures.\nOk to continue?", -title => "Warning", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); my ($pic, $dpic, $i, $exifthumb); $i = 0; my $pw = progressWinInit($top, "Remove saved EXIF infos"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Removing saved EXIF info ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $exifthumb = "$actdir/$exifdirname/$pic"; if ((!-f $exifthumb) and (@sellist == 1)) { # show this info only when removing from one file $top->messageBox(-icon => 'warning', -message => "Sorry, but there are no saved EXIF infos for $pic!", -title => "no EXIF infos", -type => 'OK'); next; } # check if file is a link and get the real target next if (!getRealFile(\$dpic)); # remove the saved EXIF info file removeFile($exifthumb ); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i/".scalar @sellist." exif removed)"; $userInfoL->update; } ############################################################## # copyComment - copy the comment from one picture to others ############################################################## sub copyComment { my $direction = shift; if (!defined $direction) { warn "copyComment: Missing a direction, should be from or to!"; return; } my @sellist = $picLB->info('selection'); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb); if ($direction eq "from") { # set the copy source if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture (the picture from which comments should be taken) for this function!", -title => 'Error', -type => 'OK'); return; } $copyCommentSource = $sellist[0]; # save source pic to global variable $userinfo = "copy source set to ".basename($copyCommentSource); $top->update; return; # that's all for now ;-) } elsif ($direction eq "to") { return unless checkSelection($top, 1, 0, \@sellist); if ((!defined $copyCommentSource) or (!-f $copyCommentSource)) { $top->messageBox(-icon => 'warning', -message => "Please select a source picture (the picture from which the EXIF info should be taken) first, and than choose EXIF info->copy from!", -title => 'Error', -type => 'OK'); return; } my $com = getComment($copyCommentSource, SHORT); my $thumb = getThumbFileName($copyCommentSource); my $message = "Copy the comments:\ -------------\ $com\ -------------\ from\ \"".basename($copyCommentSource)."\"\ to $selected selected pictures.\ The original comments won't be lost!\ Ok to continue?"; my $rc = myButtonDialog("Copy comments", "$message", $thumb, 'OK', 'Cancel'); return if ($rc ne 'OK'); $userinfo = "transfering comments to $selected pictures"; $userInfoL->update; my $pw = progressWinInit($top, "Transfer comments"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "transfering comments ($i/$selected) ...", $i, $selected); $dirthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my @comments = getComments($copyCommentSource); my $meta = getMetaData($dpic, "COM"); next unless ($meta); # add the comments foreach (@comments) { $meta->add_comment($_); } unless ($meta->save()) { warn "copyComment: save $dpic failed!"; } updateOneRow($dpic, $picLB); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); } # foreach end progressWinEnd($pw); } else { warn "copyComment: Wrong direction ($direction), should be from or to!"; return; } $userinfo = "ready! ($i of $selected copied)"; $userInfoL->update; } ############################################################## # displayIPTCData - displays all IPTC-Data in a window ############################################################## sub displayIPTCData { my $lb = shift; my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return unless askSelection(\@sellist, 10, "IPTC info"); my ($pic, $dpic, $iptc, $title, $thumb); my $i = 0; my $pw = progressWinInit($lb, "Display IPTC data"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; $iptc = ""; progressWinUpdate($pw, "displaying IPTC data ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $thumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); $title = "IPTC/IIM info of $pic"; $iptc = getIPTC($dpic, LONG); if ($iptc eq '') { $iptc = "Found no IPTC/IIM info in \"$pic\"\n"; } showText($title, $iptc, NO_WAIT, $thumb); } progressWinEnd($pw); if ($lb == $picLB) { $userinfo = "ready! ($i/".scalar @sellist." IPTC displayed)"; $userInfoL->update; } } ############################################################## # saveIPTC - save IPTC info hash as template to a file ############################################################## sub saveIPTC { my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Save IPTC info", -type => 'OK'); return; } my $dpic = $sellist[0]; my $meta = getMetaData($dpic, 'APP13'); my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); unless (defined $iptc) { $top->messageBox(-icon => 'warning', -message => "There is no IPTC info in $dpic!", -title => "Save IPTC info", -type => 'OK'); return; } if (!-d $iptcdir) { if ( !mkdir $iptcdir, 0755 ) { $top->messageBox(-icon => 'warning', -message => "Error making IPTC template folder $iptcdir: $!", -title => "Save IPTC template", -type => 'OK'); return; } } my $fileSelect = $top->FileSelect(-title => "Set file name (please use the .iptc2 suffix)", -initialfile => "template.iptc2", -create => 1, -directory => $iptcdir, -width => 30, -height => 30); my $file = $fileSelect->Show; return unless (defined $file); return if ($file eq ''); if (-f $file) { my $rc = $top->messageBox(-icon => 'warning', -message => "file $file exist. Ok to overwrite?", -title => "Save IPTC info", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } my $rc = nstore($iptc, $file) or warn "could not store IPTC in file $file: $!"; $userinfo = "IPTC template saved ($rc)"; $userInfoL->update; } ############################################################## # copyFromIPTC - ############################################################## sub copyIPTC { my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Copy IPTC info", -type => 'OK'); return; } my $dpic = $sellist[0]; my $meta = getMetaData($dpic, 'APP13'); $iptcCopy = $meta->get_app13_data('TEXTUAL', 'IPTC'); unless (defined $iptcCopy) { $top->messageBox(-icon => 'warning', -message => "There is no IPTC info in $dpic!", -title => "Copy IPTC info", -type => 'OK'); return; } $userinfo = "IPTC copy ready"; $userInfoL->update; } ############################################################## # pasteIPTC - ############################################################## sub pasteIPTC { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); applyIPTC($picLB, $iptcCopy, \@sellist); } ############################################################## # mergeIPTC - merge a IPTC info hash template to a file ############################################################## sub mergeIPTC { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $file = $top->FileSelect(-title => "Open IPTC template", -directory => $iptcdir, -width => 30, -height => 30)->Show; return unless (defined $file); return if ($file eq ""); return unless (-f $file); my $iptc = retrieve($file); unless (defined $iptc) { warn "could not retrieve $file"; return; } applyIPTC($picLB, $iptc, \@sellist); } ############################################################## # applyIPTC - apply a IPTC info hash to a list of pics ############################################################## sub applyIPTC { my $lb = shift; # reference to listbox widget my $iptc = shift; # reference to an IPTC hash as provided by Image::MetaData::JPEG my $piclist = shift; # picture list reference my $errors = ''; my $pw = 0; $pw = progressWinInit($lb, 'Apply IPTC template') if (@$piclist > 1); my $i = 0; foreach my $dpic (@$piclist) { last if ($pw and progressWinCheck($pw)); $i++; progressWinUpdate($pw, "applying IPTC template ($i/".scalar @$piclist.") ...", $i, scalar @$piclist) if $pw; next if (!checkWriteable($dpic)); my $meta = getMetaData($dpic, 'APP13'); unless (defined $meta) { $errors .= "could not create IPTC info for $dpic!"; next; } # todo, we could also use UPDATE or REPLACE here $meta->set_app13_data($iptc, 'ADD', 'IPTC'); # make the SupplementalCategories and Keywords unique and sorted uniqueIPTC($meta); if ($meta->save()) { my $dirthumb = getThumbFileName($dpic); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $lb); showImageInfoCanvas($dpic) if ($dpic eq $actpic); } else { $errors .= "save failed for $dpic\n"; } } progressWinEnd($pw) if $pw; $userinfo = "ready! ($i of ".scalar @$piclist." processed)"; $userInfoL->update; showText('Errors while applying IPTC infos', $errors, NO_WAIT) if ($errors ne ''); } ############################################################## # uniqueArray ############################################################## sub uniqueArray { my $listR = shift; my %d; # build a hash foreach (@{$listR}) { $d{$_} = 1; } @{$listR} = (sort { uc($a) cmp uc($b); } keys %d); } ############################################################## # uniqueIPTC - remove double entries from SupplementalCategories # and Keywords and sort them alphabetically # !Function will not save IPTC! ############################################################## sub uniqueIPTC { my $meta = shift; my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); # todo - doesn't work # replace (german) umlaute by corresponding letters #${$iptc->{Caption}}[0] =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); # replace all non-printable chars, but not newline etc. ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]); my %d; # build a hash foreach (@{$iptc->{SupplementalCategory}}) { $_ =~ tr/ -~//cd; # replace all non-printable chars $d{$_} = 1; } @{$iptc->{SupplementalCategory}} = (sort { uc($a) cmp uc($b); } keys %d); %d = (); # completely empty %d foreach (@{$iptc->{Keywords}}) { $_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword) $d{$_} = 1; } @{$iptc->{Keywords}} = (sort { uc($a) cmp uc($b); } keys %d); $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); } ############################################################## # editIPTCCategories ############################################################## sub editIPTCCategories { my $lb = shift; if (Exists($catw)) { $catw->deiconify; $catw->raise; $catw->focus; return; } # open window $catw = $lb->Toplevel(); $catw->withdraw; $catw->title('Categories'); $catw->iconimage($mapiviicon) if $mapiviicon; my $cattree; my $XBut = $catw->Button(-text => "Close", -command => sub { saveTreeMode($cattree); nstore($cattree->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; $catw->destroy; })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); my $af = $catw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $af->Radiobutton(-text => "all", -variable => \$config{CategoriesAll}, -value => 1)->pack(-side => 'left'); $af->Radiobutton(-text => "join", -variable => \$config{CategoriesAll}, -value => 2)->pack(-side => 'left'); $af->Radiobutton(-text => "last", -variable => \$config{CategoriesAll}, -value => 0)->pack(-side => 'left'); my $addB = $af->Button(-text => "add", -command => sub { my @cats = $cattree->info('selection'); return unless checkSelection($catw, 1, 0, \@cats); my @sellist = $lb->info('selection'); return unless checkSelection($catw, 1, 0, \@sellist); my $warning = ''; my @catlist; foreach my $cat (@cats) { my @items; if ($config{CategoriesAll} == 1) { # all, separated @items = getAllItems($cat); } elsif ($config{CategoriesAll} == 2) { # all, joined @items = getAllItems($cat); my $joined = join('.', @items); if (length($joined) > 32) { $warning .= "Category $joined has ".length($joined)." characters"; next; } undef @items; push @items, $joined; } elsif ($config{CategoriesAll} == 0) { # last @items = getLastItem($cat); } else { warn "editIPTCCategories: should never be reached ($config{CategoriesAll})!"; } push @catlist, @items; } if (@catlist) { my $iptc = { SupplementalCategory => \@catlist }; applyIPTC($lb, $iptc, \@sellist); } if ($warning ne '') { $warning = "IPTC supp. categories are limited to 32 characters. Please shorten category.\n$warning"; showText("Warnings while adding keywords", $warning, NO_WAIT); } } )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($addB, -msg => "Add the selected categories to the selected pictures"); my $rmB = $af->Button(-text => "remove", -command => sub { my @cats = $cattree->info('selection'); return unless checkSelection($catw, 1, 0, \@cats); my @sellist = $lb->info('selection'); return unless checkSelection($catw, 1, 0, \@sellist); my $pw = progressWinInit($catw, "Remove category"); my $i = 0; my $sum = @sellist; foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "removing category ($i/$sum) ...", $i, $sum); foreach my $cat (@cats) { last if progressWinCheck($pw); progressWinUpdate($pw, "removing category $cat ($i/$sum) ...", $i, $sum); my $item; if ($config{CategoriesAll} == 2) { # all, joined my @items = getAllItems($cat); $item = join('.', @items); } else { # last $item = getLastItem($cat); } print "remove category $item ($cat) from $dpic\n" if $verbose; removeIPTCItem($dpic, 'SupplementalCategory', $item); updateOneRow($dpic, $lb); } } progressWinEnd($pw); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($rmB, -msg => "Remove the selected categories from the selected pictures"); $cattree = $catw->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 25, -height => 25, )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2); bindMouseWheel($cattree->Subwidget("scrolled")); $balloon->attach($cattree, -msg => "Double click on a category to insert it.\nIt's possible to edit the categories, use the\nright mouse button to open the edit menu."); # try to get the saved mode if (-f "$configdir/categoryMode") { my $hashRef = retrieve("$configdir/categoryMode"); warn "could not retrieve mode" unless defined $hashRef; $cattree->{m_mode} = $hashRef; } $cattree->bind('', sub { $addB->invoke; }); addTreeMenu($cattree, \@precats); insertTreeList($cattree, @precats); $catw->bind('', sub { $XBut->invoke; }); $catw->bind('', sub { $XBut->invoke; }); $catw->Popup; $catw->waitWindow; } ############################################################## # editIPTCKeywords ############################################################## sub editIPTCKeywords { my $lb = shift; if (Exists($keyw)) { my $x = $keyw->parent; print "parent widget = $x lb = $lb keyw = $keyw\n"; # todo this doesn't work # but there should be a difference because when the win is already open from the main win and is called from the search win, the keywords of the wrong window are being modified! if ($lb eq $keyw->parent) { print "editIPTCKeywords called from same widget\n"; } else { print "editIPTCKeywords called from other widget\n"; } $keyw->deiconify; $keyw->raise; $keyw->focus; return; } # open window $keyw = $lb->Toplevel(); $keyw->withdraw; $keyw->title('Keywords'); $keyw->iconimage($mapiviicon) if $mapiviicon; my $keytree; my $af = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); # global button, as it has to be called from saveAllConfig (todo: find better solution for this) $keyXBut = $af->Button(-text => "Close", -command => sub { saveTreeMode($keytree); nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $config{KeyGeometry} = $keyw->geometry; $keyw->destroy; })->pack(-side => 'left', -expand => 1,-fill => 'x'); my $addB = $af->Button(-text => "add", -command => sub { my @keys = $keytree->info('selection'); return unless checkSelection($keyw, 1, 0, \@keys); my @sellist = $lb->info('selection'); return unless checkSelection($keyw, 1, 0, \@sellist); my @keylist; my $warning = ''; foreach my $key (@keys) { my @items; if ($config{KeywordsAll} == 1) { # all, separated @items = getAllItems($key); } elsif ($config{KeywordsAll} == 2) { # all, joined @items = getAllItems($key); my $joined = join('.', @items); if (length($joined) > 64) { $warning .= "Keyword $joined has ".length($joined)." characters"; next; } undef @items; push @items, $joined; } elsif ($config{KeywordsAll} == 0) { # last @items = getLastItem($key); } else { warn "editIPTCKeywords: should never be reached!"; } push @keylist, @items; } if (@keylist) { my $iptc = { Keywords => \@keylist }; applyIPTC($lb, $iptc, \@sellist); } if ($warning ne '') { $warning = "IPTC keywords are limited to 64 characters. Please shorten keyword.\n$warning"; showText("Warnings while adding keywords", $warning, NO_WAIT); } } )->pack(-side => 'left', -expand => 0, -fill => 'x'); $balloon->attach($addB, -msg => "Add the selected keywords to the selected pictures"); my $rmB = $af->Button(-text => "remove", -command => sub { my @keys = $keytree->info('selection'); return unless checkSelection($keyw, 1, 0, \@keys); my @sellist = $lb->info('selection'); return unless checkSelection($keyw, 1, 0, \@sellist); my $pw = progressWinInit($keyw, "Remove keyword"); my $i = 0; my $sum = @sellist; foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum); foreach my $key (@keys) { last if progressWinCheck($pw); progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum); my $item; if ($config{KeywordsAll} == 2) { # all, joined my @items = getAllItems($key); $item = join('.', @items); } else { # last $item = getLastItem($key); } print "remove key $item ($key) from $dpic\n" if $verbose; removeIPTCItem($dpic, 'Keywords', $item); updateOneRow($dpic, $lb); showImageInfoCanvas($dpic) if ($dpic eq $actpic); } } progressWinEnd($pw); })->pack(-side => 'left', -expand => 0, -fill => 'x'); $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures"); my $bf = $keyw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); $bf->Radiobutton(-text => "join", -variable => \$config{KeywordsAll}, -value => 2)->pack(-side => 'left'); $bf->Radiobutton(-text => "all", -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left'); $bf->Radiobutton(-text => "last", -variable => \$config{KeywordsAll}, -value => 0)->pack(-side => 'left'); $balloon->attach($bf, -msg => "Keyword add mode\nExample keyword: Friend/Bundy/Kelly\nmode join: one keyword: Friend.Bundy.Kelly\nmode all: three keywords: Friend, Bundy and Kelly\nmode last: one keyword: Kelly\n\nDefault and recommended mode: join\nIf you want to store and retrieve your keyword\nhierarchie from your pictures you should use join mode."); my $df = $keyw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 1); $balloon->attach($df, -msg => "Use the checkbutton to dock the keyword window to the main window.\nSelect < to dock it to the left side and > to dock it to the right side."); $df->Checkbutton(-text => 'dock', -variable => \$config{KeywordDialogDock}, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); $df->Radiobutton(-text => '<', -variable => \$config{KeywordDialogDockL}, -value => 1, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); $df->Radiobutton(-text => '>', -variable => \$config{KeywordDialogDockL}, -value => 0, -command => sub {dock_keyword_dialog();})->pack(-side => 'left'); $keytree = $keyw->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 25, -height => 25, )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1); $keyw->{tree} = $keytree; bindMouseWheel($keytree->Subwidget("scrolled")); $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu."); # try to get the saved mode if (-f "$configdir/keywordMode") { my $hashRef = retrieve("$configdir/keywordMode"); warn "could not retrieve mode" unless defined $hashRef; $keytree->{m_mode} = $hashRef; } $keytree->bind('', sub { $addB->invoke; }); addTreeMenu($keytree, \@prekeys); insertTreeList($keytree, @prekeys); $keyw->bind('', sub { $keyXBut->invoke; }); $keyw->bind('', sub { $keyXBut->invoke; }); # invoke $but when the window is closed by the window manager (x-button) $keyw->protocol("WM_DELETE_WINDOW" => sub { $keyXBut->invoke; }); $keyw->Popup; checkGeometry(\$config{KeyGeometry}); $keyw->geometry($config{KeyGeometry}); $keyw->waitWindow; } ############################################################## # editCommentKeywords ############################################################## sub editCommentKeywords { my $lb = shift; if (Exists($keycw)) { $keycw->deiconify; $keycw->raise; $keycw->focus; return; } # open window $keycw = $top->Toplevel(); $keycw->withdraw; $keycw->title('Keywords for comments'); $keycw->iconimage($mapiviicon) if $mapiviicon; my $keytree; my $XBut = $keycw->Button(-text => "Close", -command => sub { saveTreeMode($keytree); nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $keycw->destroy; })->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); my $af = $keycw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $af->Radiobutton(-text => "all", -variable => \$config{KeywordsAll}, -value => 1)->pack(-side => 'left'); $af->Radiobutton(-text => "last", -variable => \$config{KeywordsAll}, -value => 0)->pack(-side => 'left'); my $addB = $af->Button(-text => "add", -command => sub { my @keys = $keytree->info('selection'); return unless checkSelection($keycw, 1, 0, \@keys); my @sellist = $lb->info('selection'); return unless checkSelection($keycw, 1, 0, \@sellist); my $comment; foreach my $key (@keys) { my @items; if ($config{KeywordsAll}) { @items = getAllItems($key); } else { @items = getLastItem($key); } $comment .= "$_ " foreach (@items); } # todo add to end of existing comment or as new comment foreach my $dpic (@sellist) { # todo progressbar addCommentToPic($comment, $dpic, TOUCH); updateOneRow($dpic, $lb); showImageInfo($dpic) if ($dpic eq $actpic); } } )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($addB, -msg => "Add the selected keywords to the selected pictures"); =pod my $rmB = $af->Button(-text => "remove", -command => sub { my @keys = $keytree->info('selection'); return unless checkSelection($keycw, 1, 0, \@keys); my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $pw = progressWinInit($keycw, "Remove keyword"); my $i = 0; my $sum = @sellist; foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "removing keyword ($i/$sum) ...", $i, $sum); foreach my $key (@keys) { last if progressWinCheck($pw); progressWinUpdate($pw, "removing keyword $key ($i/$sum) ...", $i, $sum); my $name = getLastItem($key); print "remove key $name ($key) from $dpic\n" if $verbose; removeIPTCItem($dpic, 'Keywords', $name); updateOneRow($dpic, $lb); } } progressWinEnd($pw); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($rmB, -msg => "Remove the selected keywords from the selected pictures"); =cut $keytree = $keycw->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 25, -height => 25, )->pack(-expand => 1, -fill =>'both', -padx => 4, -pady => 2); bindMouseWheel($keytree->Subwidget("scrolled")); $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu."); # try to get the saved mode if (-f "$configdir/keywordMode") { my $hashRef = retrieve("$configdir/keywordMode"); warn "could not retrieve mode" unless defined $hashRef; $keytree->{m_mode} = $hashRef; } $keytree->bind('', sub { $addB->invoke; }); addTreeMenu($keytree, \@prekeys); insertTreeList($keytree, @prekeys); $keycw->bind('', sub { $XBut->invoke; }); $keycw->bind('', sub { $XBut->invoke; }); $keycw->Popup; $keycw->waitWindow; } ############################################################## # addTreeMenu - add a menu to a tree widget to edit a tree ############################################################## sub addTreeMenu { my $tree = shift; # tree widget my $listRef = shift; # the list displayed in the tree my $menu = $tree->Menu(-title => "Tree edit menu"); $menu->command(-label => "add new item", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($tree, 0, 1, \@keys); my $item = ''; my $parent = ''; $parent = $keys[0] if (@keys); if ($parent !~ m/.*\/.*/) { $parent = ''; } else { # cut of last element $parent = $1 if ($parent =~ m/(.*\/).*/); $parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/)); } my $rc = myEntryDialog('New item', "Please enter the new item (below $parent)", \$item); return if ($rc ne 'OK'); return if ($item eq ''); # avoid slash and backslash if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) { $tree->messageBox(-icon => 'info', -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.', -title => 'Wrong character', -type => 'OK'); return; } # avoid double entries if (isInList($parent.$item, $listRef)) { $tree->messageBox(-icon => 'info', -message => "Sorry, but $parent$item is already in the list.", -title => 'Double entry', -type => 'OK'); return; } push @{$listRef}, $parent.$item; insertTreeList($tree, @{$listRef}); }); $menu->command(-label => "add new item below selected item", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($tree, 1, 1, \@keys); my $item = ''; my $parent = $keys[0]; my $rc = myEntryDialog('New sub item', "Please enter the new sub item (below $parent)", \$item); return if ($rc ne 'OK'); return if ($item eq ''); # avoid slash and backslash if (($item =~ m|.*\/.*|) or ($item =~ m|.*\\.*|)) { $tree->messageBox(-icon => 'info', -message => 'Sorry, but the slash (/) and the backslash (\) are not allowed.', -title => 'Wrong character', -type => 'OK'); return; } $parent .= '/' if (($parent ne '') and ($parent !~ m/.*\/$/)); # avoid double entries if (isInList($parent.$item, $listRef)) { $tree->messageBox(-icon => 'info', -message => "Sorry, but $parent$item is already in the list.", -title => 'Double entry', -type => 'OK'); return; } push @{$listRef}, $parent.$item; insertTreeList($tree, @{$listRef}); }); $menu->separator; $menu->command(-label => "rename (move) selected item", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($tree, 1, 1, \@keys); my $parent = $keys[0]; my $rc = myEntryDialog('Rename item', "Please enter the new name for item $parent", \$parent); return if ($rc ne 'OK'); return if ($parent eq ''); $parent =~ s|^/||; # cut leading slash for my $t (0 .. $#{@{$listRef}} ) { if ($$listRef[$t] =~ m/^$keys[0](.*)/) { print "rename: $$listRef[$t] ($t) to $parent$1\n" if $verbose; $$listRef[$t] = $parent.$1; } } insertTreeList($tree, @{$listRef}); }); $menu->separator; $menu->command(-label => "delete selected item(s)", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($tree, 1, 0, \@keys); for my $t (reverse 0 .. $#{@{$listRef}} ) { foreach my $key (@keys) { if ($$listRef[$t] =~ m/^$key.*/) { print "trow out: $$listRef[$t] ($t)\n" if $verbose; splice @{$listRef}, $t, 1; # remove it from list } } } insertTreeList($tree, @{$listRef}); }); $menu->separator; $menu->command(-label => "search selected items", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($tree, 1, 0, \@keys); my $pat = ''; foreach (@keys) { my @parts = split /\//, $_; # todo add join and all mode $pat .= $parts[-1].' '; } $pat =~ s/\s+$//; # cut trailing whitespace $pat =~ s/^\s+//; # cut leading whitespace my $pat_orig = $pat; if (@keys > 1) { $pat = "(?=.*".$pat; # and-function with look-ahead $pat =~ s/\s+/)(?=.*/g; # replace one or more whitespaces with )(?=.* $pat .= ')'; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" } my $start_time = Tk::timeofday(); my $case = 'i'; my $count = 0; my @dpics; # loop through all database entries foreach my $dpic (sort keys %searchDB) { my $keys = $searchDB{$dpic}{KEYS}; if ((defined $keys) and ($keys =~ m/(?$case).*$pat.*/)) { $count ++; push @dpics, $dpic; } } my $time_elapsed = sprintf "%.2f", (Tk::timeofday() - $start_time); my $rc = myButtonDialog('Search finished', "Found $count pictures in ${time_elapsed}sec matching \"$pat_orig\"", undef, 'Show found pictures', 'Cancel',); # todo showing the pics in the light table is not always the best idea! -> showThumbListInNewWin light_table_add(\@dpics) if ((@dpics > 0) and ($rc eq 'Show found pictures')); }); $tree->bind('', sub { $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } ); } ############################################################## # showThumbListInNewWin ############################################################## sub showThumbListInNewWin { } ############################################################## # getLastItem - returns the last item of a scalar separated with # a slash: family/Miller/Robert -> Robert ############################################################## sub getLastItem($) { my $item = shift; my @names = split /\//, $item; my $name = $names[-1]; $name = $item if ((!defined $name) or ($name eq "")); return $name; } ############################################################## # getAllItems - returns a list of all items of a scalar # separated with a slash: # family/Miller/Robert -> family, Miller, Robert ############################################################## sub getAllItems($) { my $item = shift; return split /\//, $item; } ############################################################## # insertTreeList ############################################################## sub insertTreeList { my $tree = shift; my %mode; saveTreeMode($tree); %mode = %{$tree->{m_mode}} if (defined $tree->{m_mode}); $tree->delete("all"); # insert the list (@_) foreach (sort { uc($a) cmp uc($b); } @_ ) { my @names = split /\//, $_; my $name = $names[-1]; $name = $_ if ((!defined $name) or ($name eq "")); $tree->add($_, -text=>$name); } $tree->autosetmode; # reset mode to the the old setting for the first 3 levels foreach ($tree->info('children')) { $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open')); $tree->open($_) if ((defined $mode{$_}) and ($mode{$_} eq 'close')); foreach ($tree->info('children', $_)) { $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open')); $tree->open($_) if ((defined $mode{$_}) and ($mode{$_} eq 'close')); foreach ($tree->info('children', $_)) { $tree->close($_) if ((defined $mode{$_}) and ($mode{$_} eq 'open')); $tree->open($_) if ((defined $mode{$_}) and ($mode{$_} eq 'close')); } } } } ############################################################## # saveTreeMode - save the mode (open, close) of the first 3 # levels of a tree in $widget->{m_mode} # {m_mode} is mapivi private data stored in the # widget hash ############################################################## sub saveTreeMode { my $tree = shift; my %mode; %mode = %{$tree->{m_mode}} if (defined $tree->{m_mode}); # save mode (open, close) of existing items for the first 3 levels foreach ($tree->info('children')) { $mode{$_} = $tree->getmode($_); foreach ($tree->info('children', $_)) { $mode{$_} = $tree->getmode($_); foreach ($tree->info('children', $_)) { $mode{$_} = $tree->getmode($_); } } } $tree->{m_mode} = \%mode; } ############################################################## # removeIPTCItem ############################################################## sub removeIPTCItem { my $dpic = shift; my $kind = shift; my $item = shift; if (($kind ne 'Keywords') and ($kind ne 'SupplementalCategory')) { warn "removeIPTCItem: $kind is wrong kind"; return; } print "removeIPTCItem: kind:$kind item:$item pic:$dpic\n" if $verbose; my $meta = getMetaData($dpic, 'APP13'); unless (defined $meta) { print "removeIPTCItem: Could not create IPTC info for $dpic!\n"; return; } my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); my %d; # build a hash foreach (@{$iptc->{$kind}}) { $d{$_} = 1; } return unless (defined $d{$item}); delete $d{$item}; # remove item from list @{$iptc->{$kind}} = (sort { uc($a) cmp uc($b); } keys %d); $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); if ($meta->save()) { my $dirthumb = getThumbFileName($dpic); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); } else { print "removeIPTCItem: save failed for $dpic\n"; } } #my %get_encoding_name_from_tag = ( # "0x1b0x250x47" => "UTF8", # stolen from Image::ExifTool (thanks to Phil Harvey) #------------------------------------------------------------------------------ # Print conversion for CodedCharacterSet # Inputs: 0) value sub PrintCodedCharset($) { my $val = shift; return $iptcCharset{$val} if $iptcCharset{$val}; $val =~ s/(.)/ $1/g; $val =~ s/ \x1b/, ESC/g; $val =~ s/^,? //; return $val; } ############################################################## # getIPTC - returns all IPTC-Data of the given picture ############################################################## sub getIPTC { # the pic with complete path my $dpic = shift; # bool, if = LONG a better complete readable output, # if = SHORT a compact but complete IPTC info for e.g. the search database my $format = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $pic if available my $iptc = ''; return $iptc unless is_a_JPEG($dpic); my $shortkey; # todo: is , 'FASTREADONLY' here possible? $meta = getMetaData($dpic, 'APP13') unless (defined($meta)); if ($meta) { my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); if ($seg) { my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC'); foreach my $key (@IPTCAttributes) { # this causes trouble (cuts off the rest) because it's binary next if ($key eq "RecordVersion"); if (defined($hashref->{$key})) { if (($format == LONG)) { $iptc .= sprintf "%-31s: ", $key; } else { my $shortkey = $key; $shortkey =~ s/SupplementalCategory/SuppCategories/; $shortkey = substr($shortkey, 0, 7)."." if (length($shortkey) > 8); $iptc .= sprintf "%-8s: ", $shortkey; } $iptc .= "$_ " for @{$hashref->{$key}}; $iptc =~ s/\s+$//; # cut trailing whitespace $iptc .= "\n"; } } # add Coded Character Set info my $hash_1 = $seg->get_app13_data('TEXTUAL', 'IPTC_1'); if (defined $hash_1->{'CodedCharacterSet'}) { my $encoding = PrintCodedCharset(${$hash_1->{'CodedCharacterSet'}}[0]); if (($format == LONG)) { $iptc .= sprintf "%-31s: ", 'CodedCharacterSet'; } else { $iptc .= 'CCharSet: '; } $iptc .= "$encoding\n"; #print "found Coded character set in $dpic: [$encoding][${$hash_1->{'CodedCharacterSet'}}[0]]\n"; } } } $iptc =~ tr/\n -~//cd; # remove all non-printable chars, but not newline return $iptc; } ############################################################## # getShortIPTC - get just one attribute of the IPTC comment # I decided to use the caption/abstract, but # I am not sure if this is the best attribute # here? # if there is no file or no IPTC info in the file # an empty string is returned ############################################################## sub getShortIPTC { my $dpic = shift; # optional, if set to LONG the complete contents of the @iptcs attributes # (see below) will be returned # else (SHORT) it will be cut to fit in the hlist my $format = shift; # LONG or SHORT return "" unless (-f $dpic); my $info = getIPTC($dpic, SHORT); $info = formatString($info, $config{LineLength}, $config{LineLimit}) if ((defined $format) and ($format == SHORT)); return $info; } ############################################################## # getImageInfo - returns a hash containing the image info ############################################################## sub getImageInfo { my $pic = shift; if (!-f $pic) { return ""; } my $ii = image_info($pic); if (!$ii) { return ""; } if ($ii->{Errno} and $ii->{Errno} ne "0") { return ""; } return $ii; } ############################################################## # getNearestItem - finds the nearest item to the mouse pointer # in a listbox ############################################################## sub getNearestItem { my($LB) = @_; my ($X,$Y) = $LB->pointerxy(); my $y = $LB->rooty(); my $yy = $Y - $y; return ($LB->nearest($yy)); } ############################################################## # processARGV - handels the command line arguments (if any) ############################################################## sub processARGV { getopts('i'); # sets $opt_i if switch -i is found my $nr = @ARGV; if ($nr < 1) { # no arguments - open the last dir $actdir = $config{LastDir}; dirSave($actdir); return; } if ($nr > 1) { # too many argument print "Mapivi error: to many command line options\n"; printUsage(); exit; } my $item = abs_path($ARGV[0]); #print "processARGV: -e $item = ", -e $item, "\n"; $item = Encode::encode('iso-8859-1', $item); #print "processARGV: item: $item item2: $item2\n"; #print "processARGV: -e $item = ", -e $item, "\n"; if (-f $item) { $actpic = $item; $actdir = dirname($item); } elsif (-d $item) { $actdir = $item; } else { printUsage(); exit; } dirSave($actdir); } ############################################################## # getDirAndOpen - let the user select a new dir and open it # with a simple text entry ############################################################## sub getDirAndOpen { my $dir = $actdir; my $rc = myEntryDialog("open dir","Please enter folder:",\$dir); return if ($rc ne 'OK'); print " --$dir--\n" if $verbose; $dir = glob("$dir"); print "g--$dir--\n" if $verbose; while (!-d $dir) { $top->messageBox(-icon => 'warning', -message => "Sorry, but I can't find the folder \"$dir\"", -title => "No valid folder", -type => 'OK'); $rc = myEntryDialog("open dir","Please enter folder:",\$dir); return if ($rc ne 'OK'); $dir = glob("$dir"); } openDirPost($dir); } ############################################################## # openDir - let the user select a new dir and open it # with a real dir dialog ############################################################## sub openDir { my $dir = dirDialog($actdir); openDirPost($dir); } ############################################################## # openDirPost - things to do when opening a new dir ############################################################## sub openDirPost { my $dir = shift; $dir = Encode::encode('iso-8859-1', $dir); #print "openDirPost: dir: $dir"; #if (-d $dir) { print " is a dir\n"; } #else { print " is not a dir\n"; } $dir =~ s/\/\//\//g; # replace all // with / return unless (defined $dir); return unless (-d $dir); $actdir = $dir; my $path = cutString($dir, -22, ".."); $userinfo = "opening $path ..."; $userInfoL->update; $actpic = ""; # reset var $actpic - needed to get a correct window title setDirProperties(); dirSave($dir); clearLabels(); showImageInfoCanvas(); setTitle(); $exif = "" if ($config{ShowEXIFField}); $commentText->delete( 0.1, 'end') if ($config{ShowCommentField} and defined $commentText); $captionText->delete( 0.1, 'end') if ($config{ShowCaptionField} and defined $captionText); $dirtree->configure(-directory => $actdir); # Set the folder exists &Tk::DirTree::chdir ? $dirtree->chdir($actdir) : $dirtree->set_dir($actdir); selectDirInTree($actdir); updateThumbs(); } ############################################################## # setDirProperties ############################################################## sub setDirProperties { $dirPropSORT = 0; $dirPropMETA = 0; $dirPropPRIO = 0; $dirPropSORT = $dirProperties{$actdir}{SORT} if (defined $dirProperties{$actdir}{SORT}); $dirPropMETA = $dirProperties{$actdir}{META} if (defined $dirProperties{$actdir}{META}); $dirPropPRIO = $dirProperties{$actdir}{PRIO} if (defined $dirProperties{$actdir}{PRIO}); #foreach my $prop (@dirPropList) { # $dirProp{$prop} = 0; # $dirProp{$prop} = $dirProperties{$actdir}{SORT} } ############################################################## # showDirProperties ############################################################## sub showDirProperties { if (Exists($dpw)) { $dpw->deiconify; $dpw->raise; $dpw->focus; return; } # open window $dpw = $top->Toplevel(); $dpw->withdraw; $dpw->title('Folder Checklist'); $dpw->iconimage($mapiviicon) if $mapiviicon; my $topf = $dpw->Frame()->pack(); my $dplb = $dpw->Scrolled("HList", -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 1, -columns => 5, -scrollbars => 'osoe', #-selectmode => "dragdrop", todo -selectmode => "extended", -background => $config{ColorBG}, #8fa8bf -width => 40, -height => 60, )->pack(-expand => 1, -fill => "both"); bindMouseWheel($dplb); my $count = 0; $dplb->{dircol} = $count; $dplb->header('create', $count++, -text => 'Folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $dplb->{sortcol} = $count; $dplb->header('create', $count++, -text => 'Sort', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $dplb->{metacol} = $count; $dplb->header('create', $count++, -text => 'Meta', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $dplb->{priocol} = $count; $dplb->header('create', $count++, -text => 'Prio', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $dplb->{commcol} = $count; $dplb->header('create', $count++, -text => 'Comment', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $Xbut = $topf->Button(-text => "Close", -command => sub { $dpw->withdraw; $dpw->destroy; } )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1); my $upd_but = $topf->Button(-text => "Update", -command => sub { my @dirs = $dplb->info('selection'); my $last = $dirs[-1]; $dplb->delete("all"); insertDirProperties($dplb); reselect($dplb, @dirs); $dplb->see($last) if ($dplb->info("exists", $last));; })->pack(-side => 'left', -expand => 0,-padx => 1,-pady => 1); $topf->Checkbutton(-text => "Show unfinished folders", -variable => \$config{ShowUnfinishedDirs} )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1); $topf->Checkbutton(-text => "Show finished folders", -variable => \$config{ShowFinishedDirs} )->pack(-side => 'left', -expand => 0,-fill => 'x',-padx => 1,-pady => 1); my $dpmenu = $dpw->Menu(-title => "Folder Checklist Menu"); $dpmenu->command(-label => "open folder", -command => sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 1, \@dirs); if (-d $dirs[0]) { openDirPost($dirs[0]); # show main window $top->deiconify; $top->raise; } else { $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK'); } } ); $dpmenu->command(-label => "add all sub folders to this list", -command => sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 1, \@dirs); @dirs = getDirsRecursive($dirs[0]); my $nr = 0; foreach (@dirs) { # todo skip empty dirs if (!defined $dirProperties{$_}) { print "adding $_\n" if $verbose; $dirProperties{$_}{SORT} = 0 ; $dirProperties{$_}{META} = 0 ; $dirProperties{$_}{PRIO} = 0 ; $nr++; } } $upd_but->invoke; $dplb->messageBox(-icon => 'info', -message => "Added $nr folders.", -title => "Added sub folders", -type => 'OK'); } ); $dpmenu->command(-label => "remove selected from list", -command => sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 0, \@dirs); foreach my $dir (@dirs) { delete $dirProperties{$dir}; $dplb->delete("entry", $dir) if ($dplb->info('exists', $dir)); } } ); $dpmenu->command(-label => "edit comment", -command => sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 1, \@dirs); my $text = ""; $text = $dirProperties{$dirs[0]}{COMM} if (defined $dirProperties{$dirs[0]}{COMM}); my $rc = myTextDialog("Edit comment", "Please edit comment of $dirs[0]", \$text); return if ($rc ne 'OK'); # replace (german) umlaute by corresponding letters $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $dirProperties{$dirs[0]}{COMM} = $text; $dplb->itemConfigure($dirs[0], $dplb->{commcol}, -text => $dirProperties{$dirs[0]}{COMM}, -style => $fileS); } ); my $sort_menu = $dpmenu->cascade(-label => "Sort"); my $meta_menu = $dpmenu->cascade(-label => "Meta"); my $prio_menu = $dpmenu->cascade(-label => "Prio"); my $all_menu = $dpmenu->cascade(-label => "All"); $sort_menu->command(-label => "set", -command => sub { setProperty($dplb, 'SORT', 1); } ); $sort_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'SORT', 0); } ); $meta_menu->command(-label => "set", -command => sub { setProperty($dplb, 'META', 1); } ); $meta_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'META', 0); } ); $prio_menu->command(-label => "set", -command => sub { setProperty($dplb, 'PRIO', 1); } ); $prio_menu->command(-label => "reset", -command => sub { setProperty($dplb, 'PRIO', 0); } ); $all_menu->command( -label => "set", -command => sub { setProperty($dplb, 'ALL', 1); } ); $all_menu->command( -label => "reset", -command => sub { setProperty($dplb, 'ALL', 0); } ); $dplb->bind('', sub { $dpmenu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $dplb->bind('', sub { my @dirs = $dplb->info('selection'); return unless checkSelection($dpw, 1, 1, \@dirs); if (-d $dirs[0]) { openDirPost($dirs[0]); # show main window $top->deiconify; $top->raise; } else { $dplb->messageBox(-icon => 'info', -message => "Sorry, but this folder is currently not available!", -title => "Folder not available", -type => 'OK'); } } ); $dpw->bind('', sub { $Xbut->invoke; }); $dpw->bind('', sub { $Xbut->invoke; }); $dpw->Popup; my $ws = 0.7; # window size is 70% of screen my $w = int($ws * $dpw->screenwidth); my $h = int($ws * $dpw->screenheight); my $x = int(($dpw->screenwidth - $w)/3); my $y = int(($dpw->screenheight - $h)/3); $dpw->geometry("${w}x${h}+${x}+${y}"); insertDirProperties($dplb); $dpw->waitWindow; } ############################################################## # insertDirProperties ############################################################## sub insertDirProperties { my $lb = shift; my $normal_S = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#009', -background=>$config{ColorBG}); my $finished_S = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#090', -background=>$config{ColorBG}); my $not_avail_S = $lb->ItemStyle('text', -anchor=>'nw', -foreground=>'#900', -background=>$config{ColorBG}); my $last_time; foreach my $dir (sort { uc($a) cmp uc($b); } keys %dirProperties) { my $style = $normal_S; $style = $finished_S if (defined $dirProperties{$dir}{SORT} and defined $dirProperties{$dir}{META} and defined $dirProperties{$dir}{PRIO} and $dirProperties{$dir}{SORT} == 1 and $dirProperties{$dir}{META} == 1 and $dirProperties{$dir}{PRIO} == 1); next if (!$config{ShowFinishedDirs} and $style == $finished_S); next if (!$config{ShowUnfinishedDirs} and $style != $finished_S); $style = $not_avail_S unless (-d $dir); # create new row $lb->add($dir); $lb->itemCreate($dir, $lb->{dircol}, -text => $dir, -style => $style); $lb->itemCreate($dir, $lb->{sortcol}, -text => $dirProperties{$dir}{SORT}, -style => $comS); $lb->itemCreate($dir, $lb->{metacol}, -text => $dirProperties{$dir}{META}, -style => $iptcS); $lb->itemCreate($dir, $lb->{priocol}, -text => $dirProperties{$dir}{PRIO}, -style => $comS); $lb->itemCreate($dir, $lb->{commcol}, -text => $dirProperties{$dir}{COMM}, -style => $iptcS); # show progress every 0.5 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { $lb->update; $last_time = Tk::timeofday(); } } } ############################################################## # showDirSizes ############################################################## sub showDirSizes { if (Exists($dsw)) { $dsw->deiconify; $dsw->raise; $dsw->focus; return; } my @dirs = @_; # just one dir at the moment, because the dir tree is configured to single selection # will contain all dirs my @alldirs; my $break = 0; my $pw = progressWinInit($top, "Collect sub folders"); foreach my $dir (@dirs) { if (progressWinCheck($pw)) { $break = 1; last; } find(sub { # process just dirs, but not .thumbs/ .xvpics/ etc. if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) { progressWinUpdate($pw, "collecting folders, found ".scalar @alldirs." ...", 0, 0); push @alldirs, $File::Find::name; # add dir if it contains at least one picture #if (getPics($File::Find::name, JUST_FILE) > 0) { #} } }, $dir); } progressWinEnd($pw); return if ($break); shift @alldirs if (@alldirs > 1); # remove the parent (starting) dir if there are subdirs #$label = "Found ".scalar @alldirs." folders, getting size ..."; # hash key: folder value: size of dir in Bytes (including all subdirs) my %dirsize; my $max = 0; #my $allsize = 0; my $dirCount = 0; my $fileCount = 0; my $i = 0; $pw = progressWinInit($top, "Calculate folder sizes"); foreach my $dir (@alldirs) { if (progressWinCheck($pw)) { $break = 1; last; } $i++; progressWinUpdate($pw, "in folder $dir ($i/".scalar @alldirs.") ...", $i, scalar @alldirs); my $size = 0; $dirCount++; find(sub { $fileCount++; $size += -s if (defined -s); }, $dir); $dirsize{$dir} = $size; $max = $size if ($size > $max); #$allsize += $size; # this will count deeper structures several times } progressWinEnd($pw); return if ($break); # open window $dsw = $top->Toplevel(); #$dsw->withdraw; $dsw->title('Folder Sizes'); $dsw->iconimage($mapiviicon) if $mapiviicon; #$dsw->{label} = "Starting soon"; my $label = "Starting soon"; my $Xbut = $dsw->Button(-text => "Close", -command => sub { $dsw->withdraw; $dsw->destroy; } )->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); $dsw->Label(-textvariable => \$label, )->pack(-expand => 0,-fill => 'x',-padx => 1,-pady => 1); my $dc_width = 700; my $dc = $dsw->Scrolled('Canvas', -scrollbars => 'osoe', -width => $dc_width, -height => 400, -relief => 'sunken', -bd => $config{Borderwidth})->pack(-expand => 1,-fill => 'both',-padx => 1, -pady => 1); my $height = 16; $dc->configure(-scrollregion => [0, 0, $dc_width, ($#alldirs * $height)]); $max = 1 if ($max <= 0); # avoid divison by zero my $scale = ($dc_width - 2)/$max; my $y = 2; my $x = 2; foreach my $dir (sort keys %dirsize) { $dc->createRectangle( $x, $y, $x + ($dirsize{$dir} * $scale), $y+$height, -tags => ['RECT'], #-outline => undef, -outline => 'black', -fill => 'goldenrod3', ); my $text = sprintf "%6s", computeUnit($dirsize{$dir}); $dc->createText( $x+1, $y+1, -text => $text, -anchor => 'nw'); $dc->createText( $x+50, $y+1, -text => $dir, -anchor => 'nw'); $y += $height; } $max = computeUnit($max); #$allsize = computeUnit($allsize); $label = "Ready! $dirCount folders, $fileCount files, (max folder size: $max)"; $dsw->waitWindow; } ############################################################## # setProperty ############################################################## sub setProperty($$$) { my $lb = shift; my $prop = shift; my $value = shift; my @dirs = $lb->info('selection'); return unless checkSelection($dpw, 1, 0, \@dirs); if ((!defined $value) or ($value < 0) or ($value > 1)) { warn "wrong value $value"; return; } if ((!defined $prop) or (($prop ne 'SORT') and ($prop ne 'META') and ($prop ne 'PRIO') and ($prop ne 'ALL'))) { warn "wrong property $prop"; return; } foreach my $dir (@dirs) { # set property to given value unless ($prop eq 'ALL') { $dirProperties{$dir}{$prop} = $value; } else { $dirProperties{$dir}{SORT} = $value; $dirProperties{$dir}{META} = $value; $dirProperties{$dir}{PRIO} = $value; } # show changed property my $style = $iptcS; $style = $exifS if (defined $dirProperties{$dir}{SORT} and defined $dirProperties{$dir}{META} and defined $dirProperties{$dir}{PRIO} and $dirProperties{$dir}{SORT} == 1 and $dirProperties{$dir}{META} == 1 and $dirProperties{$dir}{PRIO} == 1); $lb->itemConfigure($dir, $lb->{dircol}, -text => $dir, -style => $style); $lb->itemConfigure($dir, $lb->{sortcol}, -text => $dirProperties{$dir}{SORT}, -style => $comS); $lb->itemConfigure($dir, $lb->{metacol}, -text => $dirProperties{$dir}{META}, -style => $iptcS); $lb->itemConfigure($dir, $lb->{priocol}, -text => $dirProperties{$dir}{PRIO}, -style => $comS); $lb->itemConfigure($dir, $lb->{commcol}, -text => $dirProperties{$dir}{COMM}, -style => $iptcS); } } ############################################################## # selectDirInTree ############################################################## sub selectDirInTree { my $dir = shift; $dir = Encode::encode('iso-8859-1', $dir); $dirtree->selectionClear(); if ($dirtree->info('exists', "/$dir")) { $dirtree->selectionSet("/$dir"); $dirtree->show('entry', "/$dir"); } elsif ($dirtree->info('exists', $dir)) { $dirtree->selectionSet($dir); $dirtree->show('entry', $dir); } } ############################################################## # dirSave - save the last used dirs, build a hotlist of # often used dirs and update the dir menu ############################################################## sub dirSave { my $dir = shift; return if ($dir eq $trashdir); # check if dir is already in history list my $i = 0; foreach (@dirHist) { if ($_ eq $dir) { splice @dirHist, $i, 1; # throw old entry away last; } $i++; } # add dir to history list push @dirHist, $dir; # no more than 10 entries in history list if (@dirHist > 10) { shift @dirHist; } # count the number of accesses to each dir if (defined $dirHotlist{$dir}) { $dirHotlist{$dir}++; } else { $dirHotlist{$dir} = 1; } updateDirMenu(); } ############################################################## # clearLabels - clear the labels containing infos about the # actual picture ############################################################## sub clearLabels { # show index number in window $nrof = "0/0 (0)"; $widthheight = ""; $size = ""; $zoomFactorStr = ""; $urgencyStr = ""; $urgencyScale = 0; } ############################################################## # dirDialog - open a window and a dir tree ############################################################## sub dirDialog { my $dir = shift; $dir = Encode::encode('iso-8859-1', $dir); if ($EvilOS) { if ($win32FOAvail) { print "FileOp is available!\n" if $verbose; # this is untested!!! todo $dir = BrowseForFolder("Choose folder", "CSIDL_DESKTOP"); $dir =~ s|\\|/|g; # perl likes the slashes like this return $dir; } else { # windows, but no win32 FileOp available print "FileOp is not available!\n" if $verbose; # checkDialog('Select file instead of folder', # 'There is no folder selector available, so please select a file instead of the folder. #You may use any file, Mapivi will use the folder of that file. #If the folder is empty, you may create a new file and select this. #Sorry for that inconvenience! #Example: #To use the folder C:\pictures\2006\ select e.g. C:\pictures\2006\pic1.jpg', # \$config{winDirRequesterAskAgain}, # "remind everytime", # "", # 'OK') if ($config{winDirRequesterAskAgain}); # my $file = $top->getOpenFile(); # little tricky here # if ((defined $file) and (-f $file)) { # until there is no win folder dialog # $dir = dirname($file); # we take a file and jump to the dir of that file # } # but empty dirs are a problem!!! # else { # $dir = ""; # } $dir = $top->chooseDirectory(-title => "Select folder", -initialdir => $dir); $dir = '' unless (defined $dir); $dir = '' unless (-d $dir); return $dir; } } else { # non windows system # code based on Tk::chooseDirectory my $t = $top->Toplevel; $t->withdraw; $t->title('Open folder ...'); $t->iconimage($mapiviicon) if $mapiviicon; my $ok = 0; # flag: "1" means OK, "0" means cancelled # Create Frame widget before the DirTree widget, so it's always visible # if the window gets resized. my $f = $t->Frame->pack(-fill => 'x', -side => "bottom"); my $d; my $mkdB = $t->Button(-text => 'Make new folder', -command => sub { makeNewDir($dir, $d); })->pack(-fill => 'x'); $balloon->attach($mkdB, -msg => "The new folder will be created underneath the selected folder.\nSo, please select a folder in the tree first"); $d = $t->Scrolled('DirTree', -scrollbars => 'osoe', -showhidden => $config{ShowHiddenDirs}, -selectmode => 'browse', -exportselection => 1, -browsecmd => sub { # this function will show all subdirs when pressing on the + sign $dir = shift; $dir = Encode::encode('iso-8859-1', $dir); return if (@_ >= 1); if (!-d $dir) { print "dirDialog: $dir does not exists!\n"; return; } $t->Busy; my @dirs = getDirs($dir); $t->Unbusy; return if (@dirs < 1); $t->Busy; my $lastdir = $dir.'/'.$dirs[-1]; if ($d->info('exists', "$lastdir")) { $d->see($lastdir) if (-d $lastdir); } $t->Unbusy; }, # With this version of -command a double-click will # select the folder -command => sub { $ok = 1; $t->destroy; }, # With this version of -command a double-click will # open a folder. Selection is only possible with # the Ok button. #-command => sub { $d->opencmd($_[0]) }, )->pack(-fill => "both", -expand => 1); # Set the initial folder exists &Tk::DirTree::chdir ? $d->chdir($dir) : $d->set_dir($dir); $f->Button(-text => 'Ok', -command => sub { $ok = 1; $t->destroy; })->pack(-side => 'left',-fill => 'x', -expand => 1); $f->Button(-text => 'Cancel', -command => sub { $ok = 0; $t->destroy; })->pack(-side => 'left',-fill => 'x', -expand => 1); # file and dir requester should always be big! (50% of screenwidth and 90% of screenheight) my $w = int(0.5 * $t->screenwidth); my $h = int(0.9 * $t->screenheight); $t->geometry("${w}x${h}+0+0"); $t->deiconify; $t->raise; $f->waitWindow(); $t->destroy() if (Exists($t)); $dir = "" if ($ok != 1); return $dir; } } ############################################################## # printUsage - show the user how to use mapivi ############################################################## sub printUsage { print "\nUsage: mapivi [-i] [file|folder]\n"; print "\n -i start with import wizard\n"; } ############################################################## # touch - set the modification date of the given file to the # actual date and time ############################################################## sub touch { my $file = shift; my $now = time; utime($now, $now, $file); } ############################################################## # addComment - add a comment to all selected pics in the given # listbox ############################################################## sub addComment($) { my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($dpic, $i); $userinfo = "adding comments to ".scalar @sellist." pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($lb, @sellist)); my $info = "Please enter comment to add to the ".scalar @sellist." selected pictures"; my $text = ""; my $thumb = ""; # if just one pic should be commented we show the thumbnail and the real name if (@sellist == 1) { $thumb = getThumbFileName($sellist[0]); $info = "Please enter comment to add to ".basename($sellist[0]); } my $rc = myTextDialog("Add comment", $info, \$text, $thumb); return if ($rc ne 'OK' or $text eq ""); # replace (german) umlaute by corresponding letters # (a lot of programs seem to have problems with Umlauten in comments) $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $config{Comment} = $text; # save changed comment to global config hash my $pw = progressWinInit($lb, "Add comment"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding comment ($i/".scalar @sellist.") ...", $i, scalar @sellist); next if (!checkWriteable($dpic)); addCommentToPic($text, $dpic, TOUCH); # touch thumbnail updateOneRow($dpic, $lb); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i of ".scalar @sellist." commented)"; $userInfoL->update; } ############################################################## # grayscalePic ############################################################## sub grayscalePic { my $lb = shift; # the reference to the active listbox widget # check if ImageMagick convert version is at least or bigger than 6 if ((`convert 2>&1` =~ m/.*ImageMagick (\d+)\.(\d+)\.(\d+).*/) and ($1 < 6)) { $top->messageBox(-icon => 'warning', -message => "Sorry, but for these function you need at least ImageMagick (convert) in version 6.x.x. You have $1.$2.$3.\nPlease download at http://www.imagemagick.org.", -title => "Wrong ImageMagick version ($1.$2.$3)", -type => 'OK'); return; } #return if (!checkExternProgs("grayscalePic", "jpegtran")); my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); # check if some files are links return if (!checkLinks($lb, @sellist)); my $rc = 0; # open window my $win = $top->Toplevel(); $win->title('Convert to B/W'); $win->iconimage($mapiviicon) if $mapiviicon; my $topF = $win->Frame()->pack(-expand => 1, -fill =>'both', -padx => 5); my $picF = $topF->Frame(-height => $config{FilterPrevSize}, -width => $config{FilterPrevSize})->pack(-side => 'left', -expand => 1, -fill =>'both'); my $presetF = $topF->Frame()->pack(-side => 'left', -expand => 1, -fill =>'both'); $win->{status} = $picF->Label(-textvariable => \$win->{label})->pack(); my $w = 18; labeledScale($win, 'top', $w, "Red channel (%)", \$config{ChannelRed}, -100, 200, 1); labeledScale($win, 'top', $w, "Green channel (%)", \$config{ChannelGreen}, -100, 200, 1); labeledScale($win, 'top', $w, "Blue channel (%)", \$config{ChannelBlue}, -100, 200, 1); my $original_pic = $sellist[0]; my $preview_start_pic = $trashdir.'/'.basename($original_pic).'-start'; my $preview_pic = $trashdir.'/'.basename($original_pic); my $preview_photo; $win->Button(-text => "update", -command => sub { $win->Busy; $win->{label} = "preparing preview ..."; return if (!mycopy ($preview_start_pic, $preview_pic, OVERWRITE)); grayscalePicInt($preview_pic, PREVIEW); $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma}); $win->{photo}->configure(-image => $preview_photo); $win->{label} = "preview finished"; $win->Unbusy; })->pack(); $presetF->Label(-text => 'Presets')->pack(); my $preset = $presetF->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'single', -exportselection => 0, -width => 20, -height => 10, )->pack(-expand => 1, -fill =>'both', -padx => 2, -pady => 2); bindMouseWheel($preset->Subwidget("scrolled")); # preset for channel mixer (hash of lists HoL; list is red, green , blue = RGB) my %channel_mixer = ( 'Filter Yellow' => [30, 70, 20], 'Filter Orange' => [78, 22, 0], 'Filter Red' => [75, 0, 25], 'Filter Red II' => [150,-25,-25], 'Filter Red 25a' => [200, 0,-100], 'Filter Green' => [20, 60, 40], 'Normal 1' => [30, 59, 11], 'Normal 2' => [80, 15, 5], 'Normal 3' => [70, 20, 10], 'Normal 4' => [80, 20,-20], 'Normal 5' => [65, 25, 10], 'Contrast High' => [40, 34, 60], 'Contrast Normal' => [43, 33, 30], ); $preset->insert('end', (sort keys %channel_mixer)); $preset->bind('', sub { my @sel = $preset->curselection(); my $key = $preset->get($sel[0]); $config{ChannelRed} = @{$channel_mixer{$key}}[0]; $config{ChannelGreen} = @{$channel_mixer{$key}}[1]; $config{ChannelBlue} = @{$channel_mixer{$key}}[2]; $win->update(); $win->Busy; $win->{label} = "preparing preview ..."; return if (!mycopy ($preview_start_pic, $preview_pic, OVERWRITE)); grayscalePicInt($preview_pic, PREVIEW); $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma}); $win->{photo}->configure(-image => $preview_photo); $win->{label} = "preview finished"; $win->Unbusy; } ); $win->Checkbutton(-variable => \$config{ChannelBright}, -text => "Keep brightness")->pack(-anchor=>'w', -padx => 5, -pady => 3); my $decoF = $win->Frame()->pack(-fill =>'x', -padx => 5); $decoF->Checkbutton(-variable => \$config{ChannelDeco}, -anchor => 'w', -text => "Add border or text (not visible in preview)")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $decoF->Button(-text => "Options", -anchor => 'w', -command => sub {decorationDialog(scalar @sellist,0);})->pack(-side => "left", -anchor => 'w', -padx => 3); buttonBackup($win, 'top'); my $qs = labeledScale($win, 'top', 18, "Quality (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qs); my $plural = 's'; $plural = '' if (@sellist == 1); $win->Label(-text => "Convert ".scalar @sellist." selected picture$plural to grayscale (B/W) picture$plural.\nPress OK to continue.")->pack(); my $but_frame = $win->Frame()->pack(-fill =>'x'); my $ok_but = $but_frame->Button(-text => 'OK', -command => sub { $rc = 1; $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); my $x_but = $but_frame->Button(-text => 'Cancel', -command => sub { $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 2, -pady => 3); $win->{label} = "preparing preview ..."; $win->Popup(-popover => 'cursor'); repositionWindow($win); $win->Busy; $win->update; return if (!mycopy ($original_pic, $preview_start_pic, OVERWRITE)); return if (!resizePic($preview_start_pic, $config{FilterPrevSize}, $config{FilterPrevSize}, 80)); return if (!mycopy ($preview_start_pic, $preview_pic, OVERWRITE)); grayscalePicInt($preview_pic, PREVIEW); $preview_photo = $win->Photo(-file => $preview_pic, -gamma => $config{Gamma}); $win->{photo} = $picF->Label(-image => $preview_photo, -relief => "sunken", )->pack(-padx => 3, -pady => 3); $win->{label} = "preview finished"; $win->Unbusy; $win->waitWindow; return unless ($rc); $userinfo = "converting ".scalar @sellist." pictures to grayscale"; $userInfoL->update; my $pw = progressWinInit($lb, "Convert to grayscale"); my $i = 0; foreach my $dpic (@sellist) { last if progressWinCheck($pw); progressWinUpdate($pw, "converting ($i/".scalar @sellist.") this may take a while ...", $i, scalar @sellist); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); grayscalePicInt($dpic, NO_PREVIEW); $i++; progressWinUpdate($pw, "converting ($i/".scalar @sellist.") ...", $i, scalar @sellist); updateOneRow($dpic, $lb); showImageInfo($dpic) if ($dpic eq $actpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); reselect($lb, @sellist); $userinfo = "ready! ($i of ".scalar @sellist." converted)"; $userInfoL->update; generateThumbs(ASK, SHOW); $preview_photo->delete if $preview_photo; } ############################################################## # grayscalePicInt ############################################################## sub grayscalePicInt { my $dpic = shift; my $preview = shift; my $sum = 100; if ($config{ChannelBright}) { $sum = $config{ChannelRed}+$config{ChannelGreen}+$config{ChannelBlue}; } $sum = 1 if ($sum == 0); # avoid division by zero my $command = "convert "; $command .= " \"$dpic\" -fx \"(r*$config{ChannelRed}+g*$config{ChannelGreen}+b*$config{ChannelBlue})/$sum\" "; # windows needs the " instead of ' #\'(r*$config{ChannelRed}+g*$config{ChannelGreen}+b*$config{ChannelBlue})/$sum\' "; $command .= makeDrawOptions($dpic) if ($config{ChannelDeco} and !$preview); $command .= " \"$dpic\" "; print "grayscalePicInt: command: $command\n" if $verbose; execute($command); } ############################################################## # updateOneRow - update the (changed) metainfo of one picture # in the given listbox and store them in the # search database ############################################################## sub updateOneRow($$) { my $dpic = shift; # pic with path my $lb = shift; # the listbox reference return unless (-f $dpic); # check if listbox entry exists unless ($lb->info('exists', $dpic)) { warn "entry $dpic not found in listbox!"; return; } my $iptc = ''; my $exif = ''; my $com = ''; my $size = ''; my $meta = addToSearchDB($dpic); # save meta data of picture into the search data base $com = $searchDB{$dpic}{COM}; $exif = $searchDB{$dpic}{EXIF}; $iptc = displayIPTC($dpic); $size = getAllFileInfo($dpic); $com = formatString($com, $config{LineLength}, $config{LineLimit}); # format the comment for the list $iptc = formatString($iptc, $config{LineLength}, $config{LineLimit}); # format the IPTC info for the list # update the metainfo in the listbox $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($dpic)) if (defined $lb->{thumbcol}); $lb->itemConfigure($dpic, $lb->{comcol}, -text => $com) if (defined $lb->{comcol}); $lb->itemConfigure($dpic, $lb->{exifcol}, -text => $exif) if (defined $lb->{exifcol}); $lb->itemConfigure($dpic, $lb->{iptccol}, -text => $iptc) if (defined $lb->{iptccol}); $lb->itemConfigure($dpic, $lb->{filecol}, -text => $size) if (defined $lb->{filecol}); } ############################################################## # addCommentToPic - add a comment to a single picture ############################################################## sub addCommentToPic($$$) { my $com = shift; my $dpic = shift; my $touch = shift; # TOUCH = touch thumbnail, NO_TOUCH return if (!-f $dpic); # check if file is a link and get the real target return if (!getRealFile(\$dpic)); my $meta = getMetaData($dpic, "COM"); return unless ($meta); printf "addCommentToPic: %-30s %s\n", cutString($com,30,".."), $dpic if $verbose; #$com = encode("utf8", $com); $meta->add_comment($com); unless ($meta->save()) { warn "addCommentToPic: save $dpic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch(getThumbFileName($dpic)) if ($touch == TOUCH); addToSearchDB($dpic); } ############################################################## # replaceComment - search/replace a string in a comment to all # selected pics in the given listbox ############################################################## sub replaceComment { my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($dpic, $dthumb, $i, $j, $pic, $meta, @com, $replace, $spat, $stextd, $rtextd); $userinfo = "replacing comments in ".scalar @sellist." pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($lb, @sellist)); my $info = "Please enter the string to replace in the ".scalar @sellist." selected pictures"; my $stext = $config{SearchPattern}; # search string my $rtext = ''; # replace string # if just one pic should be commented we show the real name if (@sellist == 1) { $info = "Please enter the string to replace in ".basename($sellist[0]); } my $test = 1; while ($test) { # todo: one search/replace dialog with upper/lower case support my $rc = myReplaceDialog("Replace comment", $info, \$stext, \$rtext); return if (($rc eq 'Cancel') or ($stext eq '')); $test = 0 if ($rc eq 'OK'); $config{SearchPattern} = $stext; # replace (german) umlaute by corresponding letters # (a lot of programs seem to have problems with Umlauten in comments) $stext =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $rtext =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $spat = makePattern($stext); $config{Comment} = $rtext; # save changed comment to global config hash my $nocom = ""; my $nostr = ""; my $countComments = 0; my $countFiles = 0; my $pw = progressWinInit($lb, "Replace comments"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "replacing comments ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); print "replaceComment: pic:$pic\n" if $verbose; $dthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); $meta = getMetaData($dpic, "COM"); unless ($meta) { $nocom .= "$dpic\n"; next; } @com = getComments($dpic, $meta); # get all comments from the file unless (@com) { $nocom .= "$dpic\n"; next; } $replace = 0; for $j (0 .. $#com) { if ($com[$j] =~ m/$spat/) { # todo handle lower/uppercase unless ($test) { print "replacing $stext with $rtext in $pic: -$com[$j]- " if $verbose; $com[$j] =~ s/$spat/$rtext/g; print "to -$com[$j]-\n" if $verbose; $meta->set_comment($j, $com[$j]); } $replace++; $countComments++; } } if ($replace > 0) { unless ($test) { unless ($meta->save()) { warn "replaceComment: save $pic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dthumb); updateOneRow($dpic, $lb); } $countFiles++; } else { $nostr .= "$dpic\n"; } } progressWinEnd($pw); # short the strings for better output $stextd = cutString($stext, 20, ".."); $rtextd = cutString($rtext, 20, ".."); my $text = "Replaced "; $text = "Test mode:\nMapivi would replace " if $test; $text .= "the string \"$stextd\" with \"$rtextd\"\nin $countComments comments of $countFiles pictures\n\n"; if (($nocom ne "") or ($nostr ne "")) { $text .= "Found no comments in these pictures:\n$nocom\n" if ($nocom ne ""); $text .= "Found no string matching \"$stextd\" in these pictures:\n$nostr\n" if ($nostr ne ""); } showText("Replace comment log", $text, WAIT); } $userinfo = "ready! ($i of ".scalar @sellist." pictures processed)"; $userInfoL->update; } ############################################################## # nameToComment - add the filename as comment to all selected # pictures ############################################################## sub nameToComment { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirthumb, $i, $com); my $dia = $top->DialogBox(-title => "Add filename to comment", -buttons => ['OK', 'Cancel']); $dia->add("Label", -text => "This function will add a comment containing\nthe individual filename of $selected pictures!", -bg => $config{ColorBG}, -justify => "left")->pack; $dia->add("Checkbutton", -text => "Remove suffix (.jpg)", -variable => \$config{NameComRmSuffix})->pack; my $rc = $dia->Show(); $top->focusForce; return if ($rc ne 'OK'); $userinfo = "adding filename as comment of $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Adding file name as comment"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Adding file name ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); $com = $pic; next if (!checkWriteable($dpic)); if (($config{NameComRmSuffix}) and ($pic =~ /(.*)(\.jp(g|eg))/i)) { $com = $1; # remove .jp(e)g suffix } # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $meta = getMetaData($dpic, "COM"); next unless ($meta); $meta->add_comment($com); unless ($meta->save()) { warn "nameToComment: save $pic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected processed)"; $userInfoL->update; } ############################################################## # showComment - show the comment of all selected pictures ############################################################## sub showComment { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return unless askSelection(\@sellist, 10, "comment"); my $selected = @sellist; my $nocomment = ""; my ($pic, $dpic, $i, $plural, $thumb); $userinfo = "displaying JPEG comments of $selected pictures"; $userInfoL->update; my $pw = progressWinInit($top, "Display comments"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "displaying comment ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $thumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my @comments = getComments($dpic); my $comment = ""; foreach (@comments) { $comment .= "$_\n"; } (@comments > 1) ? ($plural = "s") : ($plural = ""); if ($comment ne "") { showText("$pic contains ".scalar @comments." comment$plural", $comment, NO_WAIT, $thumb); } else { $nocomment .= "$pic\n"; } } progressWinEnd($pw); if ($nocomment ne "") { showText("no comments", "no comments in:\n$nocomment", NO_WAIT); } $userinfo = "ready! ($i of $selected displayed)"; $userInfoL->update; } ############################################################## # addDecoration ############################################################## sub addDecoration { return if (!checkExternProgs("addDecoration", "mogrify")); my $index = shift; my @sellist; if ((defined $index) and ($index >= 0) and ($index < $picLB->info('children'))) { push @sellist, $index; } else { @sellist = $picLB->info('selection'); } my $selected = @sellist; my ($dpic, $i, $command); return unless checkSelection($top, 1, 0, \@sellist); $userinfo = "adding decorations to $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); return if (!decorationDialog($selected,1)); my $pw = progressWinInit($top, "Adding decoration"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding decorations ($i/$selected) ...", $i, $selected); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); $command = "mogrify ".makeDrawOptions($dpic)."-quality ".$config{PicQuality}." \"$dpic\""; execute($command); addDropShadow($dpic); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one updateOneRow($dpic, $picLB); } progressWinEnd($pw); reselect($picLB, @sellist); $userinfo = "ready! ($i of $selected)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # addDropShadow - to be called after makeDrawOptions and # mogrify # operates on the pic directly # a backup has to be made before ############################################################## sub addDropShadow { my $dpic = shift; return unless (-f $dpic); return unless ($config{DropShadow}); my $b4 = $config{DropShadowWidth} * 4; my $b3 = $config{DropShadowWidth} * 3; my $command = "convert -depth 8 -colors 1 -gamma 0 \"$dpic\" -bordercolor \"".$config{DropShadowBGColor}."\" -border ${b4}x${b4} -gaussian 0x".$config{DropShadowBlur}." -shave ${b3}x${b3} - | composite -quality ".$config{PicQuality}." -gravity northwest \"$dpic\" - \"$dpic\""; #(system "$command") == 0 or warn "$command failed: $!"; print "addDropShadow: $command\n" if $verbose; execute($command); } ############################################################## # makeDrawOptions ############################################################## sub makeDrawOptions { my $dpic = shift; my $command = ""; my $x = $config{CopyX}; my $y = $config{CopyY}; if ($config{BorderAdd}) { $command .= '-bordercolor "'.$config{BorderColor1}.'" -border '.$config{BorderWidth1x}.'x'.$config{BorderWidth1y}.' '; $command .= '-bordercolor "'.$config{BorderColor2}.'" -border '.$config{BorderWidth2x}.'x'.$config{BorderWidth2y}.' ' if (($config{BorderWidth2x} > 0) or ($config{BorderWidth2y} > 0)); $command .= '-bordercolor "'.$config{BorderColor3}.'" -border '.$config{BorderWidth3x}.'x'.$config{BorderWidth3y}.' ' if (($config{BorderWidth3x} > 0) or ($config{BorderWidth3y} > 0)); $command .= '-bordercolor "'.$config{BorderColor4}.'" -border '.$config{BorderWidth4x}.'x'.$config{BorderWidth4y}.' ' if (($config{BorderWidth4x} > 0) or ($config{BorderWidth4y} > 0)); } if ($config{CopyAdd}) { if ($config{CopyTextOrLogo} eq "text") { # text $command .= "-gravity $config{CopyPosition} "; my $geo1 = ($x+1).",".($y+1); my $geo2 = "$x,$y"; print "drawoptions: x = $x y = $y geo1 = $geo1 geo2 = $geo2\n" if $verbose; $command .= "-font '-*-".$config{CopyFontFamily}."-medium-r-*-*-".$config{CopyFontSize}."-*-*-*-*-*-iso8859-*' "; $command .= "-fill \"".$config{CopyFontColBG}."\" -draw 'text $geo1 \"".$config{Copyright}."\"' " if $config{CopyFontShadow}; $command .= "-fill \"".$config{CopyFontColFG}."\" -draw 'text $geo2 \"".$config{Copyright}."\"' "; } else { # logo image my ($lw, $lh) = getSize($config{CopyrightLogo}); my ($pw, $ph) = getSize($dpic); if ($config{BorderAdd}) { # calc new size of pic (including borders) $pw += 2 * $config{BorderWidth1x}; $pw += 2 * $config{BorderWidth2x}; $pw += 2 * $config{BorderWidth3x}; $ph += 2 * $config{BorderWidth1y}; $ph += 2 * $config{BorderWidth2y}; $ph += 2 * $config{BorderWidth3y}; } if ($config{CopyPosition} eq 'NorthEast') { $x = $pw - $lw - $x; } elsif ($config{CopyPosition} eq 'North') { $x = $pw/2 - $lw/2 - $x; } elsif ($config{CopyPosition} eq 'SouthWest') { $y = $ph - $lh - $y; } elsif ($config{CopyPosition} eq 'South') { $y = $ph - $lh - $y; $x = $pw/2 - $lw/2 - $x; } elsif ($config{CopyPosition} eq 'SouthEast') { $y = $ph - $lh - $y; $x = $pw - $lw - $x; } $x = int($x); $y = int($y); my $geo = "$x,$y"; $command .= "-draw \"image Over $geo $lw,$lh '".$config{CopyrightLogo}."'\" "; } } print "command == $command\n" if $verbose; return $command; } ############################################################## # buildBackupName ############################################################## sub buildBackupName($) { my $bpic = shift; $bpic =~ s/(.*)\.(.*)/$1-bak.$2/i; return $bpic; } ############################################################## # getBasenameSuffix ############################################################## sub getBasenameSuffix { my $suffix; my $base; my $file = shift; my @parts = split /\./, $file; if (@parts > 1) { $suffix = $parts[-1]; $base = substr($file, 0, length($file)-length($suffix)-1); } else { $suffix = ''; $base = $file; } return ($base, $suffix); } ############################################################## # makeBackup ############################################################## sub makeBackup($) { my $dpic = shift; return 0 if (!-f $dpic); return 1 if (!$config{MakeBackup}); my $dir = dirname($dpic); my $dthumb = getThumbFileName($dpic); my $bpic = buildBackupName($dpic); # make a backup file if (!mycopy("$dpic", "$bpic", ASK_OVERWRITE)) { my $rc = $top->messageBox(-icon => 'question', -message => "Proceed anyway?", -title => "Proceed?", -type => 'OKCancel'); if ($rc =~ m/Ok/i) { return 1; } else { return 0; } } # copy the thumbnail too mycopy($dthumb, getThumbFileName($bpic), OVERWRITE); if (!-f $bpic) { warn "backup failed, there is no $bpic, giving up ..."; return 0; } else { # copy meta info in search database (needed e.g. for nr. of views) $searchDB{$bpic} = $searchDB{$dpic}; # insert backup in listbox addOneRow($picLB, $bpic, 1, $dpic); } return 1; } ############################################################## # getImageMagickFonts - get the font families supported by IM ############################################################## sub getImageMagickFonts { return if (!checkExternProgs('getImageMagickFonts', 'identify')); my $fonts = `identify -list type`; my %families; my @lines = split(/\n/, $fonts); foreach my $line (@lines) { #print "line = $line\n"; # \s = whitespace \S = non-whitespece \d = number if ($line =~ m |(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+)|) { $families{$2} = 1; } } my @font_families = sort keys(%families); #print "font_families: $_\n" foreach (@font_families); return @font_families; } my $decoW; ############################################################## # decorationDialog ############################################################## sub decorationDialog { if (Exists($decoW)) { $decoW->deiconify; $decoW->raise; return; } my $pics = shift; my $QandB = shift; # bool - show Quality-Scale and Backup-Checkbutton my $rc = 0; my $max = 1000; #my @fontFamilies = sort $top->fontFamilies; my @fontFamilies = getImageMagickFonts(); # open window $decoW = $top->Toplevel(); $decoW->title('Add border/copyright/shadow'); $decoW->iconimage($mapiviicon) if $mapiviicon; my $addF = $decoW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x', -padx => 5, -pady => 3); $addF->Label(-text => "Process $pics pictures", -bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w', -fill => 'x', -padx => 5, -pady => 3); $addF->Label(-text => "Add ", -bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w'); $addF->Checkbutton(-text => "border ", -variable => \$config{BorderAdd})->pack(-side => 'left', -anchor => 'w'); $addF->Checkbutton(-text => "copyright info ", -variable => \$config{CopyAdd})->pack(-side => 'left', -anchor => 'w'); $addF->Checkbutton(-text => "drop shadow", -variable => \$config{DropShadow})->pack(-side => 'left', -anchor => 'w'); my $notebook = $decoW->NoteBook(#-width => 500, -background => $config{ColorBG}, # background of active page (including its tab) -inactivebackground => $config{ColorEntry}, # tabs of inactive pages -backpagecolor => $config{ColorBG}, # background behind notebook )->pack(-expand => "yes", -fill => "both", -padx => 5, -pady => 5); my $cF = $notebook->add("border", -label => "Border"); my $bF = $notebook->add("copy", -label => "Copyright"); my $dF = $notebook->add("shadow", -label => "Drop shadow"); if ($QandB) { my $qS = labeledScale($decoW, 'top', 19, "Quality (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); buttonBackup($decoW, 'top'); buttonComment($decoW, 'top'); } # ### copyright ### my $pfa = $bF->Frame()->pack(-anchor => 'w'); $pfa->Label(-text => "Position in picture", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3); my $pf = $pfa->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-side => "left"); my $pfn = $pf->Frame()->pack(); my $pfs = $pf->Frame()->pack(); foreach my $gravity qw(NorthWest North NorthEast) { my $but = $pfn->Radiobutton(-text => "", -variable => \$config{CopyPosition}, -value => $gravity)->pack(-side => 'left'); $balloon->attach($but, -msg => "Align the copyright text or logo in $gravity position"); } foreach my $gravity qw(SouthWest South SouthEast) { my $but = $pfs->Radiobutton(-text => "", -variable => \$config{CopyPosition}, -value => $gravity)->pack(-side => 'left'); $balloon->attach($but, -msg => "Align the copyright text or logo in $gravity position"); } labeledScale($bF, 'top', 17, "x offset", \$config{CopyX}, 0, $max, 1); labeledScale($bF, 'top', 17, "y offset", \$config{CopyY}, 0, $max, 1); my $ctF = $bF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x',-padx => 5, -pady => 5); my $clF = $bF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-anchor => 'w', -fill => 'x', -padx => 5, -pady => 5); $ctF->Radiobutton(-text => "add copyright text", -variable => \$config{CopyTextOrLogo}, -value => "text")->pack(-anchor => 'w'); labeledEntry($ctF, 'top', 17, "Copyright text", \$config{Copyright}); my $fontF = $ctF->Frame(-bd => 0)->pack(-anchor => 'w', -padx => 5, -pady => 3); my $fontF2 = $ctF->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -height => 80, -width => 480)->pack(-anchor => 'w', -padx => 5, -pady => 3); $fontF->Label(-text => "Font family", -bg => $config{ColorBG})->pack(-side => "left"); my $fontL = $fontF2->Label(-textvariable => \$config{Copyright}, -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Optionmenu(-textvariable => \$config{CopyFontFamily}, -options => \@fontFamilies, -command => sub { $decoW->Busy; my $font = $top->Font(-family => $config{CopyFontFamily}, -size => $config{CopyFontSize}); $fontL->configure(-font => $font) if (ref($font) eq 'HASH'); $fontL->update(); $decoW->Unbusy; })->pack(-side => "left", -anchor => 'w'); $fontF->Label(-text => "Font size", -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Scale( -variable => \$config{CopyFontSize}, -from => 5, -to => 200, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 0, -width => 15, -bd => $config{Borderwidth}, -command => sub { $decoW->Busy; my $font = $top->Font(-family => $config{CopyFontFamily}, -size => $config{CopyFontSize}); $fontL->configure(-font => $font); $fontL->update(); $decoW->Unbusy; })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $fontF->Label(-textvariable => \$config{CopyFontSize})->pack(-side => "left"); labeledEntryColor($ctF, 'top', 17, "Foreground color", 'Set', \$config{CopyFontColFG}); $ctF->Checkbutton(-variable => \$config{CopyFontShadow}, -anchor => 'w', -text => "Add a shadow to the copyright text" )->pack(-anchor => 'w', -padx => 5, -pady => 3); labeledEntryColor($ctF, 'top', 17, "Shadow color", 'Set', \$config{CopyFontColBG}); $clF->Radiobutton(-text => "add copyright logo (image)", -variable => \$config{CopyTextOrLogo}, -value => "logo")->pack(-anchor => 'w'); labeledEntryButton($clF,'top',17,"path/name of logo",'Set',\$config{CopyrightLogo}); # ### border ### $cF->Label(-text => "Add one or several borders around pictures", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); my $wi = 25; my $bF1 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $bF1->Label(-text => "Border 1 - innermost border", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); labeledScale($bF1, 'top', $wi, "Border width x-direction", \$config{BorderWidth1x}, 0, $max, 1); labeledScale($bF1, 'top', $wi, "Border width y-direction", \$config{BorderWidth1y}, 0, $max, 1); labeledEntryColor($bF1, 'top', $wi, "Color", 'Set', \$config{BorderColor1}); my $bF2 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $bF2->Label(-text => "Border 2 - border around border 1 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); labeledScale($bF2, 'top', $wi, "Border width x-direction", \$config{BorderWidth2x}, 0, $max, 1); labeledScale($bF2, 'top', $wi, "Border width y-direction", \$config{BorderWidth2y}, 0, $max, 1); labeledEntryColor($bF2, 'top', $wi, "Color", 'Set', \$config{BorderColor2}); my $bF3 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $bF3->Label(-text => "Border 3 - border around border 2 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); labeledScale($bF3, 'top', $wi, "Border width x-direction", \$config{BorderWidth3x}, 0, $max, 1); labeledScale($bF3, 'top', $wi, "Border width y-direction", \$config{BorderWidth3y}, 0, $max, 1); labeledEntryColor($bF3, 'top', $wi, "Color", 'Set', \$config{BorderColor3}); my $bF4 = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $bF4->Label(-text => "Border 4 - border around border 3 (use width 0 to disable)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); labeledScale($bF4, 'top', $wi, "Border width x-direction", \$config{BorderWidth4x}, 0, $max, 1); labeledScale($bF4, 'top', $wi, "Border width y-direction", \$config{BorderWidth4y}, 0, $max, 1); labeledEntryColor($bF4, 'top', $wi, "Color", 'Set', \$config{BorderColor4}); # ### drop shadow ### $dF->Label(-text => "Add a drop shadow to the pictures", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); $dF->Label(-text => "(conversion may take some time)", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3); labeledScale($dF, 'top', 17, "Border width", \$config{DropShadowWidth}, 1, $max, 1); labeledScale($dF, 'top', 17, "Shadow blur", \$config{DropShadowBlur}, 1, 9, 1); labeledEntryColor($dF, 'top', 17, "Background color", 'Set', \$config{DropShadowBGColor}); my $ButF = $decoW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $decoW->withdraw(); $decoW->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $decoW->withdraw(); $decoW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $decoW->bind('', sub { $Xbut->invoke; }); $decoW->bind('', sub { $Xbut->invoke; }); $decoW->Popup; $decoW->waitWindow; return $rc; } my $colw; ############################################################## # colorDialog ############################################################## sub colorDialog { if (Exists($colw)) { $colw->deiconify; $colw->raise; return; } my $rc = 0; # open window $colw = $top->Toplevel(); $colw->title('Color options'); $colw->iconimage($mapiviicon) if $mapiviicon; foreach (qw(Brightness Saturation Hue)) { labeledScale($colw, 'top', 16, "$_ (%)", \$config{"Pic$_"}, 0, 200, 1); } labeledScale($colw, 'top', 16, "Gamma", \$config{PicGamma}, 0.1, 10.0, 0.01); $colw->Button(-text => "Reset", -command => sub { foreach (qw(Brightness Saturation Hue)) { $config{"Pic$_"} = 100; } $config{PicGamma} = 1.00; })->pack(-anchor => 'w', -padx => 3, -pady => 3); my $OKB = $colw->Button(-text => "Close", -command => sub { $rc = 1; $colw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $colw->bind('', sub { $OKB->invoke; }); $colw->bind('', sub { $OKB->invoke; }); $colw->Popup; $colw->waitWindow; } my $uw; ############################################################## # unsharpDialog ############################################################## sub unsharpDialog { if (Exists($uw)) { $uw->deiconify; $uw->raise; return; } my $rc = 0; # open window $uw = $top->Toplevel(); $uw->title('Unsharp mask options'); $uw->iconimage($mapiviicon) if $mapiviicon; my $usr =labeledScale($uw, 'top', 16, "Radius (pixel)", \$config{UnsharpRadius}, 0, 10, 1); $balloon->attach($usr, -msg => "The radius of the Gaussian, in pixels, not counting the center pixel. Use a radius of 0 and the function selects a suitable radius for you (default 0)"); my $uss = labeledScale($uw, 'top', 16, "Sigma (pixel)", \$config{UnsharpSigma}, 0.1, 10, 0.1); $balloon->attach($uss, -msg => "The standard deviation of the Gaussian,\nin pixels (default 1.0)"); my $usa = labeledScale($uw, 'top', 16, "amount (%)", \$config{UnsharpAmount}, 0, 100, 0.1); $balloon->attach($usa, -msg => "The percentage of the difference between the original\nand the blur image that is added back into the original\n(default 1.0)"); my $ust = labeledScale($uw, 'top', 16, "Threshold (frac)", \$config{UnsharpThreshold}, 0, 10, 0.01); $balloon->attach($ust, -msg => "The threshold, as a fraction of MaxRGB,\nneeded to apply the difference amount\n(default 0.05)"); $uw->Button(-text => "Default", -command => sub { $config{UnsharpRadius} = 0; $config{UnsharpSigma} = 1.0; $config{UnsharpAmount} = 1.0; $config{UnsharpThreshold} = 0.05; })->pack(-anchor => 'w', -padx => 3, -pady => 3); my $OKB = $uw->Button(-text => "Close", -command => sub { $rc = 1; $uw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $uw->bind('', sub { $OKB->invoke; }); $uw->bind('', sub { $OKB->invoke; }); $uw->Popup; $uw->waitWindow; } my $lw; ############################################################## # levelDialog ############################################################## sub levelDialog { if (Exists($lw)) { $lw->deiconify; $lw->raise; return; } my $rc = 0; # open window $lw = $top->Toplevel(); $lw->title('Levels'); $lw->iconimage($mapiviicon) if $mapiviicon; my $lws = labeledScale($lw, 'top', 18, "White point (%)", \$config{LevelWhite}, 0, 100, 1); $balloon->attach($lws, -msg => "White point specifies the lightest color in the image. Colors brighter than the white point are set to the maximum quantum value."); my $lms = labeledScale($lw, 'top', 18, "Mid point (gamma)", \$config{LevelGamma}, 0.1, 10.0, 0.1); $balloon->attach($lms, -msg => "Mid point specifies a gamma correction to apply to the image."); my $lbs = labeledScale($lw, 'top', 18, "Black point (%)", \$config{LevelBlack}, 0, 100, 1); $balloon->attach($lbs, -msg => "The black point specifies the darkest color in the image. Colors darker than the black point are set to zero."); $lw->Button(-text => "Reset", -command => sub { $config{LevelWhite} = 100; $config{LevelGamma} = 1.0; $config{LevelBlack} = 0; })->pack(-anchor => 'w', -padx => 3, -pady => 3); my $OKB = $lw->Button(-text => "Close", -command => sub { $rc = 1; $lw->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $lw->bind('', sub { $OKB->invoke; }); $lw->bind('', sub { $OKB->invoke; }); $lw->Popup; $lw->waitWindow(); } ############################################################## # editIPTC - edit IPTC info of one or multiple pictures ############################################################## sub editIPTC($) { my $lb = shift; my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($pic, $dpic, $dirthumb, @in, @out, %saw); # check if some files are links return if (!checkLinks($lb, @sellist)); $dpic = $sellist[0]; $pic = basename($dpic); my %iptcmh; my $iptcm = \%iptcmh; # $iptcm = IPTC master, must be a hash reference # take the first picture as master for the IPTC data my $meta = getMetaData($dpic, 'APP13'); unless ($meta) { warn "no APP13 in $dpic"; return; } if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) { $iptcm = $meta->get_app13_data('TEXTUAL', 'IPTC'); } # handle several pictures: the IPTC dialog should just show common elements if (@sellist > 1) { my $i = 0; # show a progressbar if there are more than 5 pictures selected my $pw = progressWinInit($lb, 'Analyzing IPTC data ...') if (@sellist > 5); foreach my $dpic (@sellist) { if ($pw) {last if progressWinCheck($pw)}; $i++; progressWinUpdate($pw, "Collecting common data ($i/".scalar @sellist.") ...", $i, scalar @sellist) if ($pw); my $iptc; # get IPTC data my $meta = getMetaData($dpic, 'APP13'); unless ($meta) { warn "no APP13 in $dpic"; next; } if (defined $meta->get_app13_data('TEXTUAL', 'IPTC')) { $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); } # compare each key from the master foreach my $key (keys %{$iptcm}) { my $ref = ref($iptcm->{$key}); my $nr = scalar @{$iptcm->{$key}}; # if key doesn't exists in one of the pictures we remove this key unless (exists $iptc->{$key}) { delete $iptcm->{$key}; next; } # get the intersection of the key content (this works for single elements and lists) my @intersection = listIntersection($iptcm->{$key}, $iptc->{$key}); # if there is something left we take the intersection if (@intersection) { $iptcm->{$key} = \@intersection; } # else we remove the key else { delete $iptcm->{$key}; } } } progressWinEnd($pw) if ($pw); } my @keywords_common = (); my @suppcats_common = (); foreach (@{$iptcm->{Keywords}}) { $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword) } ${$iptcm->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptcm->{Caption}}[0]); # replace all non-printable chars, but not newline etc. # these are the common items (e.g. common keywords of all selected pictures) @keywords_common = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords}); @suppcats_common = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory}); my $rc = iptcDialog($iptcm, $pic, scalar @sellist); return if ($rc ne 'OK'); # after user interaction in the dialog my @keywords_master = (); @keywords_master = @{$iptcm->{Keywords}} if (exists $iptcm->{Keywords}); my @suppcats_master = (); @suppcats_master = @{$iptcm->{SupplementalCategory}} if (exists $iptcm->{SupplementalCategory}); # to remove keywords and categories we need to figure out what has been removed by the user my @keywords_removed = diffList(\@keywords_common, \@keywords_master); my @suppcats_removed = diffList(\@suppcats_common, \@suppcats_master); my $IPTC_action = $config{IPTC_action}; $IPTC_action = 'REPLACE' if (@sellist == 1); my $errors = ""; my $i = 0; my $pw = progressWinInit($lb, "Writing IPTC info"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Writing IPTC info ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $meta = getMetaData($dpic, 'APP1'); # APP1 includes EXIF and IPTC (APP13) my $er = $meta->get_Exif_data('ALL', 'TEXTUAL'); my $iptc; # copy (clone) master iptc hash to picture iptc hash $iptc = dclone($iptcm); if (($config{IPTCdateEXIF}) or ($config{IPTCtimeEXIF})) { my $date = getEXIFDate($dpic, $er); # date format YYYY:MM:DD HH:mm:SS if (my ($y, $M, $d, $h, $m, $s) = $date =~ m/(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/) { my $time = timelocal($s,$m,$h,$d,($M-1),($y-1900)); my $diff = ((localtime($time))[2] - (gmtime($time))[2]); # RJW: Correct timezone calculation in case of migration over # 24 hour border if ( $diff > 12 ) { $diff -= 24; } elsif ( $diff < -12 ) { $diff += 24; } my $GMToffset = sprintf("%+03d00", $diff); my $IPTCdate = $y.$M.$d; my $IPTCtime = $h.$m.$s.$GMToffset; # according to IPTC - NAA INFORMATION INTERCHANGE MODEL, Version No. 4, 1999, http://www.iptc.org/IIM/ ${$iptc->{DateCreated}}[0] = $IPTCdate if ($config{IPTCdateEXIF}); # format CCYYMMDD ${$iptc->{TimeCreated}}[0] = $IPTCtime if ($config{IPTCtimeEXIF}); # format HHMMSS+HHMM } else { warn "picture has an unusual EXIF date: \"$date\" ($dpic)\n" if $config{MetadataWarn}; } } if ($config{IPTCbylineEXIF}) { if (defined $er) { my $owner = ''; if (defined $er->{SUBIFD_DATA}->{OwnerName}) { $owner = join('', @{$er->{SUBIFD_DATA}->{OwnerName}}); } elsif (defined $er->{IFD0_DATA}->{Artist}) { $owner = join('', @{$er->{IFD0_DATA}->{Artist}}); } elsif (defined $er->{SUBIFD_DATA}->{UserComment}) { $owner = join('', @{$er->{SUBIFD_DATA}->{UserComment}}); } else { } if ($owner ne '') { $owner =~ tr/ -~//cd; # remove non-printable characters (but not \n) $owner =~ s/ASCII//g; # cut 'ASCII' $owner =~ s/^\s+//; # cut leading white $owner =~ s/\s+$//; # cut trailing white print "*** Writing \"$owner\" to $dpic\n" if $verbose; ${$iptc->{ByLine}}[0] = $owner; } } } if ($config{IPTCaddMapivi}) { ${$iptc->{OriginatingProgram}}[0] = 'Mapivi'; ${$iptc->{ProgramVersion}}[0] = $version; } # make some corrections for keywords and supp cats # according to the documentation of Image::MetaData::JPEG this should not be needed if ((@sellist > 1) and (($IPTC_action eq 'UPDATE') or ($IPTC_action eq 'ADD'))) { # todo problem is still, that removed elements (where nothing is left, e.g. a headline) are not removed in Update mode my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement if ($seg) { my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC'); my @keywords; # take the original items and add the items from the dialog (master) push @keywords, @{$hashref->{Keywords}} if (defined($hashref->{Keywords})); push @keywords, @keywords_master; # then remove items which have been removed in the dialog @keywords = diffList(\@keywords, \@keywords_removed); #@keywords = ('') unless (@keywords); $iptc->{Keywords} = \@keywords; my @suppcats; # take the original items and add the items from the dialog (master) push @suppcats, @{$hashref->{SupplementalCategory}} if (defined($hashref->{SupplementalCategory})); push @suppcats, @suppcats_master; # then remove items which have been removed in the dialog @suppcats = diffList(\@suppcats, \@suppcats_removed); $iptc->{SupplementalCategory} = \@suppcats; } } $meta->set_app13_data($iptc, $IPTC_action, 'IPTC'); uniqueIPTC($meta); unless ($meta->save()) { $errors .= "save failed for $dpic\n"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding touch($dirthumb); updateOneRow($dpic, $lb); if ($dpic eq $actpic) { showImageInfoCanvas($dpic); if ($config{ShowCaptionField}) { my $caption = getIPTCCaption($dpic); $captionText->delete( 0.1, 'end'); # remove old caption $captionText->insert('end', $caption); # insert new caption } } } progressWinEnd($pw); $userinfo = "ready! ($i/".scalar @sellist." written)"; $userInfoL->update; showText("Errors while editing IPTC info", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # setIPTCurgency - set the urgency flag to a given value (0 .. 8) ############################################################## sub setIPTCurgency { my $lb = shift; # the reference to the active listbox widget my $urgency = shift; return unless (defined($urgency)); return if (($urgency < 0) or ($urgency > 9)); # 9 is used to clear the urgency flag my @sellist = getSelection($lb); return unless checkSelection($lb, 1, 0, \@sellist); my ($pic, $dpic, $dirthumb, $msg); # check if some files are links return if (!checkLinks($lb, @sellist)); $urgency = "" if ($urgency == 9); # 9 is used to clear the urgency flag $msg = "Writing IPTC urgence $urgency"; $msg = "Deleting IPTC urgence flag" if ($urgency eq ""); my $errors = ""; my $i = 0; my $pw = progressWinInit($lb, $msg); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "$msg ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $meta = getMetaData($dpic, 'APP13'); my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); warn "IPTC segment of $dpic has errors!" if ($iptc->{error}); if ($config{UrgencyChangeWarning} and (defined $iptc->{"Urgency"}) and (${$iptc->{"Urgency"}}[0] != $urgency)) { $errors .= "Info: Urgency changed from ".${$iptc->{"Urgency"}}[0]." to $urgency $dpic\n"; } $iptc->{Urgency} = $urgency; # todo why is this here foreach (@{$iptc->{Keywords}}) { $_ =~ tr/ -~//cd; # remove non-printables (Picasa adds one to each keyword) } # todo why is this here ${$iptc->{Caption}}[0] =~ tr/\n\t\r\f -~//cd if (${$iptc->{Caption}}[0]); # replace all non-printable chars, but not newline etc. $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); if (!$meta->save()) { $errors .= "save failed for $dpic\n"; } else { # urgency changed successfully! print "saved IPTC urgency $urgency to $pic\n" if $verbose; # touch the thumbnail pic (set actual time stamp), to suppress rebuilding touch($dirthumb); updateOneRow($dpic, $lb); if ($dpic eq $actpic) { showImageInfoCanvas($dpic); $urgencyStr = $urgency; # display new urgency in the status bar unless ($urgency eq "") { $urgencyScale = 9 - $urgencyStr; $urgencyScale = 0 if (($urgencyStr < 1) or ($urgencyStr > 8)); } } } } progressWinEnd($pw); $msg = "urgency $urgency written to"; $msg = "removed urgency flag in" if ($urgency eq ""); $userinfo = "ready! ($msg $i/".scalar @sellist.") pictures"; $userInfoL->update; showText("Errors and infos while saving IPTC urgency", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # getIPTCurgencyDB - get the urgency flag of a given file from # the search database # returns 9 if there is no file or no urgency ############################################################## sub getIPTCurgencyDB { my $dpic = shift; my $urgency = 9; $urgency = $searchDB{$dpic}{URG} if (defined $searchDB{$dpic}{URG}); return $urgency; } ############################################################## # getIPTCurgency - get the urgency flag of a given file # returns 9 if there is no file or no urgency ############################################################## sub getIPTCurgency { my $dpic = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available my $urgency = 9; return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); return 9 unless (-f $dpic); $meta = getMetaData($dpic, "APP13", 'FASTREADONLY') unless (defined($meta)); return 9 unless ($meta); my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement return 9 unless ($seg); my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC'); if (defined($hashref->{Urgency})) { $urgency = ${$hashref->{Urgency}}[0]; $urgency = 8 if ($urgency =~ /l/i); $urgency = 1 if ($urgency =~ /h/i); $urgency = 9 if ($urgency !~ /\d/); $urgency = 9 if ( ($urgency > 9) or ($urgency < 0) ); } $quickSortHash{$dpic} = $urgency if $quickSortSwitch; print "getIPTCurgency: -$urgency- $dpic\n" if $verbose; return $urgency; } ############################################################## # getIPTCkeywords - get the keywords of a given file # returns empty list if there is no file or # no keyword ############################################################## sub getIPTCkeywords { my $dpic = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available my @keywords = (); return @keywords unless (-f $dpic); $meta = getMetaData($dpic, 'APP13', 'FASTREADONLY') unless (defined($meta)); return @keywords unless ($meta); my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement return @keywords unless ($seg); my $hashref = $seg->get_app13_data('TEXTUAL', 'IPTC'); if (defined($hashref->{Keywords})) { @keywords = @{$hashref->{Keywords}}; } foreach (@keywords) { # translate it to a string if it is non-printing #my $key = $_; #$key =~ s/[\000-\037\177-\377]/sprintf "\\%02x",ord($&)/e; #print "key = -$key-\n"; $_ =~ tr/ -~//cd; # replace all non-printable chars (Picasa adds one to each keyword) } return @keywords; } ############################################################## # getIPTCByLine - get the by-line info of a given file ############################################################## sub getIPTCByLine($) { my $dpic = shift; my $byline = ""; return $quickSortHash{$dpic} if ($quickSortSwitch and defined $quickSortHash{$dpic}); return $byline unless (-f $dpic); my $meta = getMetaData($dpic, "APP13", 'FASTREADONLY'); return $byline unless ($meta); my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement return $byline unless ($seg); my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC'); $byline = ${$hashref->{ByLine}}[0] if (defined($hashref->{ByLine})); $quickSortHash{$dpic} = $byline if $quickSortSwitch; print "getIPTCByLine: $byline ($dpic)\n" if $verbose; return $byline; } ############################################################## # getIPTCAttr - get an IPTC attribute of a given file ############################################################## sub getIPTCAttr { my $dpic = shift; my $name = shift; my $val = ""; if (-f $dpic) { my $meta = getMetaData($dpic, "APP13", 'FASTREADONLY'); if ($meta) { my $seg = $meta->retrieve_app13_segment(undef, 'IPTC'); # todo should be possible without segement if ($seg) { my $hashref = $seg->get_app13_data("TEXTUAL", 'IPTC'); if (defined($hashref->{$name})) { $val = ${$hashref->{$name}}[0]; print "getIPTCAttr: $name=$val ($dpic)\n" if $verbose; } } } } return $val; } ############################################################## # getIPTCObjectName - get the object name of a given file ############################################################## sub getIPTCObjectName { my $dpic = shift; return getIPTCAttr($dpic, "ObjectName"); } ############################################################## # getIPTCHeadline - get the headline of a given file ############################################################## sub getIPTCHeadline { my $dpic = shift; return getIPTCAttr($dpic, "Headline"); } ############################################################## # getIPTCCaption - get the caption of a given file ############################################################## sub getIPTCCaption { my $dpic = shift; return getIPTCAttr($dpic, "Caption/Abstract"); } ############################################################## # getIPTCByLineTitle - get the by-line title of a given file ############################################################## sub getIPTCByLineTitle { my $dpic = shift; return getIPTCAttr($dpic, "ByLineTitle"); } ############################################################## # getIPTCSublocation - get the sublocation of a given file ############################################################## sub getIPTCSublocation { my $dpic = shift; return getIPTCAttr($dpic, "SubLocation"); } ############################################################## # getIPTCCity - get the city of a given file ############################################################## sub getIPTCCity { my $dpic = shift; return getIPTCAttr($dpic, "City"); } ############################################################## # getIPTCProvince - get the province/state of a given file ############################################################## sub getIPTCProvince { my $dpic = shift; return getIPTCAttr($dpic, "Province/State"); } ############################################################## # getIPTCCountryCode - get the country code of a given file ############################################################## sub getIPTCCountryCode { my $dpic = shift; return getIPTCAttr($dpic, "Country/PrimaryLocationCode"); } ############################################################## # iptcDialog ############################################################## sub iptcDialog { my $iptc = shift; my $picname = shift; my $nr = shift; # number of pics my $rc = 'Cancel'; my @tag_list; # used to store all IPTC tags which are already displayed, all others will go to the misc tab # open window my $t = $top->Toplevel(); $t->title("Edit IPTC/IIM information of $nr pictures ($picname)"); $t->iconimage($mapiviicon) if $mapiviicon; my $notebook = $t->NoteBook(-width => 750, -background => $config{ColorBG}, # background of active page (including its tab) -inactivebackground => $config{ColorEntry}, # tabs of inactive pages -backpagecolor => $config{ColorBG}, # background behind notebook )->pack(-expand => 1, -fill => 'both', -padx => 5, -pady => 5); my $aN = $notebook->add('stan', -label => 'Standard'); my $bN = $notebook->add('misc', -label => 'Misc'); my $cN = $notebook->add('opt', -label => 'Options'); $notebook->raise($config{IPTCLastPad}); my $w = 11; my $ent; ####### Standart IPTC tags ############# # left and right frame on standard tab my $aF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0); my $bF = $aN->Frame(-bd => 0)->pack(-side => 'left', -expand => 1, -fill => 'both', -padx => 3, -pady => 0); my @alist = ('Headline', 'ObjectName'); foreach (@alist) { $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0], 5); if (defined $iptcHelp{$_}) { $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent); } } push @tag_list, @alist; # add already displayed elements to the list ####### Caption ############# my $capF = $aF->Frame(-bd => 0)->pack(-anchor=>'w', -expand => 1, -fill => 'both', -padx => 3, -pady => 3); $capF->Label(-text => 'Caption/Abstract', -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 2, -pady => 2); my $caption = $capF->Scrolled("Text", -scrollbars => 'osoe', -wrap => 'word', -width => 60, -height => 6, )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2); $caption->insert('end', ${$iptc->{'Caption/Abstract'}}[0]); $caption->see(0.1); push @tag_list, 'Caption/Abstract'; # add already displayed elements to the list ####### Urgency ############# my $oF = $aF->Frame(-bd => 0)->pack(-anchor=>'w', -padx => 3, -pady => 6); $balloon->attach($oF, -msg => "Rating/Urgency\n0 = no\n1 = High ********\n2 = *******\n3 = ******\n4 = *****\n5 = Normal ****\n6 = ***\n7 = **\n8 = Low *"); $oF->Label(-text => "Rating/Urgency", -bg => $config{ColorBG}, -width => 15, -anchor => 'w')->pack(-side => "left", -anchor => 'w', -padx => 2, -pady => 2); $oF->Optionmenu(-variable => \${$iptc->{Urgency}}[0], -textvariable => \${$iptc->{Urgency}}[0], -options => [0,1,2,3,4,5,6,7,8])->pack(-side => "left", -anchor => 'w', -padx => 0); push @tag_list, 'Urgency'; # add already displayed elements to the list if ($config{IPTCProfessional}) { ####### Writer/Editor and Credit ############# labeledDoubleEntry($aF, 'top', $w, 'Writer/Editor', 'Credit', \${$iptc->{'Writer/Editor'}}[0], formatString("Writer/Editor:\n".$iptcHelp{'Writer/Editor'}, 80, -1), \${$iptc->{'Credit'}}[0], formatString("Credit:\n".$iptcHelp{'Credit'}, 80, -1)); push @tag_list, ('Writer/Editor', 'Credit'); # add already displayed elements to the list } ####### BylineTitle and Byline ############# # !!! todo byline and bylinetitle are repeatable use e.g. .= "$_, " for @{$iptc->{$_}}; labeledDoubleEntry($aF, 'top', $w, 'ByLineTitle', 'Name', \${$iptc->{ByLineTitle}}[0], formatString("ByLineTitle:\n".$iptcHelp{'ByLineTitle'}, 80, -1), \${$iptc->{ByLine}}[0], formatString("ByLine:\n".$iptcHelp{'ByLine'}, 80, -1)); push @tag_list, ('ByLineTitle', 'ByLine'); # add already displayed elements to the list ####### EditStatus etc. ############## if ($config{IPTCProfessional}) { @alist = ('EditStatus', 'SpecialInstructions', 'Contact', 'Source', 'CopyrightNotice'); foreach (@alist) { $ent = labeledEntry($aF,'top',$w,$_,\${$iptc->{$_}}[0]); if (defined $iptcHelp{$_}) { # todo this cuts very long desc because of config{LineLimit} $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)) if (Exists $ent); } } push @tag_list, @alist; # add already displayed elements to the list } ####### Location ############## my $locF = $aF->Frame(-relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x'); $locF->Label(-text => 'Location')->pack(-anchor => 'w', -padx => 2, -pady => 2); $ent = labeledEntry($locF,'top',$w,'SubLocation',\${$iptc->{'SubLocation'}}[0]); if (defined $iptcHelp{'SubLocation'}) { # todo this cuts very long desc because of config{LineLimit} $balloon->attach($ent, -msg => formatString("SubLocation:\n".$iptcHelp{'SubLocation'}, 80, -1)) if (Exists $ent); } labeledDoubleEntry($locF, 'top', $w, 'City', 'Province/State', \${$iptc->{'City'}}[0], formatString("City:\n".$iptcHelp{'City'}, 80, -1), \${$iptc->{'Province/State'}}[0], formatString("Province/State:\n".$iptcHelp{'Province/State'}, 80, -1)); labeledDoubleEntry($locF, 'top', $w, 'Country', 'Code', \${$iptc->{'Country/PrimaryLocationName'}}[0], formatString("Country/PrimaryLocationName:\n".$iptcHelp{'Country/PrimaryLocationName'}, 80, -1), \${$iptc->{'Country/PrimaryLocationCode'}}[0], formatString("Country/PrimaryLocationCode:\n".$iptcHelp{'Country/PrimaryLocationCode'}, 80, -1)); push @tag_list, ('SubLocation', 'City', 'Province/State', 'Country/PrimaryLocationName', 'Country/PrimaryLocationCode'); ####### Date and Time ############ if ($config{IPTCProfessional}) { @alist = ('ReleaseDate', 'ReleaseTime', 'DateCreated', 'TimeCreated'); my $dateF = $aF->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-anchor=>'w', -padx => 3, -pady => 3, -fill => 'x'); $dateF->Label(-text => 'Date and time')->pack(-anchor => 'w', -padx => 2, -pady => 2); labeledDoubleEntry($dateF, 'top', $w, 'Date created', 'Time', \${$iptc->{DateCreated}}[0], formatString("DateCreated:\n".$iptcHelp{'DateCreated'}, 80, -1), \${$iptc->{TimeCreated}}[0], formatString("TimeCreated:\n".$iptcHelp{'TimeCreated'}, 80, -1)); labeledDoubleEntry($dateF, 'top', $w, 'Date released', 'Time', \${$iptc->{ReleaseDate}}[0], formatString("ReleaseDate:\n".$iptcHelp{'ReleaseDate'}, 80, -1), \${$iptc->{ReleaseTime}}[0], formatString("ReleaseTime:\n".$iptcHelp{'ReleaseTime'}, 80, -1)); push @tag_list, @alist; # add already displayed elements to the list } ####### Keywords ############ my $keyword_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0); # get the keywords (list ref) doubleList($keyword_frame, \@prekeys, \@{$iptc->{Keywords}}, 'keywords'); push @tag_list, 'Keywords'; ####### Categories ########## my $category_frame; if ($config{IPTCProfessional} == 1) { $category_frame = $bF->Frame(-bd => 0)->pack(-expand => 1, -fill => 'both', -padx => 0, -pady => 0); $ent = labeledEntry($category_frame,'top',$w,'Category',\${$iptc->{Category}}[0]); if (defined $iptcHelp{Category}) { $balloon->attach($ent, -msg => formatString("Category:\n".$iptcHelp{Category}, 80, -1)); # todo } # supp categories ### doubleList($category_frame, \@precats, \@{$iptc->{SupplementalCategory}}, 'supplemental categories'); push @tag_list, ('Category', 'SupplementalCategory'); } ####### Misc ################# my $p = $bN->Scrolled("Pane", -scrollbars => "oe", -height => 300)->pack(-fill => "both", -expand => "1"); # build a frame, a label and an entry for every tag which is not yet displayed foreach (@IPTCAttributes) { next if (isInList($_, \@tag_list)); $ent = labeledEntry($p,'top',40,$_,\${$iptc->{$_}}[0]); if (defined $iptcHelp{$_}) { $balloon->attach($ent, -msg => formatString($_.":\n".$iptcHelp{$_}, 80, -1)); # todo } } ###### bottom frame my $exf = $t->Frame()->pack(-anchor=>'w'); #my $exf2 = $t->Frame()->pack(-anchor=>'w'); my $edb = $exf->Checkbutton(-variable => \$config{IPTCdateEXIF}, -text => "EXIF date -> creation date ")->pack(-anchor => 'w', -side => 'left'); $balloon->attach($edb, -msg => 'This option will copy EXIF date, to the IPTC date created tag.'); my $etb = $exf->Checkbutton(-variable => \$config{IPTCtimeEXIF}, -text => "EXIF time -> creation time ")->pack(-anchor => 'w', -side => 'left'); $balloon->attach($etb, -msg => 'This option will copy EXIF time, to the IPTC time created tag.'); my $IbEo = $exf->Checkbutton(-variable => \$config{IPTCbylineEXIF}, -text => "EXIF owner -> ByLine ")->pack(-anchor => 'w', -side => 'left'); $balloon->attach($IbEo, -msg => 'This option will copy the content of EXIF Owner, or if not available the content of EXIF Artist, or if not available the content of EXIF UserComment to the IPTC ByLine tag.'); my $IMap = $exf->Checkbutton(-variable => \$config{IPTCaddMapivi}, -text => "Add Mapivi infos")->pack(-anchor => 'w', -side => 'left'); $balloon->attach($IMap, -msg => 'This option will insert Mapivi in the IPTC OriginatingProgram tag and the actual Mapivi version into the ProgramVersion tag.'); my $optF = $cN->Frame()->pack(); $optF->Label(-text => 'IPTC dialog layout')->pack(-anchor => 'w'); $optF->Radiobutton(-text => 'Simple', -variable => \$config{IPTCProfessional}, -value => 0)->pack(-anchor => 'w'); $optF->Radiobutton(-text => 'Professional without Category', -variable => \$config{IPTCProfessional}, -value => 2)->pack(-anchor => 'w'); $optF->Radiobutton(-text => 'Professional with Category', -variable => \$config{IPTCProfessional}, -value => 1)->pack(-anchor => 'w'); $cN->Label(-text => 'Note: According to the IPTC standard Categories are deprecated.')->pack(); $cN->Label(-text => 'Please choose IPTC dialog layout, close dialog and open it again to see changes.')->pack(); my $f = $t->Frame()->pack(-anchor=>'w',-fill => 'x', -expand => 0); # edit mode buttons only for more than one pictures if ($nr > 1) { my $rf = $f->Frame()->pack(-side => 'left', -anchor=>'w', -fill => 'x', -expand => 0); my $radioB = $rf->Label(-text => 'Edit mode')->pack(-side => 'left', -anchor => 'w'); $rf->Radiobutton(-text => 'Add', -variable => \$config{IPTC_action}, -value => 'ADD')->pack(-side => 'left', -anchor => 'w'); $rf->Radiobutton(-text => 'Update', -variable => \$config{IPTC_action}, -value => 'UPDATE')->pack(-side => 'left', -anchor => 'w'); $rf->Radiobutton(-text => 'Replace', -variable => \$config{IPTC_action}, -value => 'REPLACE')->pack(-side => 'left', -anchor => 'w'); $balloon->attach($rf, -msg => 'Add: new records are added and nothing is deleted; however, if you try to add a non-repeatable record which is already present, the newly supplied value ejects (replaces) the pre-existing value. Update: new records replace those characterised by the same tags, but the others are preserved. This makes it possible to modify some repeatable IPTC records without deleting the other tags. Replace: all records present in the IPTC sub folder are deleted before inserting the new ones.'); } my $okb = $f->Button(-text => 'OK', -command => sub { # get the caption ${$iptc->{'Caption/Abstract'}}[0] = $caption->get(0.1, 'end'); ${$iptc->{'Caption/Abstract'}}[0] =~ s/\s+$//; # remove trailing whitespace $config{IPTCLastPad} = $notebook->raised(); if (Exists $keyword_frame) { saveTreeMode($keyword_frame->{m_tree}); # todo nstore($keyword_frame->{m_tree}->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; } if (Exists $category_frame) { saveTreeMode($category_frame->{m_tree}); # todo nstore($category_frame->{m_tree}->{m_mode}, "$configdir/categoryMode") or warn "could not store $configdir/categoryMode: $!"; } $t->destroy; # close window $rc = 'OK'; } )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 3, -pady => 3); $balloon->attach($okb, -msg => "You can press Control-x to close the dialog (like OK button)"); $t->bind('', sub { $okb->invoke; }); my $Xbut = $f->Button(-text => 'Cancel', -command => sub { $config{IPTCLastPad} = $notebook->raised(); $t->destroy; # close window $rc = 'Cancel'; } )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 3, -pady => 3); $balloon->attach($Xbut, -msg => "You can press ESC to close the dialog (like Cancel button)"); $t->bind('', sub { $Xbut->invoke; }); $t->waitWindow; return $rc; } ############################################################## # cleanList - remove empty elements from a list reference ############################################################## sub cleanList { my $listRef = shift; if (ref($listRef) ne 'ARRAY') { warn "cleanList: $listRef is no an array ref!"; return; } my @list; foreach (@$listRef) { push @list, $_ if ($_ ne ""); } $listRef = \@list; } ############################################################## # doubleList - mega widget containing two listboxes, a entry # and some buttons ############################################################## sub doubleList($$$$) { my $widget = shift; # mother widget my $l1 = shift; # predefined list ref my $l2 = shift; # real list ref my $name = shift; # build a frame for the keywords/categories my $f = $widget->Frame(-bd => $config{Borderwidth}, -relief => 'raised')->pack(-expand => 1, -fill => 'both', -anchor=>'w', -padx => 3, -pady => 3); $f->Label(-text => $name, -bg => $config{ColorBG})->pack(-anchor=>'w', -padx => 2, -pady => 2); my $fc1 = $f->Frame()->pack(-expand => 1, -fill => "both", -side => "left", -anchor=>"n"); my $fc2 = $f->Frame()->pack(-expand => 0, -fill => 'x', -side => "left", -anchor=>"n"); my $fc3 = $f->Frame()->pack(-expand => 1, -fill => "both", -side => "left", -anchor=>"n"); $fc1->Label(-text => "common tags", -bg => $config{ColorBG})->pack(-anchor=>'w', -padx => 2, -pady => 2); my $catLB2; my $category = ""; my $fcent = $fc1->Entry(-textvariable => \$category, -width => 20)->pack(-fill => 'x', -padx => 2, -pady => 2); $fcent->bind('', sub { return if ($category eq ""); # check if keyword/category is allready in list return if isInList($category, $l2); push @$l2, $category; $category = ""; @$l2 = sort { uc($a) cmp uc($b) } @$l2; $catLB2->delete(0, 'end'); $catLB2->insert('end', @$l2); }); my $tree = $fc1->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 26, -height => 14, )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2); $widget->{m_tree} = $tree; bindMouseWheel($tree->Subwidget("scrolled")); $balloon->attach($tree, -msg => "Double click on a item to insert it.\nIt's possible to edit the items, use the\nright mouse button to open the edit menu."); # try to get the saved mode my $modeRef; if ($name eq 'keywords' and -f "$configdir/keywordMode") { $modeRef = retrieve("$configdir/keywordMode"); } if ($name eq 'supplemental categories' and -f "$configdir/categoryMode") { $modeRef = retrieve("$configdir/categoryMode"); } $tree->{m_mode} = $modeRef if (defined $modeRef); addTreeMenu($tree, $l1); insertTreeList($tree, @$l1); # $tree->bind("", sub { # my @keys = $keytree->info('selection'); # return unless checkSelection($myDiag, 1, 0, \@keys); # $entry->insert("insert", getLastItem($keys[0])." "); # }); $fc2->Label(-text => "command", -bg => $config{ColorBG})->pack(-expand => 0, -anchor=>'w', -padx => 2, -pady => 2); my $all = 0; my $all_ref = \$all; $all_ref = \$config{CategoriesAll} if ($name eq 'supplemental categories'); $all_ref = \$config{KeywordsAll} if ($name eq 'keywords'); my $addB = $fc2->Button(-text => "add", -command => sub { my @keys = $tree->info('selection'); return unless checkSelection($widget, 1, 0, \@keys); my @keylist; my $warning = ''; my @items; foreach my $key (@keys) { if ($$all_ref == 1) { # all, separated push @items, getAllItems($key); } elsif ($$all_ref == 2) { # all, joined my $joined = join('.', getAllItems($key)); if (length($joined) > 64) { $warning .= "Keyword $joined has ".length($joined)." characters"; next; } push @items, $joined; } elsif ($$all_ref == 0) { # last push @items, getLastItem($key); }else { warn "doubleList: should never be reached!"; } } foreach my $item (@items) { next if isInList($item, $l2); # make @$l2 unique push @$l2, $item; # by adding just new items @$l2 = sort { uc($a) cmp uc($b) } @$l2; # sort alphabetical $catLB2->delete(0, 'end'); $catLB2->insert('end', @$l2); } } )->pack(-expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($addB, -msg => "Add the selected items to the picture"); my $fc2a = $fc2->Frame()->pack(); $fc2a->Radiobutton(-text => "all", -variable => $all_ref, -value => 1)->pack(-anchor => 'w'); $fc2a->Radiobutton(-text => "join", -variable => $all_ref, -value => 2)->pack(-anchor => 'w'); $fc2a->Radiobutton(-text => "last", -variable => $all_ref, -value => 0)->pack(-anchor => 'w'); $balloon->attach($fc2a, -msg => "$name add mode\nExample $name: Friend/Bundy/Kelly\nmode all: three $name: Friend, Bundy and Kelly\nmode join: one $name: Friend.Bundy.Kelly\nmode last: one $name: Kelly"); my $rmB = $fc2->Button(-text => "remove", -command => sub { my @sellist = $catLB2->curselection(); if (@sellist < 1) { print "nothing selected\n" if $verbose; return; } # delete the selected elements in reverse order foreach (reverse @sellist) { splice @$l2, $_, 1; } $catLB2->delete(0, 'end'); $catLB2->insert('end', @$l2); })->pack(-expand => 0, -fill => 'x', -padx => 1, -pady => 1); $balloon->attach($rmB, -msg => "Remove the selected items from the picture"); $tree->bind('', sub { $addB->invoke(); } ); $fc3->Label(-text => "tags of picture", -bg => $config{ColorBG})->pack(-anchor=>'w'); $catLB2 = $fc3->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 25, -height => 14, )->pack(-expand => 1, -fill =>'both', -padx => 2, -pady => 2); bindMouseWheel($catLB2->Subwidget("scrolled")); $catLB2->insert('end', @$l2); $catLB2->bind('', sub { $rmB->invoke(); } ); } ############################################################## # removeAllComments ############################################################## sub removeAllComments { my $ask = shift; unless ($ask == ASK or $ask == NO_ASK) { warn "removeAllComments called with wrong argument: $ask"; return; } my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirthumb, $dirtpic, $i, $com); if ($ask == ASK) { my $rc = $top->messageBox(-icon => 'question', -message => "Ok to remove all comments of $selected selected pictures?\nThere is no undo!", -title => "Remove all comments?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } $userinfo = "removing comments ..."; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Remove all comments"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "removing all comments ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $meta = getMetaData($dpic, "COM"); next unless ($meta); $meta->remove_all_comments(); unless ($meta->save()) { warn "removeAllComments: save $pic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! (removed comments in $i of $selected pictures)"; $userInfoL->update; } ############################################################## # editComment ############################################################## sub editComment { my $lb = shift; # the reference to the listbox widget to update my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirthumb, $dirtpic, $com); $userinfo = "editing comments from $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($lb, @sellist)); my $pw = progressWinInit($lb, "Edit comments"); my $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "editing comment ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my @comsellist = (); my $text = ""; my @comments = getComments($dpic); if (@comments <= 0) { next; # no comment -> no edit } elsif (@comments == 1) { $text = $comments[0]; # one comment -> select the first $comsellist[0] = 0; } else { # more than one comment, let the user select one comment to edit my $nr = @comments; my @shortComments; foreach (@comments) { push @shortComments, cutString($_, 80, "..."); } next if (!mySelListBoxDialog("Edit comment of $pic", "Please select one of the $nr comments to edit", SINGLE, "Edit", \@comsellist, @shortComments)); if (@comsellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select just one comment.", -title => "Wrong selection", -type => 'OK'); next; } $text = $comments[$comsellist[0]]; } my $rc = myTextDialog("Edit comment", "Please edit comment of $pic", \$text, $dirthumb); next if ($rc ne 'OK'); # replace (german) umlaute by corresponding letters $text =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $config{Comment} = $text; # save changed comment to global config hash my $meta = getMetaData($dpic, "COM"); next unless ($meta); $meta->set_comment($comsellist[0], $text); unless ($meta->save()) { warn "editComment: save $pic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $lb); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected edited)"; $userInfoL->update; } ############################################################## # joinComments ############################################################## sub joinComments { my $ask = shift; unless ($ask == ASK or $ask == NO_ASK) { warn "joinComments called with wrong argument: $ask"; return; } my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($pic, $dpic, $dirthumb, $meta, $com, $nr); my $separator = "\n"; if ($ask == ASK) { my $rc = myButtonDialog('Join comments?', "Ok to join all comments to one comment in each of the ".scalar @sellist." selected pictures?\n\n(Some programms are only able to display the fist comment of a JPEG picture.\nPictures with no or just one comment will be skipped.)\nPlease choose the desired separator when joining the comments.", undef, 'Space', 'Newline', 'Nothing', 'Cancel'); return if ($rc =~ m/Cancel/i); $separator = ' ' if ($rc =~ m/Space/i); $separator = '' if ($rc =~ m/Nothing/i); } $userinfo = "joining comments from ".scalar @sellist." pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Join comments"); my $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "joining comments ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); $meta = getMetaData($dpic, "COM"); next unless ($meta); $nr = $meta->get_number_of_comments(); next if ($nr <= 1); # no or just one comment -> no join $com = getComments($dpic, 0); if ((defined $com) and (length $com > $maxCommentLength)) { # a JPEG comment may have max 64kB my $rc = $top->messageBox(-icon => 'warning', -message => "The joined comments of $dpic are too long (".length $com." characters).\nJPEG-Comments may only be up to 64K.\nOK will skip this picture, Cancel will abort the operation.", -title => "Comment to big", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); next; } # join comments with configurable separator string $meta->join_comments($separator); unless ($meta->save()) { warn "editComment: save $pic failed!"; } # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); } progressWinEnd($pw); $userinfo = "ready! ($i of ".scalar @sellist." joined)"; $userInfoL->update; } ############################################################## # checkTempFile - check if temp file exists # returns 0 if it exists # return s1 if not ############################################################## sub checkTempFile($) { my $tmpfile = shift; if (-f $tmpfile) { $top->messageBox(-icon => 'warning', -message => "Temporary file $tmpfile already exists. Skipping!", -title => 'Error', -type => 'OK'); return 0; } return 1; } ############################################################## # removeComment - remove a JPEG comment from a picture # if there is more than one comment in the # picture the user can # choose which to delete # if the same comment is selected in two pics # we ask, if we should delete this one in all ############################################################## sub removeComment { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my $doForAll = 0; my ($pic, $dpic, $dirthumb, $meta, $com, @removedComments); $userinfo = "removing comments from $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Remove comments"); my $i = 0; my $j = 0; # the real number of changed pictures foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "removing comment ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); next if (!checkWriteable($dpic)); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my @comments = getComments($dpic); next if (@comments <= 0); # let the user select the comments to delete my @comsellist = (); # normal modus - let the user select what to remove if (!$doForAll) { my @shortComments; foreach (@comments) { push @shortComments, cutString($_, 80, "..."); } next if (!mySelListBoxDialog("Remove comments", "Please select comment(s) to remove from $pic", MULTIPLE, "Remove", \@comsellist, @shortComments)); } # comment remove wizard mode :) - we choose the right comment to delete else { for (0 .. $#comments) { # search in all comments if ($comments[$_] eq $removedComments[-1]) { # for the magic comment $comsellist[0] = $_; # remember the index last; } } } if ( (@comsellist == 1) and ($doForAll == 0) ) { # if just one comment is removed push @removedComments, $comments[$comsellist[0]]; # remember the removed comments if (@removedComments >= 2) { # when we collected at least two ... if ($removedComments[-1] eq $removedComments[-2]) { # and they are the same ... if ($i < @sellist) { # and there is still some work to be done ... my $com = $removedComments[-1]; $com = substr($com, 0, 100)."..." if (length($com) > 103); my $rc = $top->messageBox(-icon => 'question', -message => "You've selected the same comment two times. Should I remove this comment:\n-------------\n$com\n-------------\nfrom the rest (".(@sellist - $i).") of the selected pictures?", -title => "Comment remove wizard", -type => 'OKCancel'); $doForAll = 1 if ($rc =~ m/Ok/i); } } } } # this can only happen in wizard mode (for pictures not containing the comment to remove) next if (@comsellist == 0); $meta = getMetaData($dpic, "COM"); next unless ($meta); # delete the selected elements in reverse order, the unselected stay in the @comments foreach (reverse @comsellist) { $meta->remove_comment($_); } unless ($meta->save()) { warn "editComment: save $pic failed!"; } $j++; # count the modified pics # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch ($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! (removed comments in $j of $selected pictures)"; $userInfoL->update; } ############################################################## # rotate - rotate all selected pictures by 90, 180 or 270 # degrees or do a flip transformation ############################################################## sub rotate { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirtpic, $i); return if (!checkExternProgs("rotate", "jpegtran")); my $deg = shift; # 90, 180, 270, auto, clear, norot, horizontal or vertical my $mode = 0; if ($deg eq "auto") { $mode = 1; return if (!checkExternProgs("auto rotate", "jhead")); my $usage = `jhead -h 2>&1`; if ($usage !~ m/.*-autorot.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jhead does not support automatic rotation!\nTry to get a newer version at: ".$exprogsres{jhead}, -title => "Wrong jhead version", -type => 'OK'); return; } } elsif ($deg eq "clear") { $mode = 2; return if (!checkExternProgs("auto rotate", "jhead")); my $usage = `jhead -h 2>&1`; if ($usage !~ m/.*-norot.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jhead does not support the clearing of the rotation tag!\nTry to get a newer version at: ".$exprogsres{jhead}, -title => "Wrong jhead version", -type => 'OK'); return; } } else { $mode = 0; } my $transform = "-rotate $deg"; if (($deg eq "horizontal") or ($deg eq "vertical")) { $transform = "-flip $deg"; } my $errors = ""; my $trim = ""; $trim = "-trim " if $config{jpegtranTrim}; $userinfo = "rotating $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "rotate pictures"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; $pic = basename($dpic); $dirtpic = dirname($dpic)."/$pic"."-cjpg"; # temporary file next if (!checkWriteable($dpic)); # check if temp file exists next if (!checkTempFile($dirtpic)); my $command = ""; if ($mode == 1) { # auto if (is_a_JPEG($dpic)) { # call external command jhead and auto rotate the file directly $command = "jhead -autorot \"$dpic\" "; } else { $errors .= "auto rotation is only supported for JPEGs ($dpic)\n"; } } elsif ($mode == 2) { # clear if (is_a_JPEG($dpic)) { # call external command jhead and clear the rotation flag of the file directly $command = "jhead -norot \"$dpic\" "; } else { $errors .= "clear rotation is only supported for JPEGs ($dpic)\n"; } } else { if (is_a_JPEG($dpic)) { # call external command jpegtran and rotate to the temp file $command = "jpegtran -copy all $transform $trim -outfile \"$dirtpic\" \"$dpic\" "; } else { $transform = "-rotate $deg"; if ($deg eq "horizontal") { $transform = "-flip"; } if ($deg eq "vertical") { $transform = "-flop"; } $command = "mogrify $transform \"$dpic\" "; } } next if ($command eq ""); execute($command); progressWinUpdate($pw, "rotating ($i/$selected) ...", $i, $selected); # now overwrite the original pic with the temp file and delete the temp file # (not needed for jhead and mogrify) # todo rotate also thumbs of autorotated pics (but how?) if (($mode == 0) and (is_a_JPEG($dpic))) { rotateThumb("$dirtpic", $transform) if ($config{RotateThumb}); next if (!overwrite("$dpic", "$dirtpic")); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); reselect($picLB, @sellist); $userinfo = "ready! ($i of $selected rotated)"; $userInfoL->update; showText("Errors while rotating pictures", $errors, NO_WAIT) if ($errors ne ""); generateThumbs(ASK, SHOW); } ############################################################## # rotateThumb ############################################################## sub rotateThumb { my $dpic = shift; my $pic = basename($dpic); my $tmppic = "$trashdir/$pic"; my $tmppic2 = "$trashdir/$pic.tcjpeg"; my $transform = shift; print "rotateThumb: $pic $transform\n" if $verbose; my $errors = ""; extractThumb($dpic, $tmppic, \$errors); return unless (-f $tmppic); # there is no EXIF thumbnail my $trim = ""; $trim = "-trim " if $config{jpegtranTrim}; my $command = "jpegtran -copy all $transform $trim -outfile \"$tmppic2\" \"$tmppic\" "; execute($command); removeFile($tmppic); writeThumb($dpic, $tmppic2); removeFile($tmppic2); } ############################################################## # extractThumb ############################################################## sub extractThumb { my $dpic = shift; # picture file with path my $dthumb = shift; # thumbnail file with path (will be overwritten!) my $errors = shift; # reference to error text scalar my $meta = getMetaData($dpic, 'APP1'); if ($meta) { my $thumbData = $meta->get_Exif_data('THUMBNAIL'); if ($thumbData and ($$thumbData ne "")) { my $thumb = new Image::MetaData::JPEG($thumbData); if ($thumb) { unless ($thumb->save($dthumb)) { $errors .= "Couldn't save $dthumb"; } } else { $errors .= "Couldn't create thumb $dpic\n"; } } else { $$errors .= "No EXIF thumbnail in $dpic\n"; } } else { $$errors .= "No EXIF data in $dpic\n"; } } ############################################################## # writeThumb - returns 1 if OK, else an error string ############################################################## sub writeThumb { my $dpic = shift; # the picture file with path to which the thumb will be written my $dthumb = shift; # the thumbnail file name with path my $error = 1; my $image = new Image::MetaData::JPEG($dpic, 'APP1'); return "Could not read meta data of $dpic" unless ($image); my $thimage = new Image::MetaData::JPEG($dthumb); return "Could not read meta data of $dthumb" unless ($thimage); my $data = "dummy"; unless ($thimage->save(\$data)) { return "Could not build thumbnail for $dthumb"; } my $hash = $image->set_Exif_data(\$data, 'THUMBNAIL'); return "JPEG thumbnail rejected for $dpic" if (keys %$hash); my $result = $image->save(); return "save failed for $dpic" unless ($result); return 1; } ############################################################## # copyThumbnail ############################################################## sub copyThumbnail { my @sellist = $picLB->info('selection'); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb); return unless checkSelection($top, 1, 0, \@sellist); if ((!defined $copyEXIFDataSource) or (!-f $copyEXIFDataSource)) { $top->messageBox(-icon => 'warning', -message => 'Please select a source picture first. This picture will be used as thumbnail, you may use "Save thumbnail ..." first. Than choose EXIF info->copy from!', -title => 'No source picture', -type => 'OK'); return; } my $size = getFileSize($copyEXIFDataSource, NO_FORMAT); # file size in bytes if ($size > 65535) { $top->messageBox(-icon => 'warning', -message => "Sorry, the thumbnail picture is too big ($size bytes). The thumbnail picture must have less than 65535 bytes.", -title => "Thumbnail too big", -type => 'OK'); return; } my $message = "Copy this thumbnail from\ \"".basename($copyEXIFDataSource)."\"\ to $selected selected pictures.\ The original thumbnails of these pictures will be lost!\ Ok to continue?"; my $rc = myButtonDialog("Copy EXIF data", "$message", $copyEXIFDataSource, 'OK', 'Cancel'); return if ($rc ne 'OK'); $userinfo = "transfering thumbnail to $selected pictures"; $userInfoL->update; my $errors = ""; $i = 0; my $pw = progressWinInit($top, "Copy thumbnail"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "transfering thumbnail ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $rc = writeThumb($dpic, $copyEXIFDataSource); $errors .= "$rc\n" if ($rc ne '1'); updateOneRow($dpic, $picLB); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); } progressWinEnd($pw); $userinfo = "ready! ($i/$selected thumbnails transfered)"; $userInfoL->update; showText("Errors while transfering thumbnails", $errors, NO_WAIT) if ($errors ne ""); } ############################################################## # buildEXIFThumb ############################################################## sub buildEXIFThumb { my $rc = $top->messageBox(-icon => "question", -message => "This function will (re)build the embedded EXIF thumbnail of the selected pictures.\nThe original EXIF thumnail (if existent) will be overwritten!\nOk to continue?", -title => "(Re)Build EXIF thumbnail", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); my @sellist = $picLB->info('selection'); my $selected = @sellist; my ($pic, $dpic, $i, $dirthumb, $thumb); return unless checkSelection($top, 1, 0, \@sellist); $userinfo = "(re)building EXIF thumbnail in $selected pictures"; $userInfoL->update; $i = 0; my $pw = progressWinInit($top, "(Re)build EXIF thumbnail"); foreach $dpic (@sellist) { last if progressWinCheck($pw); progressWinUpdate($pw, "(Re)building EXIF thumbnail ($i/$selected) ...", $i, $selected); $i++; $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); $thumb = "$trashdir/$pic-exifthumb"; if (-f $thumb) { warn "the temp file $thumb exists - skipping!"; next; } # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); my $command = "convert -size 160x160 -geometry 160x160 -quality 75 -sharpen 0.4 -filter Lanczos \"$dpic\" \"$thumb\""; $top->Busy; execute($command); $top->Unbusy; if (!-f $thumb) { warn "file $thumb not generated - skipping!"; next; } my $errors; removeEXIF($thumb, 'all', \$errors); my $size = getFileSize($thumb, NO_FORMAT); # file size in bytes if ($size > 65535) { $top->messageBox(-icon => 'warning', -message => "Sorry, builded EXIF thumbnail picture is too big ($size bytes). The thumbnail picture must have less than 65535 bytes.\nSkipping picture ...", -title => "Thumbnail too big", -type => 'OK'); next; } writeThumb($dpic, $thumb); removeFile($thumb); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time touch($dirthumb); updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); $userinfo = "ready! ($i/$selected EXIF thumbnails (re)builded)"; $userInfoL->update; } ############################################################## # reselect - selects the index in the given list, if they exist # and shows the selection information in the status # bar ############################################################## sub reselect { my $lb = shift; foreach (@_) { $lb->selectionSet($_) if ($lb->info("exists", $_)); } showNrOf() if ($lb == $picLB); } ############################################################## # rotateAny - rotate all selected pictures in any angle ############################################################## sub rotateAny { return if (!checkExternProgs("rotateAny", "mogrify")); my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($dpic, $i, $command); $userinfo = "rotating $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $doforall = 0; my $degree = 0; my $color = "gray30"; my $pw = progressWinInit($top, "Rotate pictures"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; if (!$doforall) { last if (!rotateDialog(\$degree, \$color, \$doforall, $dpic, $selected)); } progressWinUpdate($pw, "rotating ($i/$selected) ...", $i, $selected); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); $command = "mogrify -rotate $degree -bordercolor \"$color\" -background \"$color\" -quality $config{PicQuality} "; $command .= "-unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if $config{Unsharp}; $command .= "\"$dpic\" "; print "$command\n" if $verbose; execute($command); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); reselect($picLB, @sellist); $userinfo = "ready! ($i of $selected rotated)"; $userInfoL->update; generateThumbs(ASK, SHOW); } my $rotw; ############################################################## # rotateDialog ############################################################## sub rotateDialog { my $deg = shift; # reference my $col = shift; # reference my $doforall = shift; # reference my $pic = shift; # the preview pic my $nr = shift; # the number of pics my $preview_size = 400; if (Exists($rotw)) { $rotw->deiconify; $rotw->raise; return; } my $orig = "$trashdir/".basename($pic); my $new = "$trashdir/x-".basename($orig); unless (mycopy($pic, $orig, OVERWRITE)) { warn "rotateDialog: copy error $pic -> $orig ($new)\ncopy"; return 0; } my ($w, $h) = getSize($orig); if ($w > $preview_size or $h > $preview_size) { $userinfo = "rotate: resizing preview picture ..."; $userInfoL->update; my $command = "mogrify -geometry ${preview_size}x${preview_size} -quality 80 \"$orig\""; $top->Busy; execute($command); $top->Unbusy; $userinfo = "ready!"; $userInfoL->update; } return 0 unless (-f $orig); # open window $rotw = $top->Toplevel(); $rotw->title("Rotate picture"); $rotw->iconimage($mapiviicon) if $mapiviicon; my $rc = 0; my $preview = $rotw->Photo(-file => "$orig", -gamma => $config{Gamma}) if (-f $orig); my $fc = $rotw->Frame()->pack(); my $prevC = $fc->Scrolled("Canvas", -scrollbars => 'osoe', -width => $preview_size, -height => $preview_size, -relief => 'sunken', -bd => $config{Borderwidth})->pack(-side => "left", -padx => 3, -pady => 3,-anchor => 'w') if $preview; my $horizont = 0; my $vertical = 0; $fc->Scale(-variable => \$horizont, -length => $preview_size, -from => 0, -to => $preview_size, -resolution => 1, -sliderlength => 10, -orient => 'vertical', -width => 10, -bd => 1, -showvalue => 0, -relief => 'groove', -command => sub { drawHorizont($prevC, $horizont, $vertical); } )->pack(-side => "left", -padx => 3,-pady => 3); $rotw->Scale(-variable => \$vertical, -length => $preview_size, -from => 0, -to => $preview_size, -resolution => 1, -sliderlength => 10, -orient => 'horizontal', -width => 10, -bd => 1, -showvalue => 0, -relief => 'groove', -command => sub { drawHorizont($prevC, $horizont, $vertical); } )->pack(-anchor => 'w', -padx => 3,-pady => 3); $prevC->createImage(0, 0, -image => $preview, -tag => "image", -anchor => "nw"); my $f1 = $rotw->Frame()->pack(-anchor => 'w'); my $auto = 0; $f1->Checkbutton(-text => "auto update", -variable => \$auto)->pack(-side => "left", -expand => 1, -fill => 'x'); $f1->Button(-text => "--", -command => sub { $$deg--; rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto; })->pack(-side => "left", -expand => 1, -fill => 'x'); $f1->Button(-text => "-", -command => sub { $$deg -= 0.1; rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto; })->pack(-side => "left", -expand => 1, -fill => 'x'); $f1->Label(-textvariable => $deg, -relief => "sunken", -width => 5)->pack(-side => "left", ); $f1->Button(-text => "+", -command => sub { $$deg += 0.1; rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto; })->pack(-side => "left", -expand => 1, -fill => 'x'); $f1->Button(-text => "++", -command => sub { $$deg++; rotUpdate($prevC, $preview, $orig, $new, $deg, $col) if $auto; })->pack(-side => "left", -expand => 1, -fill => 'x'); labeledScale($rotw, 'top', 26, "Angle (degrees, clockwise)", $deg, 0, 359.9, 0.1); my $qS = labeledScale($rotw, 'top', 26, "Quality (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); labeledEntryColor($rotw,'top',26,"Background color",'Set',$col); # check, if a new version of ImageMagick's mogrify with the unsharp option is available my $unsharp = 0; $unsharp = 1 if (`mogrify` =~ m/.*-unsharp.*/); # sharpen the image with an unsharp mask operator if ($unsharp) { my $umF = $rotw->Frame()->pack(-fill =>'x'); my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp}, -anchor => 'w', -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $balloon->attach($umcB, -msg => "The -unsharp option sharpens an image. We convolve the image with a Gaussian operator of the given radius and standard deviation (sigma). For reasonable results, radius should be larger than sigma. Use a radius of 0 to have the method select a suitable radius."); $umF->Button(-text => "Options", -anchor => 'w', -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3); } buttonBackup($rotw, 'top'); buttonComment($rotw, 'top'); if ($nr > 1) { $rotw->Checkbutton(-variable => \$$doforall, -anchor => 'w', -text => "use this setting for all pics" )->pack(-anchor => 'w'); } my $ButF = $rotw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 1; $rotw->withdraw(); $rotw->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Preview", -command => sub { rotUpdate($prevC, $preview, $orig, $new, $deg, $col); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3) if $preview; my $XBut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $rotw->withdraw(); $rotw->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $rotw->bind('', sub { $XBut->invoke; }); $rotw->bind('', sub { $XBut->invoke; }); $rotw->Popup; $rotw->waitWindow; $preview->delete; removeFile($orig); removeFile($new); return $rc; } ############################################################## # drawHorizont ############################################################## sub drawHorizont { my $canvas = shift; my $y = shift; # in percent of the canvas height my $x = shift; # in percent of the canvas width $canvas->delete('withtag', 'line'); $canvas->createLine( 0, $y, $canvas->width, $y, -tags => "line", -fill => "black", -dash => [6,4,2,4], ); $canvas->createLine( 0, $y, $canvas->width, $y, -tags => "line", -fill => "white", -dash => [2,6,2,4], ); $canvas->createLine( $x, 0, $x, $canvas->height, -tags => "line", -fill => "black", -dash => [6,4,2,4], ); $canvas->createLine( $x, 0, $x, $canvas->height, -tags => "line", -fill => "white", -dash => [2,6,2,4], ); } ############################################################## # rotUpdate - update the picture in the rotateDialog with the # new degree setting ############################################################## sub rotUpdate { my ($prevC, $preview, $orig, $new, $deg, $col) = @_; return if !mycopy("$orig", "$new", OVERWRITE); $rotw->Busy; # some versions of mogrify need bordercolor, some background so we supply both my $command = "mogrify -rotate $$deg -bordercolor \"$$col\" -background \"$$col\" \"$new\" "; execute($command); $preview->configure(-file => "$new", -gamma => $config{Gamma}); my @ids = $prevC->find('withtag', 'image'); my ($x1, $y1, $x2, $y2) = $prevC->bbox($ids[0]); $prevC->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]); $rotw->Unbusy; } ############################################################## # getRealFile - alters the path and file name to the real file # if it's a link, else do nothing # returns 1 if everything worked, else 0 ############################################################## sub getRealFile($) { my $dirfileR = shift; # reference to a file, which may be a link if (!-f $$dirfileR) { warn "getRealFile: $$dirfileR is no file!"; return 0; } if (-l $$dirfileR) { my $linktargetfile = getLinkTarget($$dirfileR); if ($linktargetfile eq "") { warn "error in getLinkTarget! ($$dirfileR)"; return 0; } else { $$dirfileR = $linktargetfile; return 1; } } else { # no link, change nothing, return true return 1; } } ############################################################## # getLinkTarget - returns the file a link is pointing to # input (folder, link) or (dirlink) where # dirlink consists of folder and link # works with relative and absolute links ############################################################## sub getLinkTarget { my ($dir, $link); if (@_ == 2) { $dir = shift; $link = shift; } elsif (@_ == 1) { $dir = dirname($_[0]); $link = basename($_[0]); } else { warn "getLinkTarget: wrong # of parameters!"; return ""; } # change first to the start dir (to handle relative links) return "" if !changeDir($dir); my $linktargetfile = readlink $link; my $linktargetdir = dirname $linktargetfile; # change to link target, this should now work for relative and absolute links return "" if !changeDir($linktargetdir); # get the current dir my $cwd = cwd(); $linktargetfile = $cwd."/".basename($linktargetfile); return $linktargetfile; } ############################################################## # overwrite - takes two files a and b, deletes a and moves b # to a # the filenames must include the absolute path ############################################################## sub overwrite($$) { my $dpic = shift; my $dirtpic = shift; if (!-f $dirtpic) { warn "overwrite: $dirtpic not created. Giving up!"; return 0; } if (-l $dpic) { my $linktargetfile = getLinkTarget($dpic); $dpic = $linktargetfile; } return 0 if (! removeFile($dpic) ); if (!move ("$dirtpic", "$dpic")) { $top->Dialog(-title => "Move $dirtpic", -text => "Couldn't move $dirtpic to $dpic: $!", -buttons => ["Ok"])->Show(); return 0; } return 1; } ############################################################## # myEntryDialog - get a string from the user # returns 'OK' or 'Cancel' ############################################################## sub myEntryDialog { my $title = shift; my $text = shift; my $varRef = shift; my $thumbnail = shift; # optional my $icon; my $rc = 'Cancel'; # open window my $myDiag = $top->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; my $f = $myDiag->Frame()->pack; if ((defined $thumbnail) and (-f $thumbnail)) { $icon = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma}); if ($icon) { $f->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken", )->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3); } } # determine the heigt of the textbox by counting the number of lines my $height = ($text =~ tr/\n//); $height += 2; $height = 50 if ($height > 50); # not to big, we have scrollbars my $rotext = $f->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 70, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => 0 )->pack(-side => "right", -fill => 'both', -expand => "1", -padx => 3, -pady => 3); $rotext->insert('end', $text); my $OKB; my $entry = $myDiag->Entry(-textvariable => \$$varRef, -width => 40, )->pack(-fill => 'x', -padx => 3, -pady => 3); if ($$varRef =~ /(.*)(\.jp(g|eg))/i) { # if it is a jpeg image name $entry->selectionRange(0,length($1)); # select only the part before the suffix $entry->icursor(length($1)); } else { $entry->selectionRange(0,'end'); # else select all $entry->icursor('end'); } $entry->xview('end'); $entry->bind('', sub { $OKB->invoke; } ); $entry->focus; my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 'OK'; $myDiag->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $XBut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 'Cancel'; $myDiag->destroy; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->bind('', sub { $XBut->invoke; }); $myDiag->Popup; repositionWindow($myDiag); $myDiag->waitWindow(); $icon->delete if $icon; return $rc; } ############################################################## # myFontDialog - dialog to select a font family ############################################################## sub myFontDialog { my $widget = shift; my $title = shift; #my $text = shift; my $varRef = shift; my $size = shift; my $rc = 0; # open window my $myDiag = $widget->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; my $listBox = $myDiag->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'single', -exportselection => 0, -width => 30, #-height => 40, )->pack(-side => 'left', -anchor => 'w', -expand => 1, -fill =>'y', -padx => 3, -pady => 3); my $f = $myDiag->Frame()->pack(-side => 'left', -expand => 1, -anchor => 'w', -fill =>'both'); my @fontFamilies = sort $top->fontFamilies; shift @fontFamilies unless ($fontFamilies[0]); bindMouseWheel($listBox); $listBox->insert('end', @fontFamilies); foreach my $i (0 .. $#fontFamilies) { if ($fontFamilies[$i] eq $$varRef) { $listBox->selectionSet($i); $listBox->see($i); last; } } my $normalText = "This is a preview Text, here you can see how the selected font will look like.\n\nThe brown fox jumps over the brigde.\n\n1 :\n12 :\n123 :\n1234 :\n12345 :\nWWWWWWW:\niiiiiii:\n\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057\040\041\042\043\044\045\046\047\050\051\052\053\054\055\056\057\060\061\062\063\064\065\066\067\070\071\072\073\074\075\076\077\100\n\101\102\103\104\105\106\107\110\111\112\113\114\115\116\117\120\121\122\123\124\125\126\127\130\131\132\133\134\135\136\137\140\141\142\143\144\145\146\147\150\151\152\153\154\155\156\157\160\161\162\163\164\165\166\167\170\171\172\173\174\175\176\n\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\n\260\261\262\263\264\265\266\267\270\271\272\273\274\275\276\277\300\301\302\303\304\305\306\307\310\311\312\313\314\315\316\317\320\321\322\323\324\325\326\327\330\331\332\333\334\335\336\337\n\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357\360\361\362\363\364\365\366\367\370\371\372\373\374\375\376\377"; my $ButF = $f->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $pane = $f->Scrolled('Pane', -bd => $config{Borderwidth}, -relief => 'groove', -scrollbars => 'osoe', -width => 1000)->pack(-expand => 1, -anchor => 'w', -fill => 'both', -padx => 3, -pady => 3); my $example = $pane->Label(-text => $normalText, -bg => $config{ColorBG}, -justify => 'left')->pack(-fill => 'both', -expand => 1, -anchor => 'w'); $listBox->bind('', sub { my @sell = $listBox->curselection(); return unless @sell; my $actfont = $fontFamilies[$sell[0]]; return unless $actfont; $myDiag->Busy; my $font = $top->Font(-family => $actfont, -size => $size); $example->configure(-font => $font); $example->update(); $myDiag->Unbusy; } ); $ButF->Button(-text => 'next', -command => sub { my @sell = $listBox->curselection(); return unless @sell; my $index = $sell[0]; $listBox->selectionClear(0, 'end'); $index++; $index = 0 if ($index >= @fontFamilies); $listBox->selectionSet($index); $listBox->see($index); my $actfont = $fontFamilies[$index]; return unless $actfont; $myDiag->Busy; my $font = $top->Font(-family => $actfont, -size => $size); $example->configure(-font => $font); $example->update(); $myDiag->Unbusy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'previous', -command => sub { my @sell = $listBox->curselection(); return unless @sell; my $index = $sell[0]; $listBox->selectionClear(0, 'end'); $index--; $index = $#fontFamilies if ($index < 0); $listBox->selectionSet($index); $listBox->see($index); my $actfont = $fontFamilies[$index]; return unless $actfont; $myDiag->Busy; my $font = $top->Font(-family => $actfont, -size => $size); $example->configure(-font => $font); $example->update(); $myDiag->Unbusy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { my @sell = $listBox->curselection(); $$varRef = $fontFamilies[$sell[0]] if @sell; $rc = 1; $myDiag->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->bind ('', sub { $OKB->invoke; } ); $listBox->bind('', sub { $OKB->invoke; } ); $OKB->focus; my $XBut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $myDiag->destroy; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->bind('', sub { $XBut->invoke; }); my $ws = 0.5; my $w = int($ws * $myDiag->screenwidth); my $h = int($ws * $myDiag->screenheight); my $x = int(((1 - $ws) * $myDiag->screenwidth)/3); my $y = int(((1 - $ws) * $myDiag->screenheight)/3); #print "geo==${w}x${h}+${x}+${y}\n"; $myDiag->geometry("${w}x${h}+${x}+${y}"); $myDiag->Popup; repositionWindow($myDiag); $myDiag->waitWindow(); return $rc; } ############################################################## # myPicDialog - show some thumbnails and a text to the user # returns 'OK' or content of $button ############################################################## sub myPicDialog { my $title = shift; my $text = shift; my $button = shift; # optional button, if not needed set to "" my @thumbnails = @_; my @icons; my $rc = $button; # open window my $myDiag = $top->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; # determine the heigt of the textbox by counting the number of lines my $height = ($text =~ tr/\n//); $height += 2; $height = 50 if ($height > 50); # not to big, we have scrollbars my $rotext = $myDiag->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 40, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-fill => 'both', -expand => "1", -padx => 3, -pady => 3); $rotext->insert('end', $text); my $f = $myDiag->Frame()->pack; my $i = 0; # insert the thumbnails foreach (@thumbnails) { if ((defined $_) and (-f $_)) { $icons[$i] = $top->Photo(-file => "$_", -gamma => $config{Gamma}); if ($icons[$i]) { $f->Label(-image => $icons[$i], -bg => $config{ColorBG}, -relief => "sunken", )->pack(-side => "left", -anchor => "n", -fill => 'x', -padx => 3, -pady => 3); $i++; } } } my $bf = $myDiag->Frame()->pack(-expand => 1, -fill => 'x'); my $OKB = $bf->Button(-text => 'OK', -command => sub { $rc = 'OK'; $myDiag->destroy; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->focus; if ($button ne "") { $bf->Button(-text => $button, -command => sub { $rc = $button; $myDiag->destroy; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); } $myDiag->bind('', sub { $OKB->invoke; }); $myDiag->Popup; repositionWindow($myDiag); $myDiag->waitWindow(); foreach (@icons) { $_->delete if $_; } # free memory return $rc; } ############################################################## # myButtonDialog - get a feedback from the user # you may specify as many buttons as you like # the return value will be the text of the button pressed # The first one is the default button # the last one is invoked when pressing Escape ############################################################## sub myButtonDialog { my $title = shift; my $text = shift; my $thumbnail = shift; my @buttons = @_; my $icon; my $rc = ""; # open window my $myDiag = $top->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; my $f = $myDiag->Frame()->pack(-fill => 'both', -expand => "1"); if ((defined $thumbnail) and (-f $thumbnail)) { $icon = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma}); if ($icon) { $f->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken", )->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3); } } # determine the heigt of the textbox by counting the number of lines my $height = ($text =~ tr/\n//); $height += 2; $height = 50 if ($height > 50); # not to big, we have scrollbars my $rotext = $f->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 80, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-side => 'right', -fill => 'both', -expand => "1", -padx => 3, -pady => 3); $rotext->insert('end', $text); my %buts; my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); # add the buttons foreach (@buttons) { my $name = $_; $buts{$name} = $ButF->Button(-text => "$name", -command => sub { $rc = "$name"; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); } # the first button gets the focus and is invoked with return $myDiag->bind('', sub { $buts{$buttons[0]}->invoke; } ); $buts{$buttons[0]}->focus; # the last button is invoked with the Escape key $myDiag->bind('', sub { $buts{$buttons[-1]}->invoke; }); $myDiag->Popup; repositionWindow($myDiag); $myDiag->waitVariable(\$rc); $icon->delete if $icon; $myDiag->destroy(); $top->focus; return $rc; } ############################################################## # checkDialog - a dialog with a Checkbutton (e.g. do not show # this again ...) ############################################################## sub checkDialog { my $title = shift; my $text = shift; my $check = shift; # var ref my $checkT = shift; # the text for the checkbutton my $thumbnail = shift; # !!! not optional, supply "" if there is no thumbnail to show my @buts = @_; # the button text, this text will be returned my $icon; my $rc; # open window my $myDiag = $top->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; my $f = $myDiag->Frame()->pack; if ((defined $thumbnail) and (-f $thumbnail)) { $icon = $top->Photo(-file => "$thumbnail", -gamma => $config{Gamma}); if ($icon) { $f->Label(-image => $icon, -bg => $config{ColorBG}, )->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3); } } # determine the heigt of the textbox by counting the number of lines my $height = ($text =~ tr/\n//); $height += 2; $height = 50 if ($height > 50); # not to big, we have scrollbars my $rotext = $f->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 55, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-side => "right", -fill => 'both', -expand => "1", -padx => 3, -pady => 3); $rotext->insert('end', $text); my $OKB; $myDiag->Checkbutton(-variable => \$$check, -text => $checkT, )->pack(-fill => 'x', -padx => 3, -pady => 3); my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); foreach my $text (@buts) { $ButF->Button(-text => "$text", -command => sub { $rc = "$text"; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); } $myDiag->Popup; repositionWindow($myDiag); $myDiag->waitVariable(\$rc); $icon->delete if $icon; $myDiag->withdraw(); $myDiag->destroy(); return $rc; } ############################################################## # myTextDialog - get a text from the user ############################################################## sub myTextDialog { my $title = shift; my $text = shift; my $varRef = shift; my $thumb = shift; # optional file name of thumbnail my ($rc, $icon); # open window my $myDiag = $top->Toplevel(); #$myDiag->grab(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; $myDiag->Label(-text => $text, -bg => $config{ColorBG} )->pack(-fill => 'x', -padx => 3, -pady => 3); my $fl = $myDiag->Frame()->pack(-anchor => "n", -side => "left"); my $fm = $myDiag->Frame()->pack(-expand => 1, -fill => "both", -anchor => "n", -side => "left"); my $fr = $myDiag->Frame()->pack(-expand => 1, -fill => "both", -anchor => "n", -side => "left"); if ((defined $thumb) and (-f $thumb)) { $icon = $myDiag->Photo(-file => "$thumb", -gamma => $config{Gamma}); if ($icon) { $fl->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken", )->pack(-padx => 1, -pady => 2); } } my $topButF = $fm->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill =>'x', -padx => 3, -pady => 3); my $midF = $fm->Frame()->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 3); my $entry = $midF->Scrolled("Text", -scrollbars => 'osoe', -wrap => 'none', -width => 65, -height => 20, )->pack(-side => "left", -expand => 1, -fill => "both", -padx => 3, -pady => 3); $entry->insert('end', $$varRef); #$entry->selectionRange(0,'end'); $entry->see('end'); $entry->markSet("insert",'end'); my $keytree = $fr->Scrolled('Tree', -separator => '/', -scrollbars => 'osoe', -selectmode => 'single', -exportselection => 0, -width => 20, )->pack(-expand => 1, -fill => 'both', -padx => 2, -pady => 2); bindMouseWheel($keytree->Subwidget("scrolled")); $balloon->attach($keytree, -msg => "Double click on a keyword to insert it.\nIt's possible to edit the keywords, use the\nright mouse button to open the edit menu."); # try to get the saved mode if (-f "$configdir/keywordMode") { my $hashRef = retrieve("$configdir/keywordMode"); warn "could not retrieve mode" unless defined $hashRef; $keytree->{m_mode} = $hashRef; } addTreeMenu($keytree, \@prekeys); insertTreeList($keytree, @prekeys); $keytree->bind("", sub { my @keys = $keytree->info('selection'); return unless checkSelection($myDiag, 1, 0, \@keys); $entry->insert("insert", getLastItem($keys[0])." "); $entry->focus; }); my $ButF = $fm->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $umlautB = $ButF->Checkbutton(-variable => \$config{ConvertUmlaut}, -text => "convert german umlaute")->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 1); $balloon->attach($umlautB, -msg => "Convert german umlaute (e.g. -> ae)\nUmlaute often cause problems in other tools,\nso it's saver to convert them to plain ASCII."); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $$varRef = $entry->get(0.1, 'end'); trimComment($varRef); my $len = length($$varRef); if ($len >= $maxCommentLength) { $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.", -title => "Comment to long", -type => 'OK'); return; } $rc = 'OK'; saveTreeMode($keytree); nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($OKB, -msg => "You can press Control-x to close the dialog (OK button)"); # key-desc,Ctrl-x,accept text and close (in text dialog) $myDiag->bind('', sub { $OKB->invoke; }); $topButF->Label(-text => "Insert ...", -bg => $config{ColorBG}, )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3); my $crb = $topButF->Button(-text => "copyright", -command => sub { $entry->insert("insert", $config{Copyright}); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3); $myDiag->bind('', sub { $crb->invoke; }); $topButF->Button(-text => "file name", -command => sub { $entry->insert("insert", basename($actpic)); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3); $topButF->Button(-text => "last comment", -command => sub { $entry->insert("insert", $config{Comment}); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1); $topButF->Button(-text => "file ...", -command => sub { my $fs = $myDiag->FileSelect(-title => "read comment from file", -directory => $actdir, -width => 30, -height => 30); my $file = $fs->Show; if (!defined $file) { warn "not defined"; return;} if ($file eq "") { warn "empty"; return;}; if (!-f $file) { warn "$file is no file"; return;}; my $fileH; if (!open($fileH, "<$file")) { warn "Sorry, I couldn't open the file $file: $!"; return; } my $buffer; read $fileH, $buffer, 32768; close($fileH); $entry->insert("insert", $buffer); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'Cancel', -command => sub { $rc = 'Cancel'; saveTreeMode($keytree); nstore($keytree->{m_mode}, "$configdir/keywordMode") or warn "could not store $configdir/keywordMode: $!"; $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $entry->focus; $myDiag->Popup(-popover => 'cursor'); repositionWindow($myDiag); $myDiag->waitWindow; $icon->delete if $icon; return $rc; } ############################################################## # myReplaceDialog - get two strings from the user ############################################################## sub myReplaceDialog { my $title = shift; my $text = shift; my $varARef = shift; my $varBRef = shift; my $rc = 'Cancel'; # open window my $win = $top->Toplevel(); #$win->grab(); $win->title($title); $win->iconimage($mapiviicon) if $mapiviicon; $win->Label(-text => $text, -bg => $config{ColorBG} )->pack(-anchor=>'w', -padx => 3, -pady => 3); my $midF = $win->Frame()->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0); $midF->Label(-text => "Replace this:", -bg => $config{ColorBG} )->pack(-anchor=>'w', -padx => 3, -pady => 3); my $entryA = $midF->Scrolled("Text", -scrollbars => 'osoe', -wrap => 'none', -height => 4, -width => 80, )->pack(-side => 'top', -expand => 1, -fill => "both", -padx => 3, -pady => 3); $midF->Label(-text => "with that:", -bg => $config{ColorBG} )->pack(-anchor=>'w', -padx => 3, -pady => 3); my $entryB = $midF->Scrolled("Text", -scrollbars => 'osoe', -wrap => 'none', -height => 4, -width => 80, )->pack(-side => 'top', -expand => 1, -fill => "both", -padx => 3, -pady => 3); $entryA->insert('end', $$varARef); $entryA->see('end'); $entryA->markSet("insert",'end'); $entryB->insert('end', $$varBRef); $entryB->see('end'); $entryB->markSet("insert",'end'); my $umlautB = $win->Checkbutton(-variable => \$config{ConvertUmlaut}, -text => "convert german umlaute")->pack(-anchor => 'w', -padx => 3, -pady => 3); $balloon->attach($umlautB, -msg => "Convert german umlaute (e.g. -> ae)\nUmlaute often cause problems in other tools,\nso it's saver to convert them to plain ASCII."); my $ButF = $win->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $$varARef = $entryA->get(0.1, 'end'); trimComment($varARef); my $len = length($$varARef); if ($len >= $maxCommentLength) { $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.", -title => "Comment to long", -type => 'OK'); return; } $$varBRef = $entryB->get(0.1, 'end'); trimComment($varBRef); $len = length($$varBRef); if ($len >= $maxCommentLength) { $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.", -title => "Comment to long", -type => 'OK'); return; } $rc = 'OK'; $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($OKB, -msg => "You can press Control-x to close the dialog (OK button)"); $ButF->Button(-text => "Test", -command => sub { $$varARef = $entryA->get(0.1, 'end'); trimComment($varARef); my $len = length($$varARef); if ($len >= $maxCommentLength) { $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.", -title => "Comment to long", -type => 'OK'); return; } $$varBRef = $entryB->get(0.1, 'end'); trimComment($varBRef); $len = length($$varBRef); if ($len >= $maxCommentLength) { $top->messageBox(-icon => 'warning', -message => "Sorry your comment is too long ($len characters).\nJPEG-Comments may only be up to 64K.\nPlease shorten your comment.", -title => "Comment to long", -type => 'OK'); return; } $rc = "Test"; $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->bind('', sub { $OKB->invoke; }); $ButF->Button(-text => 'Cancel', -command => sub { $rc = 'Cancel'; $win->withdraw(); $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $entryA->focus; $win->Popup(-popover => 'cursor'); repositionWindow($win); $win->waitWindow; return $rc; } ############################################################## # trimComment ############################################################## sub trimComment { my $comRef = shift; $$comRef =~ s/\n*$//; # remove trailing newlines $$comRef =~ s/\r*//g; # remove \r (carriage return) #$$comRef =~ s/"/\\"/g; # replace " with \" $$comRef =~ s/\"/\'/g; # replace " with ' } ############################################################## # mySelListBoxDialog - let the user select some items of the # given list ############################################################## sub mySelListBoxDialog { my $title = shift; my $text = shift; my $mode = shift; #SINGLE (one selection) or MULTIPLE (several selections) my $OKBut = shift; my $sellist = shift; # output list (list reference) - the list with the selected items my @list = @_; # input list - the list to choose from my $rc = 0; # open window my $myDiag = $top->Toplevel(); $myDiag->title($title); $myDiag->iconimage($mapiviicon) if $mapiviicon; $myDiag->Label(-anchor => 'w', -justify => "left", -text => $text, -bg => $config{ColorBG})->pack(-fill => 'x', -padx => 3, -pady => 3); my $listBoxY = @list; $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries my $listBox = $myDiag->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3); $listBox->configure(-selectmode => 'single') if ($mode == SINGLE); bindMouseWheel($listBox); $listBox->insert('end', @list); $listBox->bind('', sub { @$sellist = $listBox->curselection(); $rc = 1; } ); # select all|none make only sense if multiple selection is possible if ($mode == MULTIPLE) { my $ubutF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $ubutF->Button(-text => 'Select all', -command => sub { $listBox->selectionSet(0, 'end'); })->pack(-side => 'left', -padx => 3, -pady => 3); $ubutF->Button(-text => 'Select none', -command => sub { $listBox->selectionClear(0, 'end'); })->pack(-side => 'left', -padx => 3, -pady => 3); } my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => $OKBut, -command => sub { @$sellist = $listBox->curselection(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->Popup; if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab $myDiag->grab; $myDiag->after(50, sub{$myDiag->grabRelease}); } $OKB->focus; $myDiag->waitVariable(\$rc); $myDiag->destroy() if Tk::Exists($myDiag); return $rc; } ############################################################## # createDirMenu ############################################################## sub createDirMenu { $dirMenu = $top->Menu(-title => "Folder Menu"); } ############################################################## # updateDirMenu ############################################################## sub updateDirMenu { return if (!defined($dirMenu)); # get number of items my $end = $dirMenu->index('end'); # first call to function - build up menu fixed part if ($end < 10) { $dirMenu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'), -command => sub { my $dir = getRightDir(); openDirPost($dir);}, -accelerator => "double click"); $dirMenu->command(-image => compound_menu($top, 'preview folder ...', ''), -command => sub { my $dir = getRightDir(); my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }, -accelerator => "middle click"); $dirMenu->command(-image => compound_menu($top, 'search in folder ...', 'system-search.png'), -command => sub { my $tmp = $config{SearchOnlyInDir}; # save search mode $config{SearchOnlyInDir} = 1; # set to local search searchMetaInfo(); $config{SearchOnlyInDir} = $tmp; # restore search mode }); my $dir_size = $dirMenu->cascade(-image => compound_menu($top, 'folder size', '')); $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } ); $dir_size->command(-label => "display folder sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } ); $dirMenu->separator; $dirMenu->command(-image => compound_menu($top, 'rename folder ...', ''), -command => sub { renameDir(); }); $dirMenu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'), -command => sub { my $dir = getRightDir(); if (!-d $dir) { warn "dir $dir is no dir"; return; } makeNewDir($dir, $dirtree); }); $dirMenu->command(-image => compound_menu($top, 'delete folder ...', ''), -command => sub { deleteDir(); }); $dirMenu->separator; my $dir_hot = $dirMenu->cascade(-image => compound_menu($top, 'folder hotlist', 'emblem-favorite.png')); $dir_hot->command(-label => "add to hotlist", -command => sub { my $dir = getRightDir(); my $max = 0; foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) { $max = $dirHotlist{$_}; last; } $dirHotlist{$dir} = $max; $userinfo = "added $dir to hotlist!"; $userInfoL->update; updateDirMenu(); }); $dir_hot->command(-label => "remove from hotlist", -command => sub { my $dir = getRightDir(); delete $dirHotlist{$dir} if (defined($dirHotlist{$dir})); $userinfo = "removed $dir from hotlist!"; $userInfoL->update; updateDirMenu(); }); } else { # clear dir menu (dynamic part) $dirMenu->delete(11, 'end'); } # add the dynamic part my $i = 0; # add the 12 most wanted hotlist folders :) my @dirlist; foreach (sort {$dirHotlist{$b} <=> $dirHotlist{$a}} keys %dirHotlist) { # remove deleted dirs if (!-d $_) { delete $dirHotlist{$_}; next; # skip } next if ($_ eq $trashdir); $i++; push @dirlist, $_; last if ($i > 11); } foreach (sort @dirlist) { my $dir = $_; # we need a local copy # this will add the number of accesses of the folder #$dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); }, -accelerator => "($dirHotlist{$_})"); $dirMenu->command(-label => "$_", -command => sub { openDirPost($dir); }); } $dirMenu->separator; # add the last used folders foreach (reverse @dirHist) { next if (!-d $_); my $dir = $_; # we need a local copy $dirMenu->command(-label => "$dir", -command => sub { openDirPost($dir); }); } } ############################################################## # createThumbMenu ############################################################## sub createThumbMenu { $thumbMenu = $top->Menu(-title => "Thumbnail Menu"); addSelectMenu($thumbMenu); $thumbMenu->separator; addFileActionsMenu($thumbMenu, $picLB); $thumbMenu->separator; addPicProcessing($thumbMenu); $thumbMenu->separator; addMetaInfoMenu($thumbMenu); $thumbMenu->separator; $thumbMenu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -command => \&updateThumbsPlus, -accelerator => ""); $thumbMenu->command(-label => "rebuild thumbs ...", -command => \&rebuildThumbs, -accelerator => ""); $thumbMenu->command(-label => "add to light table", -command => sub {light_table_add_from_lb($picLB);}, -accelerator => ""); } ############################################################## # createPicMenu ############################################################## sub createPicMenu { $picMenu = $top->Menu(-title => "Picture Menu"); $picMenu->command(-label => "reload picture", -command => \&reloadPic ); $picMenu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'), -command => \&showPicInOwnWin, -accelerator => "" ); $picMenu->separator; addPicProcessing($picMenu); $picMenu->separator; addZoomMenu($picMenu); $picMenu->separator; $picMenu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'), -command => \&options, -accelerator => ""); $picMenu->command(-label => "toggle layout", -command => sub { $config{Layout}++; layout(1); } ); $picMenu->command(-image => compound_menu($top, 'toggle fullscreen mode', 'view-fullscreen.png'), -command => sub { topFullScreen(); } ); } ############################################################## # compoud_menu ############################################################## sub compound_menu { my $w = shift; my $text = shift; my $icon_name = shift; my $space = shift; # optional $space = 19 unless defined $space; my $compound_image = $w->Compound(); if (-f "$icon_path/$icon_name") { $compound_image->Image(-image => $top->Photo(-file => "$icon_path/$icon_name", -gamma => $config{Gamma})); $compound_image->Space(-width => 3); } else { $compound_image->Space(-width => $space); print "Mapivi info: icon $icon_path/$icon_name not found.\n" if ($icon_name ne ''); } $compound_image->Text(-text => $text); return $compound_image; } ############################################################## # createMenubar ############################################################## sub createMenubar { $menubar = $top->Menu; my $file_menu = $menubar->cascade(-label => "File"); # use "~File" for key shortcut $file_menu->cget(-menu)->configure(-title => "File menu"); my $edit_menu = $menubar->cascade(-label => "Edit"); $edit_menu->cget(-menu)->configure(-title => "Edit menu"); my $view_menu = $menubar->cascade(-label => "View"); $view_menu->cget(-menu)->configure(-title => "View menu"); my $sort_menu = $menubar->cascade(-label => "Sort"); $sort_menu->cget(-menu)->configure(-title => "Sort menu"); my $find_menu = $menubar->cascade(-label => "Search"); $find_menu->cget(-menu)->configure(-title => "Search menu"); my $opti_menu = $menubar->cascade(-label => "Options"); $opti_menu->cget(-menu)->configure(-title => "Options menu"); my $extr_menu = $menubar->cascade(-label => "Extra"); $extr_menu->cget(-menu)->configure(-title => "Extra menu"); my $plug_menu = $menubar->cascade(-label => "PlugIns"); $plug_menu->cget(-menu)->configure(-title => "PlugIn menu"); my $help_menu = $menubar->cascade(-label => "Help"); $help_menu->cget(-menu)->configure(-title => "Help menu"); #my $icon = ; $file_menu->command(-image => compound_menu($top, 'open folder ...', 'folder.png'), -command => \&openDir, -accelerator => ""); #$file_menu->command(-image => compound_menu($top, 'open umlaut folder ...', ''), -command => sub { openDirPost("/home/herrmann/tmp/dirb/subdir"); } ); $file_menu->command(-image => compound_menu($top, 'preview folder', ''), -command => sub { my $dir = getRightDir(); my @list = getPics($dir, WITH_PATH); sortPics($config{SortBy}, $config{SortReverse}, \@list); showThumbList(\@list, $dir); }, -accelerator => "middle click"); $file_menu->command(-image => compound_menu($top, 'search in folder ...', ''), -command => sub { my $tmp = $config{SearchOnlyInDir}; # save search mode $config{SearchOnlyInDir} = 1; # set to local search searchMetaInfo(); $config{SearchOnlyInDir} = $tmp; # restore search mode }); my $dir_size = $file_menu->cascade(-image => compound_menu($top, 'folder size', '')); $dir_size->command(-label => "calculate folder size ...", -command => sub { calcDirSize(); } ); $dir_size->command(-label => "display folder sizes (graphic) ...", -command => sub { showDirSizes(getRightDir()); } ); $file_menu->separator; $file_menu->command(-image => compound_menu($top, 'rename folder ...', ''), -command => \&renameDir); $file_menu->command(-image => compound_menu($top, 'new folder ...', 'folder-new.png'), -command => sub { my $dir = getRightDir(); if (!-d $dir) { warn "dir $dir is no dir"; return; } makeNewDir($dir, $dirtree); } ); $file_menu->command(-image => compound_menu($top, 'delete folder ...', ''), -command => \&deleteDir); $file_menu->command(-image => compound_menu($top, 'hot folders ...', ''), -command => sub { $dirMenu->Popup(-popover => "cursor", -popanchor => "nw"); }, , -accelerator => ""); $file_menu->separator; addFileActionsMenu($file_menu, $picLB); $file_menu->separator; my $trash_menu = $file_menu->cascade(-image => compound_menu($top, 'trash', 'user-trash.png')); $trash_menu->command(-label => "empty trash ...", -command => \&emptyTrash); $trash_menu->command(-label => "open trash in main window", -command => [\&openDirPost, $trashdir]); $file_menu->command(-image => compound_menu($top, 'folder checklist ...', ''), -command => sub { showDirProperties(); } ); $file_menu->command(-image => compound_menu($top, 'import wizard ...', 'camera-photo.png'), -command => \&importWizard); $file_menu->separator; $file_menu->command(-image => compound_menu($top, 'light table (slideshow) ...', ''), -command => \&light_table_open_window); $file_menu->command(-image => compound_menu($top, 'convert non-JPEG pictures ...', ''), -command => \&convertNonJPEGS); $file_menu->command(-image => compound_menu($top, 'rescan folder', 'view-refresh.png'), -accelerator => "", -command => \&updateThumbsPlus); $file_menu->command(-image => compound_menu($top, 'smart update', 'view-refresh.png'), -command => sub { smart_update(); }, -accelerator => ""); $file_menu->command(-image => compound_menu($top, 'rebuild selected thumbnails ...', ''), -command => \&rebuildThumbs, -accelerator => ""); $file_menu->command(-image => compound_menu($top, 'build thumbnails ...', ''), -command => \&buildThumbsRecursive); $file_menu->separator; $file_menu->command(-image => compound_menu($top, 'iconify', 'user-desktop.png'), -accelerator => "", -command => sub { $top->iconify; }); $file_menu->command(-image => compound_menu($top, 'restart', ''), -command => \&restart) unless ($EvilOS); $file_menu->command(-image => compound_menu($top, 'quit', 'system-log-out.png'), -accelerator => "", -command => \&quitMain); addSelectMenu($edit_menu); $edit_menu->separator; addPicProcessing($edit_menu); $edit_menu->separator; # add the comments, EXIF and IPTC menu addMetaInfoMenu($edit_menu); $view_menu->command(-image => compound_menu($top, 'next', 'go-next.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(nextPic($actpic)); }, -accelerator => ""); $view_menu->command(-image => compound_menu($top, 'previous', 'go-previous.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off showPic(prevPic($actpic));}, -accelerator => ""); $view_menu->separator; $view_menu->command(-image => compound_menu($top, 'first', 'go-first.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $picLB->info('children'); return unless (@childs); showPic($childs[0]); }, -accelerator => ""); $view_menu->command(-image => compound_menu($top, 'last', 'go-last.png'), -command => sub { return if (stillBusy()); # block, until last picture is loaded if ($slideshow == 1) { $slideshow = 0; slideshow(); } # switch slideshow off my @childs = $picLB->info('children'); return unless (@childs); showPic($childs[-1]); }, -accelerator => ""); $view_menu->separator; $view_menu->command(-image => compound_menu($top, 'go to/select ...', ''), -command => sub { gotoPic($picLB); }, -accelerator => ""); $view_menu->separator; addZoomMenu($view_menu); $view_menu->separator; $view_menu->command(-image => compound_menu($top, 'open picture in new window', 'image-x-generic.png'), -command => \&showPicInOwnWin, -accelerator => ""); $view_menu->command(-image => compound_menu($top, 'open picture in external viewer', 'image-x-generic.png'), -command => sub{openPicInViewer($picLB);}, -accelerator => ""); $view_menu->command(-label => "show infos about picture", -command => \&identifyPic); $view_menu->command(-label => "show histogram (ImageMagick)", -command => sub { showHistogram($picLB); } ); $view_menu->command(-label => "show histogram (builtin)", -command => sub { showHistogram2($picLB); } ); $view_menu->command(-label => "show JPEG segments", -command => \&showSegments); $view_menu->command(-image => compound_menu($top, 'start/stop slideshow', 'media-playback-start.png'), -command => sub { if ($slideshow == 0) { $slideshow = 1; } else { $slideshow = 0; } slideshow(); }, -accelerator => ""); $view_menu->command(-label => "use actual picture as desktop background", -command => \&setBackground); $view_menu->separator; my $layout_menu = $view_menu->cascade(-label => "Window layout ..."); $layout_menu->cget(-menu)->configure(-title => "Window layout ..."); $layout_menu->command(-label => "toggle layout", -command => sub { $config{Layout}++; layout(1); }, -accelerator => ""); $layout_menu->separator; $layout_menu->command(-label => "folder-thumbnails-picture", -command => sub { $config{Layout} = 0 ; layout(1); }, -accelerator => ""); $layout_menu->command(-label => "folder-thumbnails", -command => sub { $config{Layout} = 1 ; layout(1); }, -accelerator => ""); $layout_menu->command(-label => "thumbnails", -command => sub { $config{Layout} = 2 ; layout(1); }, -accelerator => ""); $layout_menu->command(-label => "thumbnails-picture", -command => sub { $config{Layout} = 3 ; layout(1); }, -accelerator => ""); $layout_menu->command(-label => "picture", -command => sub { $config{Layout} = 4 ; layout(1); }, -accelerator => ""); $layout_menu->separator; $layout_menu->checkbutton(-label => "menu bar", -variable => \$config{ShowMenu}, -command => sub { showHideFrames(); }, -accelerator => ""); $layout_menu->checkbutton(-label => "status bar", -variable => \$config{ShowInfoFrame}, -command => sub { showHideFrames(); }, -accelerator => ""); $layout_menu->checkbutton(-label => "EXIF box", -variable => \$config{ShowEXIFField}, -command => sub { showHideFrames(); }, -accelerator => ""); $layout_menu->checkbutton(-label => "caption box", -variable => \$config{ShowCaptionField}, -command => sub { showHideFrames(); }, -accelerator => ""); $layout_menu->checkbutton(-label => "comment box", -variable => \$config{ShowCommentField}, -command => sub { showHideFrames(); }); $layout_menu->checkbutton(-label => "overlap picture with info", -variable => \$config{ShowInfoInCanvas}, -command => sub { showPic($actpic); }); $layout_menu->checkbutton(-label => "display mouse coordinates", -variable => \$config{ShowCoordinates}); $view_menu->separator; my $thumb_menu = $view_menu->cascade(-label => "Thumbnail table layout ..."); $thumb_menu->cget(-menu)->configure(-title => "Thumbnail table layout ..."); my $caption_menu = $thumb_menu->cascade(-label => "Thumbnail caption ..."); $caption_menu->cget(-menu)->configure(-title => "Thumbnail caption ..."); $caption_menu->radiobutton(-label => "none", -variable => \$config{ThumbCapt}, -value => "none", -command => sub { updateThumbsPlus(); }); $caption_menu->radiobutton(-label => "file name without suffix", -variable => \$config{ThumbCapt}, -value => "filename", -command => sub { updateThumbsPlus(); }); $caption_menu->radiobutton(-label => "file name with suffix", -variable => \$config{ThumbCapt}, -value => "filenameSuffix", -command => sub { updateThumbsPlus(); }); $caption_menu->radiobutton(-label => "IPTC object name", -variable => \$config{ThumbCapt}, -value => "objectname", -command => sub { updateThumbsPlus(); }); $thumb_menu->separator; $thumb_menu->checkbutton(-label => "show file info", -variable => \$config{ShowFile}, -command => \&toggleHeaders); $thumb_menu->checkbutton(-label => "show IPTC/IIM", -variable => \$config{ShowIPTC}, -command => \&toggleHeaders); $thumb_menu->checkbutton(-label => "show comments", -variable => \$config{ShowComment}, -command => \&toggleHeaders); $thumb_menu->checkbutton(-label => "show EXIF", -variable => \$config{ShowEXIF}, -command => \&toggleHeaders); $thumb_menu->checkbutton(-label => "show folder", -variable => \$config{ShowDirectory}, -command => \&toggleHeaders); $sort_menu->radiobutton(-label => "file name", -variable => \$config{SortBy}, -value => "name", -command => sub { updateThumbsPlus(); }); $sort_menu->radiobutton(-label => "file date", -variable => \$config{SortBy}, -value => "date", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "file size", -variable => \$config{SortBy}, -value => "size", -command => \&updateThumbsPlus); $sort_menu->separator; $sort_menu->radiobutton(-label => "IPTC urgency/rating", -variable => \$config{SortBy}, -value => "urgency", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "IPTC by-line", -variable => \$config{SortBy}, -value => "byline", -command => \&updateThumbsPlus); $sort_menu->separator; $sort_menu->radiobutton(-label => "number of views", -variable => \$config{SortBy}, -value => "popularity", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "number of pixels", -variable => \$config{SortBy}, -value => "pixel", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "number of bits per pixels (b/p)", -variable => \$config{SortBy}, -value => "bitpix", -command => \&updateThumbsPlus) if ($config{BitsPixel}); $sort_menu->separator; $sort_menu->radiobutton(-label => "EXIF date", -variable => \$config{SortBy}, -value => "exifdate", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "EXIF aperture", -variable => \$config{SortBy}, -value => "aperture", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "EXIF exposure time", -variable => \$config{SortBy}, -value => "exposuretime", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "EXIF camera maker/model", -variable => \$config{SortBy}, -value => "model", -command => \&updateThumbsPlus); $sort_menu->radiobutton(-label => "EXIF artist", -variable => \$config{SortBy}, -value => "artist", -command => \&updateThumbsPlus); $sort_menu->separator; $sort_menu->radiobutton(-label => "sort randomly", -variable => \$config{SortBy}, -value => "random", -command => \&updateThumbsPlus); $sort_menu->separator; $sort_menu->checkbutton(-label => "sort reverse", -variable => \$config{SortReverse}, -command => \&updateThumbsPlus); #my $data_menu = $extr_menu->cascade(-label => "Search database"); #$data_menu->cget(-menu)->configure(-title => "Search database"); $find_menu->command(-image => compound_menu($top, 'search ...', 'system-search.png'), -command => \&searchMetaInfo, -accelerator => ''); $find_menu->command(-image => compound_menu($top, 'search by keywords (tag cloud) ...', 'weather-overcast.png'), -command => \&keyword_browse, -accelerator => ''); $find_menu->command(-image => compound_menu($top, 'search by timeline ...', 'x-office-calendar.png'), -command => \&database_info); $find_menu->command(-image => compound_menu($top, 'search by location ...', 'applications-internet.png'), -command => sub { search_by_location($picLB); } ); $find_menu->command(-image => compound_menu($top, 'search duplicates ...', ''), -command => \&findDups); #$find_menu->command(-label => "check for new keywords ...", -command => \&check_new_keywords); $find_menu->separator; my $find_special_menu = $find_menu->cascade(-image => compound_menu($top, 'special searches', '')); $find_special_menu->command(-label => "show TOP 100 of best rated pictures", -command => \&showMostPopularPics); $find_special_menu->command(-image => compound_menu($top, 'search for file name ...', 'edit-find.png'), -command => sub { searchFileName($picLB);}); $find_menu->separator; $find_menu->command(-image => compound_menu($top, 'add to database ...', 'list-add.png'), -command => \&buildDatabase); $find_menu->command(-image => compound_menu($top, 'clean database ...', 'list-remove.png'), -command => \&cleanDatabase); $find_menu->command(-image => compound_menu($top, 'check database ...', ''), -command => \&checkDatabase); $find_menu->command(-image => compound_menu($top, 'edit database ...', 'accessories-text-editor.png'), -command => \&editDatabase); $opti_menu->command(-image => compound_menu($top, 'options ...', 'preferences-system.png'), -command => \&options, -accelerator => ""); $opti_menu->command(-label => "save options", -command => \&saveAllConfig); $extr_menu->command(-label => "export filelist ...", -command => \&exportFilelist); $extr_menu->command(-label => "compare folders ...", -command => sub { dirDiffWindow(); } ); $extr_menu->command(-label => "compare pictures", -command => \&diffPics); $extr_menu->command(-label => "show window list ...", -command => \&showWindowList, -accelerator => ""); $extr_menu->separator; $extr_menu->command(-label => "montage/index print ...", -command => sub { my @pics = getSelection($picLB); indexPrint(\@pics); }); $extr_menu->command(-label => "interpolate dead pixels ...", -command => \&interpolatePics); $extr_menu->command(-label => "add fuzzy border ...", -command => \&fuzzyBorder); $extr_menu->command(-label => "add lossless watermark ...", -command => \&losslessWatermark); $extr_menu->command(-label => "make screenshot ...", -command => \&screenshot); $extr_menu->separator; $extr_menu->command(-label => "build thumbnails database ...", -command => \&buildThumbsRecursive); $extr_menu->command(-label => "clean thumbnail database ...", -command => sub { cleanThumbDB(); } ); $extr_menu->command(-label => "clean folder ...", -command => sub { cleanDir($actdir); } ); $extr_menu->command(-label => "edit entry history ...", -command => sub { editEntryHistory(); } ); # just an experiment: #$extr_menu->separator; #$extr_menu->command(-label => "show picture view list", -command => sub { showPicViewList(); }); $extr_menu->separator; $extr_menu->command(-label => "mapivi test suite", -command => \&testSuite); makePlugInsMenu($plug_menu); $help_menu->command(-image => compound_menu($top, 'About', 'dialog-information.png'), -command => \&about); $help_menu->command(-image => compound_menu($top, 'Keys', 'input-keyboard.png'), -command => \&showkeys); $help_menu->command(-image => compound_menu($top, 'System information', 'utilities-system-monitor.png'), -command => \&systemInfo); $help_menu->command(-image => compound_menu($top, 'License', ''), -command => [\&showFile, "$configdir/License.txt"]) if (-f "$configdir/License.txt"); $help_menu->command(-image => compound_menu($top, 'History', ''), -command => [\&showFile, "$configdir/Changes.txt"]) if (-f "$configdir/Changes.txt"); $help_menu->command(-image => compound_menu($top, 'Tips', 'help-browser.png'), -command => sub { showFile("$configdir/Tips.txt") }) if (-f "$configdir/Tips.txt"); $help_menu->command(-image => compound_menu($top, 'FAQ', 'help-browser.png'), -command => [\&showFile, "$configdir/FAQ"]) if (-f "$configdir/FAQ"); $top->configure(-menu => $menubar) if $config{ShowMenu}; } ############################################################## # addPicProcessing ############################################################## sub addPicProcessing { my $menu = shift; my $rot_menu = $menu->cascade(-image => compound_menu($top, 'rotate (clockwise) ...', 'transform-rotate.png')); $rot_menu->cget(-menu)->configure(-title => "rotation menu"); $rot_menu->command(-label => "rotate 90 - right (lossless)", -command => [\&rotate, 90], -accelerator => "<9>"); $rot_menu->command(-label => "rotate 180 (lossless)", -command => [\&rotate, 180], -accelerator => "<8>"); $rot_menu->command(-label => "rotate 270 - left (lossless)", -command => [\&rotate, 270], -accelerator => "<7>"); $rot_menu->command(-label => "flip horizontal (lossless)", -command => [\&rotate, "horizontal"]); $rot_menu->command(-label => "flip vertical (lossless)", -command => [\&rotate, "vertical"]); $rot_menu->command(-label => "auto rotate (lossless)", -command => [\&rotate, "auto"], -accelerator => "<0>"); $rot_menu->command(-label => "clear rotate flag (lossless)", -command => [\&rotate, "clear"]); $rot_menu->command(-label => "rotate ...", -command => [\&rotateAny]); $menu->command(-image => compound_menu($top, 'change size/quality ...', 'transform-scale.png'), -command => \&changeSizeQuality, -accelerator => "" ); $menu->command(-image => compound_menu($top, 'crop (lossless) ...', 'edit-cut.png'), -command => sub { crop($picLB); }, -accelerator => ""); $menu->command(-image => compound_menu($top, 'image processing ...', 'camera-photo.png'), -command => \&filterPic, -accelerator => ""); $menu->command(-image => compound_menu($top, 'make grayscale ...', 'image-x-generic-bw.png'), -command => sub { grayscalePic($picLB); } ); my $border_menu = $menu->cascade(-image => compound_menu($top, 'add border ...', 'image-x-generic.png')); $border_menu->cget(-menu)->configure(-title => 'border menu'); $border_menu->command(-image => compound_menu($top, 'add border (lossless) ...', ''), -command => sub { losslessBorder(PIXEL); }, -accelerator => ""); $border_menu->command(-image => compound_menu($top, 'add border aspect ratio (lossless) ...', ''), -command => sub { losslessBorder(ASPECT_RATIO); } ); $border_menu->command(-image => compound_menu($top, 'add relative border (lossless) ...', ''), -command => sub { losslessBorder(RELATIVE); } ); $border_menu->command(-image => compound_menu($top, 'add border or copyright (lossy) ...', ''), -command => \&addDecoration); $menu->command(-image => compound_menu($top, 'edit in GIMP', 'applications-graphics.png'), -command => \&GIMPedit, -accelerator => "") unless ($exprogs{"gimp-remote"} or $exprogs{"gimp-win-remote"}); } ############################################################## # addFileActionsMenu ############################################################## sub addFileActionsMenu { my $menu = shift; my $lb = shift; my $fop_menu = $menu->cascade(-image => compound_menu($top, 'file operations ...', '')); $fop_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-copy.png'), -command => sub { copyPicsDialog(COPY, $lb); } ); $fop_menu->command(-image => compound_menu($top, 'link to ...', ''), -command => \&linkPicsDialog) if (!$EvilOS); $fop_menu->command(-image => compound_menu($top, 'move to ...', ''), -command => sub { movePicsDialog($lb); } ); $fop_menu->command(-image => compound_menu($top, 'send to ...', 'mail-message-new.png'), -command => sub { sendTo($lb); } ); $fop_menu->command(-image => compound_menu($top, 'convert ...', ''), -command => sub { convertPics($lb); } ); $fop_menu->command(-image => compound_menu($top, 'copy to print ...', 'printer.png'), -command => sub { copyToPrint($lb); }, -accelerator => ""); $fop_menu->command(-image => compound_menu($top, 'rename ...', ''), -command => sub { renamePic($lb); }, -accelerator => ""); $fop_menu->command(-image => compound_menu($top, 'smart rename ...', ''), -command => sub { renameSmart($lb); }, -accelerator => ""); $fop_menu->command(-image => compound_menu($top, 'make backup', ''), -command => sub { copyPicsDialog(BACKUP, $lb); } ); $fop_menu->command(-image => compound_menu($top, 'make HTML ...', 'applications-internet.png'), -command => sub { makeHTML($lb); }); $fop_menu->separator; $fop_menu->command(-image => compound_menu($top, 'delete to trash', 'user-trash.png'), -accelerator => "", -command => sub { deletePics($lb, TRASH); } ); $fop_menu->command(-image => compound_menu($top, 'delete ...', ''), -accelerator => "", -command => sub { deletePics($lb, REMOVE); } ); } ############################################################## # addSelectMenu ############################################################## sub addSelectMenu { my $menu = shift; my $sel_menu = $menu->cascade(-image => compound_menu($top, 'select ...', '')); $sel_menu->command(-label => "select all", -accelerator => "", -command => sub {selectAll($picLB);} ); $sel_menu->command(-label => "select all backups", -command => \&selectBak ); $sel_menu->command(-label => "invert selection", -command => \&selectInv ); $sel_menu->command(-label => "redo selection", -command => sub { $picLB->selectionClear(); reselect($picLB, @savedselection2); } ); } ############################################################## # addZoomMenu ############################################################## sub addZoomMenu { my $menu = shift; $menu->checkbutton(-label => "Auto zoom", -variable => \$config{AutoZoom}); my $zoom_menu = $menu->cascade(-label => "Zoom level ..."); $zoom_menu->cget(-menu)->configure(-title => "Zoom menu"); $zoom_menu->command(-label => "fit", -command => sub { fitPicture(); }, -accelerator => ""); my $i; for ($i = 0; $i < (@frac); $i += 2) { my $z = $frac[$i]; my $s = $frac[$i+1]; my $l = sprintf "%4d%%",($z/$s*100); unless ($l =~ m/\w*100%/) { $zoom_menu->command(-label => $l, -command => sub { zoom($z, $s); } ); } else { $zoom_menu->command(-label => $l, -command => sub { zoom($z, $s); }, -accelerator => ""); } } } ############################################################## # addMetaInfoMenu ############################################################## sub addMetaInfoMenu { my $menu = shift; my $iptc_menu = $menu->cascade(-image => compound_menu($top, 'IPTC/IIM info', '')); $iptc_menu->cget(-menu)->configure(-title => "IPTC/IIM menu"); $iptc_menu->command(-image => compound_menu($top, 'show', ''), -command => sub { displayIPTCData($picLB); }, -accelerator => ""); $iptc_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'), -command => sub { editIPTC($picLB); }, -accelerator => ""); $iptc_menu->command(-image => compound_menu($top, 'remove ...', ''), -command => \&removeIPTC); $iptc_menu->separator; $iptc_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => \©IPTC); $iptc_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => \&pasteIPTC); $iptc_menu->separator; $iptc_menu->command(-image => compound_menu($top, 'add/remove keywords ...', ''), -command => sub { editIPTCKeywords($picLB); }, -accelerator => ''); $iptc_menu->command(-image => compound_menu($top, 'add/remove categories ...', ''), -command => sub { editIPTCCategories($picLB); } , -accelerator => ''); $iptc_menu->separator; $iptc_menu->command(-image => compound_menu($top, 'save template ...', ''), -command => \&saveIPTC); $iptc_menu->command(-image => compound_menu($top, 'merge template ...', ''), -command => \&mergeIPTC); $iptc_menu->separator; addRatingMenu($iptc_menu, $picLB); addRatingMenu($menu, $picLB); if ($exiftoolAvail) { my $xmp_menu = $menu->cascade(-image => compound_menu($top, 'XMP info', '')); $xmp_menu->cget(-menu)->configure(-title => 'XMP menu'); $xmp_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { xmp_show($picLB); }); # -accelerator => ""); $xmp_menu->command(-image => compound_menu($top, 'add title ...', ''), -command => sub { xmp_add_title($picLB); }); $xmp_menu->command(-image => compound_menu($top, 'edit title ...', ''), -command => sub { xmp_edit_title($picLB); }); $xmp_menu->command(-image => compound_menu($top, 'add keyword ...', ''), -command => sub { xmp_add_keyword($picLB); }); } my $exif_menu = $menu->cascade(-image => compound_menu($top, 'EXIF info', '')); $exif_menu->cget(-menu)->configure(-title => "EXIF menu"); $exif_menu->command(-image => compound_menu($top, 'show info', ''), -command => sub { displayEXIFData($picLB); }, -accelerator => ""); $exif_menu->command(-image => compound_menu($top, 'show thumbnail', ''), -command => \&showEXIFThumb, -accelerator => ""); $exif_menu->command(-image => compound_menu($top, 'save thumbnail ...', ''), -command => \&getEXIFThumb); $exif_menu->command(-image => compound_menu($top, '(re)build thumbnail ...', ''), -command => \&buildEXIFThumb); $exif_menu->separator; $exif_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => [\©EXIFData, "from"]); $exif_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => [\©EXIFData, "to"]); $exif_menu->command(-image => compound_menu($top, 'copy thumbnail to ...', ''), -command => \©Thumbnail); $exif_menu->separator; $exif_menu->command(-image => compound_menu($top, 'save', ''), -command => \&EXIFsave); $exif_menu->command(-image => compound_menu($top, 'restore ...', ''), -command => \&EXIFrestore); $exif_menu->command(-image => compound_menu($top, 'remove saved info ...', ''), -command => \&EXIFremoveSaved); $exif_menu->separator; $exif_menu->command(-image => compound_menu($top, 'set date/time ...', 'accessories-text-editor.png'), -command => \&setEXIFDate); $exif_menu->separator; $exif_menu->command(-image => compound_menu($top, 'remove thumbnail ...', ''), -command => [\&removeEXIFData, "thumb"]); $exif_menu->command(-image => compound_menu($top, 'remove all ...', ''), -command => [\&removeEXIFData, "all"]); my $comm_menu = $menu->cascade(-image => compound_menu($top, 'Comments', '')); $comm_menu->cget(-menu)->configure(-title => "Comment menu"); $comm_menu->command(-label => "show ...", -command => \&showComment, -accelerator => ""); $comm_menu->separator; $comm_menu->command(-label => "add ...", -command => sub{ addComment($picLB); }, -accelerator => ""); $comm_menu->command(-image => compound_menu($top, 'edit ...', 'accessories-text-editor.png'), -command => sub{ editComment($picLB); }, -accelerator => ""); $comm_menu->command(-label => "join ...", -command => sub { joinComments(ASK); } ); $comm_menu->command(-label => "search/replace ...", -command => sub{ replaceComment($picLB); } ); $comm_menu->command(-label => 'add/remove keywords ...', -command => sub { editCommentKeywords($picLB); } ); $comm_menu->separator; $comm_menu->command(-label => "remove ...", -command => \&removeComment); $comm_menu->command(-label => "remove all ...", -command => sub { removeAllComments(ASK); } ); $comm_menu->separator; $comm_menu->command(-image => compound_menu($top, 'copy from ...', 'edit-copy.png'), -command => [\©Comment, "from"]); $comm_menu->command(-image => compound_menu($top, 'copy to ...', 'edit-paste.png'), -command => [\©Comment, "to"]); $comm_menu->separator; $comm_menu->command(-label => "add filename as comment ...", -command => [\&nameToComment, "to"]); } ############################################################## # addRatingMenu ############################################################## sub addRatingMenu { my $menu = shift; my $widget = shift; # e.g. $picLB my $iptc_urge = $menu->cascade(-image => compound_menu($top, 'rating (IPTC urgency)', '')); $iptc_urge->cget(-menu)->configure(-title => "rating (IPTC urgency)"); $iptc_urge->command(-label => "******** (1 high)", -command => sub { setIPTCurgency($widget, 1); }, -accelerator => ""); $iptc_urge->command(-label => "******* (2)", -command => sub { setIPTCurgency($widget, 2); }, -accelerator => ""); $iptc_urge->command(-label => "****** (3)", -command => sub { setIPTCurgency($widget, 3); }, -accelerator => ""); $iptc_urge->command(-label => "***** (4)", -command => sub { setIPTCurgency($widget, 4); }, -accelerator => ""); $iptc_urge->command(-label => "**** (5 normal)", -command => sub { setIPTCurgency($widget, 5); }, -accelerator => ""); $iptc_urge->command(-label => "*** (6)", -command => sub { setIPTCurgency($widget, 6); }, -accelerator => ""); $iptc_urge->command(-label => "** (7)", -command => sub { setIPTCurgency($widget, 7); }, -accelerator => ""); $iptc_urge->command(-label => "* (8 low)", -command => sub { setIPTCurgency($widget, 8); }, -accelerator => ""); $iptc_urge->command(-label => "- (0 none)", -command => sub { setIPTCurgency($widget, 0); }, -accelerator => ""); $iptc_urge->command(-label => "remove rating", -command => sub { setIPTCurgency($widget, 9); }, -accelerator => ""); } ############################################################## # makePlugInsMenu ############################################################## sub makePlugInsMenu { my $menu = shift; my @plugins = getFiles($plugindir); my $file; foreach my $plugin (@plugins) { if ($plugin =~ m/.*\.txt$/) { # process just the describtions if (!open($file, "<$plugindir/$plugin")) { warn "read plugin desc: Couldn't open $plugin: $!"; next; } while (<$file>) { chomp; # no newline s/^#.*//; # no comments (lines starting with #) s/^\s+//; # no leading white s/\s+$//; # no trailing white next unless length; # anything left? my ($prog, $menuitem, $update, $desc) = split(/\s\+\s/, $_, 4); print "plugin: -$prog-$menuitem-$update-$desc-\n" if $verbose; if (!-f "$plugindir/$prog") { # look for the corresponding plugin warn "warning: plugin for description $plugin not fount in $plugindir\n"; next; } my $item = $menu->command(-label => "$menuitem", -command => sub { print "$prog $menuitem $desc\n" if $verbose; my @sellist = $picLB->info('selection'); #return unless checkSelection($top, 1, 0, \@sellist); my $command = "\"$plugindir/$prog\" "; foreach (@sellist) { $command .= "\"$_\" "; } print "com = $command\n" if $verbose; my $buffer = `$command`; showText("Output of PlugIn $menuitem", $buffer, NO_WAIT) if ($buffer ne ''); updateThumbsPlus() if $update; }); #$balloon->attach($item, -msg => "$desc"); # does not work :( } close $file; } } } ############################################################## # toggleHeaders - adjusts the width of the columns to zero # or the width needed ("") ############################################################## sub toggleHeaders { my @col = ($config{ColorBG}, $config{ColorBG2}); my $c = 1; if ($config{ShowFile}) { $picLB->columnWidth($picLB->{filecol},""); $fileS->configure(-background=>$col[$c%2]); $c++; } else { $picLB->columnWidth($picLB->{filecol},0); } if ($config{ShowIPTC}) { $picLB->columnWidth($picLB->{iptccol},""); $iptcS->configure(-background=>$col[$c%2]); $c++; } else { $picLB->columnWidth($picLB->{iptccol},0); } if ($config{ShowComment}) { $picLB->columnWidth($picLB->{comcol},""); $comS->configure(-background=>$col[$c%2]); $c++; } else { $picLB->columnWidth($picLB->{comcol},0); } if ($config{ShowEXIF}) { $picLB->columnWidth($picLB->{exifcol},""); $exifS->configure(-background=>$col[$c%2]); $c++; } else { $picLB->columnWidth($picLB->{exifcol},0); } if ($config{ShowDirectory}) { $picLB->columnWidth($picLB->{dircol},""); $dirS->configure(-background=>$col[$c%2]); $c++; } else { $picLB->columnWidth($picLB->{dircol},0); } } ############################################################## # calcDirSize ############################################################## sub calcDirSize { my $dir = getRightDir(); my $size = 0; my $break = 0; my $pw = progressWinInit($top, "Calculate folder size"); find(sub { if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } # we don't know how long it will take, so we set total to zero progressWinUpdate($pw, "size $size Bytes", 0, 0); $size += -s; },$dir); progressWinEnd($pw); my $msg = "Calculation finished."; if ($break) { $msg = "Warning: The calculation wasn't finished!\nReal size may be bigger than displayed."; } my $unitSize = computeUnit($size); $top->messageBox(-icon => 'question', -message => "$msg\nThe folder size of $dir is $unitSize ($size Bytes)", -title => "Folder size", -type => 'OK'); } ############################################################## # buildThumbsRecursive - scans through all sub folders of # the actual dir an collects JPEG files # let the user select in which dirs # mapivi should build/refresh thumbnails ############################################################## sub buildThumbsRecursive { my $basedir = getRightDir(); my $rc = $top->messageBox(-icon => 'question', -message => "MaPiVi will first scan through all sub folders of $basedir and collect all folders containing JPEG files.\nThen you are able to select in which folders mapivi should build/refresh thumbnails.", -title => "Build thumbnails in all sub folders", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); $userinfo = "searching sub folders ..."; $userInfoL->update; my @dirlist; my @pictestlist; # no questions about NON-JPEGS while searching please! my $tmp = $config{CheckForNonJPEGs}; $config{CheckForNonJPEGs} = 0; my $pic_count = 0; my $break = 0; my $pw = progressWinInit($top, "Collect sub folders"); find(sub { if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } # process just dirs containing pictures, but not .thumbs/ .xvpics/ etc. dirs if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) { progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0); @pictestlist = getPics($File::Find::name, JUST_FILE); # no sort needed if (@pictestlist > 0) { $pic_count += scalar @pictestlist; push @dirlist, $File::Find::name; $userinfo = "found ".@dirlist." subdirs ..."; $userInfoL->update; } } }, $basedir); progressWinEnd($pw); if ($break) { $userinfo = "user break while counting sub folders"; return; } $config{CheckForNonJPEGs} = $tmp; $userinfo = "found ".@dirlist." sub folders"; $userInfoL->update; my @sellist; return if (!mySelListBoxDialog("Select folders", "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThumbnails will be created/updated in the selected folders.", MULTIPLE, "build thumbnails", \@sellist, @dirlist)); # copy the selected elements into the @sel_dirs list my @sel_dirs; foreach (@sellist) { push @sel_dirs, $dirlist[$_]; } my $rebuild = 0; $rc = myButtonDialog('Update or rebuild thumbnails?', "Please select if you want to update or rebuild the thumbnails.\nUpdate will just create thumbnails for modified and new pictures, rebuild will rebuild all thumbnails.", undef, 'Update', 'Rebuild', 'Cancel'); if ($rc eq 'Cancel') { return; } elsif ($rc eq 'Update') { $rebuild = 0; } elsif ($rc eq 'Rebuild') { $rebuild = 1; } else { warn "buildThumbsRecursive: Error wrong rc: $rc"; return; } my $actdirold = $actdir; my ($dir, $dirshort, @pics); $tmp = $config{CheckForNonJPEGs}; $config{CheckForNonJPEGs} = 0; my $i = 0; $pw = progressWinInit($top, "build/refresh thumbnails"); foreach $dir (@sel_dirs) { last if progressWinCheck($pw); $i++; $dirshort = cutString($dir, -40, "..."); progressWinUpdate($pw, "processing ($i/".scalar @sel_dirs.") $dirshort", $i, scalar @sel_dirs); $userinfo = "updating thumbnails in $dirshort ..."; $userInfoL->update; $actdir = $dir; if ($rebuild) { my $thumbdir = dirname(getThumbFileName("$dir/dummy.jpg")); my @thumbs = getPics($thumbdir, WITH_PATH); foreach (@thumbs) { #print "buildThumbsRecursive: remove $_\n"; if ( unlink($_) != 1) { # unlink returns the number of successfull removed files warn "buildThumbsRecursive: could not remove $_"; } } } generateThumbs(NO_ASK, NO_SHOW, 1); # do not ask the user when making a thumbnail dir # do not show (and sort!) the generated thumbs # 1 = read the pics from $actdir, not from the listbox } progressWinEnd($pw); $config{CheckForNonJPEGs} = $tmp; $userinfo = "thumbnails are now up to date!"; $userInfoL->update; $actdir = $actdirold; } ############################################################## # rebuildThumbs ############################################################## sub rebuildThumbs { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); if ($config{AskDeleteThumb}) { my $rc = checkDialog("Delete thumbnails?", "Please press Ok to delete ".scalar @sellist." thumbnails.", \$config{AskDeleteThumb}, "ask every time", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); } my $thumb; my $i = 0; my $pw = progressWinInit($top, "Delete thumbnails"); foreach my $dpic (@sellist) { last if progressWinCheck($pw); # when the element is not available we jump out completly last if (!$picLB->info("exists", $dpic)); $i++; progressWinUpdate($pw, "delete thumbnail ($i/".scalar @sellist.") ...", $i, scalar @sellist); $thumb = getThumbFileName($dpic); if (-f $thumb) { if (!removeFile( $thumb)) { next; } else { # delete was successfull, so we insert the defaultthumb $picLB->itemConfigure($dpic, $picLB->{thumbcol}, -image => $defaultthumbP, -itemtype => "imagetext") if $defaultthumbP; } } } progressWinEnd($pw); generateThumbs(ASK, SHOW); } ############################################################## # copyPicsDialog - copy the selected pictures to a choosen dir ############################################################## sub copyPicsDialog($$) { my $mode = shift; # constant COPY or BACKUP my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $targetdir; if ($mode == BACKUP) { $targetdir = $actdir; } elsif ($mode == COPY) { $targetdir = getDirDialog("Copy pictures to"); } else { warn "copyPicsDialog: error wrong mode: $mode"; return; } return if ($targetdir eq ""); copyPics($targetdir, $mode, $lb, @sellist); } ############################################################## # copyPics - copy the selected pictures to a choosen dir ############################################################## sub copyPics { my $targetdir = shift; my $mode = shift; # constant COPY or BACKUP my $lb = shift; # the reference to the active listbox widget my @sellist = @_; return unless (-d $targetdir); return if (@sellist < 1); makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic, $filename, $suffix); my $process = 'copy'; my $errors = ''; my $i = 0; my $rc = 1; my $n = 0; # count successfull copied pictures my $pw = progressWinInit($lb, "Copy pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $pic = basename($dpic); $i++; $tpic = "$targetdir/$pic"; $thumbpic = getThumbFileName($dpic); $thumbtpic = getThumbFileName($tpic); if ($mode == BACKUP) { $process = 'backup'; $tpic = buildBackupName($dpic); $thumbtpic = buildBackupName(getThumbFileName($dpic)); print "copyPics: duplicate mode $tpic\n" if $verbose; } progressWinUpdate($pw, "$process picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); # if the copy is successfull if (mycopy ($dpic, $tpic, OVERWRITE)) { $n++; # copy the thumbnail picture if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ($thumbpic, $thumbtpic, OVERWRITE) } # copy XMP, WAV, RAW files do_other_files(COPY, $dpic, $tpic, \$errors); # copy meta info in search database $searchDB{$tpic} = $searchDB{$dpic}; if ($mode == BACKUP) { hlistCopy($lb, $dpic, $tpic); # insert and show the backup in the listbox $lb->itemConfigure($tpic, $lb->{thumbcol}, -text => getThumbCaption($tpic)); $lb->itemConfigure($tpic, $lb->{filecol}, -text => getAllFileInfo($tpic)); } } } # foreach - end progressWinEnd($pw); $userinfo = "ready! ($n/".scalar @sellist." copied)"; $userInfoL->update; if ($errors ne '') { $errors = "These errors occured while copying ".scalar @sellist." selected pictures:\n$errors"; showText('Error while moving', $errors, NO_WAIT); } reselect($lb, @sellist); } ############################################################## # rename_XMP_file - rename XMP file if any ############################################################## sub rename_XMP_file { # XMP files follow picture file operations if this option is set to 1 return unless $config{XMP_file_operations}; my $dpic = shift; my $ndpic = shift; my $error_ref = shift; # reference to error string to add warnings etc. my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $dpic_no_suffix = "$dir/$name"; my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $ndpic_no_suffix = "$ndir/$nname"; my $xmp_file = ''; # we have to support upper and lower case XMP suffix if ((-f $dpic_no_suffix.'.xmp')) { $xmp_file = $dpic_no_suffix.'.xmp'; } elsif ((-f $dpic_no_suffix.'.XMP')) { $xmp_file = $dpic_no_suffix.'.XMP'; } else { } if ($xmp_file ne '') { my $txmp_file = "$ndir/${nname}.xmp"; if (-f $txmp_file) { $$error_ref .= "XMP file $txmp_file exists, file not renamed!\n"; } else { print "rename $xmp_file to $txmp_file\n" if $verbose; rename ($xmp_file, $txmp_file); } } } ############################################################## # do_other_files - rename, copy, move XMP, WAV and RAW files ############################################################## sub do_other_files { my $action = shift; # COPY, MOVE or RENAME return unless ($action == RENAME or $action == COPY or $action == MOVE); my @suffixes; # we have to support upper and lower case XMP suffix push @suffixes, ('.xmp', '.XMP') if $config{XMP_file_operations}; push @suffixes, ('.wav', '.WAV') if $config{WAV_file_operations}; push @suffixes, ('.nef', '.NEF', '.crw', '.CRW') if $config{RAW_file_operations}; return unless (@suffixes); #print "$action - suffixes: $_\n" foreach (@suffixes); my $dpic = shift; my $ndpic = shift; my $error_ref = shift; # reference to error string to add warnings etc. my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $dpic_no_suffix = "$dir/$name"; my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $ndpic_no_suffix = "$ndir/$nname"; foreach my $suffix (@suffixes) { if ((-f $dpic_no_suffix.$suffix)) { my $t_file = "$ndpic_no_suffix$suffix"; if (-f $t_file) { $$error_ref .= "$suffix file $t_file exists, file not "; $$error_ref .= "renamed!\n" if $action == RENAME; $$error_ref .= "copyed!\n" if $action == COPY; $$error_ref .= "moved!\n" if $action == MOVE; } else { #print "rename, copy, move $action $dpic_no_suffix${suffix} to $t_file\n"; #if $verbose; rename ($dpic_no_suffix.$suffix, $t_file) if $action == RENAME; move ($dpic_no_suffix.$suffix, $ndir) if $action == MOVE; mycopy ($dpic_no_suffix.$suffix, $t_file, ASK_OVERWRITE) if $action == COPY; } } } } ############################################################## # delete_XMP_file - delete XMP file if any ############################################################## sub delete_XMP_file { # XMP files follow picture file operations if this option is set to 1 return unless $config{XMP_file_operations}; my $dpic = shift; my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $dpic_no_suffix = "$dir/$name"; my $xmp_file = ''; # we have to support upper and lower case XMP suffix if ((-f $dpic_no_suffix.'.xmp')) { $xmp_file = $dpic_no_suffix.'.xmp'; } elsif ((-f $dpic_no_suffix.'.XMP')) { $xmp_file = $dpic_no_suffix.'.XMP'; } else { } if ($xmp_file ne '') { print "remove $xmp_file\n" if $verbose; removeFile($xmp_file); } } ############################################################## # rename_WAV_file - rename WAV audio file if any ############################################################## # todo: check if this function could be integrated into the XMP function (rename with any suffix) sub rename_WAV_file { # WAV files follow picture file operations if this option is set to 1 return unless $config{WAV_file_operations}; my $dpic = shift; my $ndpic = shift; my $error_ref = shift; # reference to error string to add warnings etc. my ($name,$dir,$suffix) = fileparse($dpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $dpic_no_suffix = "$dir/$name"; my ($nname,$ndir,$nsuffix) = fileparse($ndpic, '\.[^.]*'); # suffix = . and not-. (one dot and zero or more non-dots) my $ndpic_no_suffix = "$ndir/$nname"; my $wav_file = ''; # we have to support upper and lower case WAV suffix if ((-f $dpic_no_suffix.'.wav')) { $wav_file = $dpic_no_suffix.'.wav'; } elsif ((-f $dpic_no_suffix.'.WAV')) { $wav_file = $dpic_no_suffix.'.WAV'; } else { } if ($wav_file ne '') { my $twav_file = "$ndir/${nname}.wav"; if (-f $twav_file) { $$error_ref .= "WAV file $twav_file exists, file not renamed!\n"; } else { print "rename $wav_file to $twav_file\n" if $verbose; rename ($wav_file, $twav_file); } } } ############################################################## # linkPicsDialog - link the selected pictures to a choosen dir ############################################################## sub linkPicsDialog { if ($EvilOS) { $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", -title => 'Error', -type => 'OK'); return; } my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $targetdir = getDirDialog("Link pictures to"); return if ($targetdir eq ""); linkPics($targetdir, @sellist); } ############################################################## # linkPics - link the selected pictures to a choosen dir ############################################################## sub linkPics { my $targetdir = shift; my @sellist = @_; if ($EvilOS) { $top->messageBox(-icon => 'warning', -message => "Sorry, but this OS does not support symbolic links.", -title => 'Error', -type => 'OK'); return; } return unless (-d $targetdir); return if (@sellist < 1); makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic); my $i = 0; my $rc = 1; my $n = 0; # count successfull copied pictures my $pw = progressWinInit($top, "Link pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $pic = basename($dpic); $i++; progressWinUpdate($pw, "linking ($i/".scalar @sellist.") ...", $i, scalar @sellist); $tpic = "$targetdir/$pic"; # Do not link to a link. Always link to the original image. next if (!getRealFile(\$dpic)); $thumbpic = getThumbFileName($dpic); $thumbtpic = getThumbFileName($tpic); $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); if (mylink ("$dpic", "$tpic", 1)) { $n++; # if the link is created successfully, we COPY the thumbnail # should the thumb also be a link??? if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ("$thumbpic","$thumbtpic", OVERWRITE) } # unless ((defined $mode) and ($mode eq "backup")) { # # ask to link non-JPEG file, if any # foreach my $suf (split /\|/, $nonJPEGsuffixes) { # $njpic = $dpic; # $njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i; # if (-f $njpic) { # my $rc = $top->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to link it too?", # -title => "Link non-JPEG?", -type => 'OKCancel'); # next if ($rc !~ m/Ok/i); # mylink("$njpic", "$targetdir"); # } # } # } } } # foreach - end progressWinEnd($pw); $userinfo = "ready! ($n/".scalar @sellist." linked)"; $userInfoL->update; reselect($picLB, @sellist); } ############################################################## # getDirDialog - let the user select a dir ############################################################## sub getDirDialog($) { my $title = shift; my $text = "Please choose a target folder from the list below or open the folder browser\nby double clicking the first item or by just pressing OK.\n\nfolders from the hotlist and recently visited direcories:"; my $another = "Open folder browser"; my @list; my @sellist; # sort dirs hash by numerical value reverse (number of accesses) # %dirHotlist contains folders used as target in open dir, copy, link, move, ... operations foreach (sort { $dirHotlist{$b} <=> $dirHotlist{$a} } keys %dirHotlist) { next if (!-d $_); # skip non existing dirs next if ($_ eq $trashdir); push @list, $_; last if (@list > 15); # 15 entries should be enough } # add the last used folders foreach (reverse @dirHist) { next if (!-d $_); push @list, $_; } # remove duplicates and sort folder list alphabetical my %saw; @saw{@list} = (); @list = (); @list = sort keys %saw; # put the "Open folder browser" item at the first position unshift @list, $another; return '' unless (mySelListBoxDialog($title, $text, SINGLE, 'OK', \@sellist, @list)); my $dir = ''; $dir = $list[$sellist[0]] if $sellist[0]; if (($dir eq '') or ($dir eq $another)) { my $dsdir = dirDialog($actdir); if ( defined $dsdir ) { $dir = $dsdir; } } $dir =~ s/\/\//\//g; # replace all // with / if (-d $dir) { dirSave($dir); } else { $dir = ''; } return $dir; } ############################################################## # movePicsDialog - move the selected pictures to a choosen dir ############################################################## sub movePicsDialog($) { my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $targetdir = getDirDialog("Move pictures to"); return if ($targetdir eq ""); movePics($targetdir, $lb, @sellist) } ############################################################## # movePics - move the selected pictures to a choosen dir ############################################################## sub movePics { my $targetdir = shift; my $lb = shift; # the reference to the active listbox widget my @sellist = @_; return unless (-d $targetdir); return if (@sellist < 1); makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); my ($pic, $dpic, $dir, $tpic, $thumbpic, $thumbtpic, $njpic); my $i = 0; my $rc = 1; my $changed = 0; my $errors = ''; my $pw = progressWinInit($lb, "Move pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $pic = basename($dpic); $dir = dirname($dpic); next if ($targetdir eq $dir); $i++; progressWinUpdate($pw, "moving ($i/".scalar @sellist.") ...", $i, scalar @sellist); $tpic = "$targetdir/$pic"; $thumbpic = getThumbFileName($dpic); $thumbtpic = getThumbFileName($tpic); $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); # move picture if (!move ($dpic, $tpic)) { $errors .= "Could not move $dpic to $tpic: $!"; } else { $changed++; # count nr of successfull moves # only if move was successfull, we also move the thumbnail if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { if (!move ($thumbpic, $thumbtpic)) { $errors .= "Could not move thumbnail $thumbpic to $thumbtpic: $!"; } } # move XMP, WAV, RAW files do_other_files(MOVE, $dpic, $tpic, \$errors); # ask to move non-JPEG file, if any # foreach my $suf (split /\|/, $nonJPEGsuffixes) { # $njpic = $dpic; # $njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i; # if (-f $njpic) { # my $rc = $lb->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to move it too?", # -title => "Move non-JPEG?", -type => 'OKCancel'); # next if ($rc !~ m/Ok/i); # if (!move ("$njpic","$targetdir")) { # $errors .= "Could not move $njpic to $targetdir: $!"; # } # } # } $searchDB{$tpic} = $searchDB{$dpic}; # copy meta info in search database delete $searchDB{$dpic}; # delete meta info of moved pic in search database } } progressWinEnd($pw); if ($errors ne '') { $errors = "These errors occured while moving ".scalar @sellist." selected pictures:\n$errors"; showText('Error while moving', $errors, NO_WAIT); } if ($changed == 0) { # nothing happend, no update needed $userinfo = "ready! (nothing moved)"; $userInfoL->update; return; } my @pics = $lb->info('children'); if ($#pics > $#sellist) { # if not all pictures were selected #stopButStart(); foreach $dpic (@sellist) { #last if stopButCheck(); $lb->delete('entry', $dpic) if ($lb->info('exists', $dpic)); reloadPic() if (($lb == $picLB) and ($dpic eq $actpic)); } #stopButEnd(); } else { # all pictures were moved updateThumbsPlus() if ($lb == $picLB); } showNrOf() if ($lb == $picLB); $userinfo = "ready! ($changed/".scalar @sellist." moved)"; $userInfoL->update; } ############################################################## # overwritePic ############################################################## sub overwritePic { my $old = shift; # this will be overwritten ny $new my $new = shift; # this will overwrite $old my $nr = shift; # the number of all (left) files to check, if this nr is > 1 there will be two "for all" buttons return 1 if (!-f $old); # if $old does not exists, we don't need to ask ... my $rc = 3; # dummy value my $olddir = dirname($old); my $oldpic = basename($old); my $oldthumb = getThumbFileName($old); my $olddate = getFileDate($old, FORMAT); my $oldsize = getFileSize($old, FORMAT); my $newdir = dirname($new); my $newpic = basename($new); my $newthumb = getThumbFileName($new); my $newdate = getFileDate($new, FORMAT); my $newsize = getFileSize($new, FORMAT); # open window my $oww = $top->Toplevel(); $oww->title("Overwrite?"); $oww->iconimage($mapiviicon) if $mapiviicon; $oww->Label(-anchor => 'w', -text => "\"$oldpic\" exists. Do you want to overwrite it?", -bg => $config{ColorBG})->pack; my $nF = $oww->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3); my $ca = $oww->Canvas(-width => 100, -height => 50)->pack(-padx => 3, -pady => 3); my $oF = $oww->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3); # draw a red arrow $ca->createLine(50, 0,50,50, -width => 6, -fill => "red"); $ca->createLine(50,50,70,20, -width => 6, -fill => "red"); $ca->createLine(50,50,30,20, -width => 6, -fill => "red"); my $newP = $oww->Photo(-file => "$newthumb", -gamma => $config{Gamma}) if (-f $newthumb); my $oldP = $oww->Photo(-file => "$oldthumb", -gamma => $config{Gamma}) if (-f $oldthumb); $nF->Label(-image => $newP)->pack(-side => "left") if $newP; $oF->Label(-image => $oldP)->pack(-side => "left") if $oldP; $nF->Label(-justify => "left", -text => "this file\n$newsize\n$newdate\n$newdir", -bg => $config{ColorBG})->pack(-padx => 3, -side => "left"); $oF->Label(-justify => "left", -text => "will overwrite this file\n$oldsize\n$olddate\n$olddir", -bg => $config{ColorBG})->pack(-padx => 3, -side => "left"); $oww->Label(-anchor => 'w', -text => "$nr files to go ...", -bg => $config{ColorBG})->pack if ($nr > 1); my $bF = $oww->Frame()->pack(-padx => 3, -pady => 3, -fill => 'x', -expand => 1); $bF->Button(-text => "Overwrite", -command => sub { $rc = 1; })->pack(-side => "left", -fill => 'x', -expand => 1); $bF->Button(-text => "Overwrite All", -command => sub { $rc = 2; })->pack(-side => "left", -fill => 'x', -expand => 1) if ($nr > 1); $bF->Button(-text => 'Cancel', -command => sub { $rc = 0; })->pack(-side => "left", -fill => 'x', -expand => 1); $bF->Button(-text => "Cancel All", -command => sub { $rc = -1; })->pack(-side => "left", -fill => 'x', -expand => 1)if ($nr > 1); $oww->Popup; $oww->waitVariable(\$rc); $oww->withdraw(); $oww->destroy(); die "wrong rc value: $rc" if (($rc < -1) or ($rc > 2)); return $rc; } ############################################################## # sendTo - send all selected pics via email ############################################################## sub sendTo { my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); # check if some files are links return if (!checkLinks($lb, @sellist)); if ($config{MailTool} =~ m/thunderbird/i) { } elsif ($config{MailTool} =~ m/evolution/i) { } else { $top->messageBox(-icon => 'warning', -message => "Sorry, the selected mail tool ($config{MailTool}) is not supported! Please try to find the command line syntax to send a mail with attachment and send this info to Martin-Herrmann\@gmx.de.", -title => "External mail tool not yet supported", -type => 'OK'); return; } if ((system "$config{MailTool} --version") != 0) { $top->messageBox(-icon => 'warning', -message => "Sorry, no mail tool ($config{MailTool}) found! Please use Ctrl-o (Options->Advanced->External mail tool) to select the right tool.", -title => "External mail tool not available", -type => 'OK'); return; } # open dialog window my $myDiag = $top->Toplevel(); $myDiag->title("Change size/quality before sending"); $myDiag->iconimage($mapiviicon) if $mapiviicon; $myDiag->Label(-text =>"Change the size and/or quality of the ".scalar @sellist." selected pictures before sending via email.", -bg => $config{ColorBG} )->pack(-anchor => 'w',-padx => 3,-pady => 3); $myDiag->Checkbutton(-variable => \$config{MailPicNoChange}, -text => "leave pictures untouched", -command => sub { my $state = "disabled"; $state = 'normal' unless ($config{MailPicNoChange}); setChildState($myDiag->{sq}, $state); setChildState($myDiag->{sl}, $state); })->pack(-anchor => 'w'); $myDiag->{sq} = labeledScale($myDiag, 'top', 24, "Quality (%)", \$config{MailPicQuality}, 10, 100, 1); qualityBalloon($myDiag->{sq}); $myDiag->{sl} = labeledScale($myDiag, 'top', 24, "Maximum length (pixels)", \$config{MailPicMaxLength}, 10, 2000, 1); my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $myDiag->destroy(); $userinfo = "sending ".scalar @sellist." pictures via email"; $userInfoL->update; my $pics = ""; my $dpic; unless ($config{MailPicNoChange}) { # copy to trash $userinfo = "send to: copy pictures to temp folder"; $userInfoL->update; foreach $dpic (@sellist) { mycopy($dpic, $trashdir, OVERWRITE); } # exchange the folder from original to trash foreach (@sellist) { $_ = "$trashdir/".basename($_); } # resize foreach $dpic (@sellist) { $userinfo = "send to: resizing pictures ".basename($dpic); $userInfoL->update; my $command = "mogrify"; $command .= " -geometry \"".$config{MailPicMaxLength}.'x'.$config{MailPicMaxLength}.">\""; $command .= " -quality ".$config{MailPicQuality}." \"$dpic\""; print "changeSizeQuality: com = $command\n" if $verbose; execute($command); } } foreach $dpic (@sellist) { if ($pics eq "") { $pics = "file://$dpic"; # the first one } else { $pics .= ",file://$dpic"; # additional pics } } # /usr/bin/evolution mailto:Martin-Herrmann@gmx.de?attach=file:///home/pic1.jpg\&attach=file:///home/pic2.jpg\&subject=My%20Pictures\&body=Text%20for%20description & $userinfo = "send to: starting email client ..."; $userInfoL->update; my $command = "$config{MailTool} "; if ($config{MailTool} =~ m/thunderbird/i) { $command .= "-compose \"subject=Pictures,attachment=\'$pics\'\""; } elsif ($config{MailTool} =~ m/evolution/i) { $command .= "\"mailto:Receiver?attach=\'$pics\'\\&subject=Pictures\\&body=Text\"" ; } else { # this case is already handled adove. } $command .= " &" unless ($EvilOS); print "command = $command\n";# if $verbose; (system "$command") == 0 or warn "$command failed: $!"; # todo: this does not work, the pic still has to be there, when the user presses the send button # extra dir which will be deleted at the next startup or simply leave it in the trash? # $top->after(5000); # wait 5 secs for mail client to pic up the pictures (ToDo) # $userinfo = "send to: removing temp pictures ..."; $userInfoL->update; # $top->after(1000); # unless ($config{MailPicNoChange}) { # # remove pics in trash # foreach (@sellist) { # removeFile($_); # } # } $userinfo = "ready!"; $userInfoL->update; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Default", -command => sub { $config{MailPicNoChange} = 0; $config{MailPicQuality} = 75; $config{MailPicMaxLength} = 800; my $state = "disabled"; $state = 'normal' unless ($config{MailPicNoChange}); setChildState($myDiag->{sq}, $state); setChildState($myDiag->{sl}, $state); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); $ButF->Button(-text => 'Cancel', -command => sub { $myDiag->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->Popup; if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab $myDiag->grab; $myDiag->after(50, sub{$myDiag->grabRelease}); } $OKB->focus; $myDiag->waitWindow(); $myDiag->destroy() if Tk::Exists($myDiag); } ############################################################## # convertPics - convert selected pics to another format ############################################################## sub convertPics { my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return if (!checkExternProgs("sendTo", "convert")); # check if some files are links return if (!checkLinks($lb, @sellist)); # open dialog window my $win = $top->Toplevel(); $win->title("Convert to other picture formats"); $win->iconimage($mapiviicon) if $mapiviicon; $win->Label(-text =>"Convert the ".scalar @sellist." selected pictures to another picture format.\nThe orininal files will be left untouched.\nThe converted pictures are stored in the actual diretory.", -bg => $config{ColorBG} )->pack(-anchor => 'w',-padx => 3,-pady => 3); my $notebook = $win->NoteBook(-width => 500, -background => $config{ColorBG}, # background of active page (including its tab) -inactivebackground => $config{ColorEntry}, # tabs of inactive pages -backpagecolor => $config{ColorBG}, # background behind notebook )->pack(-expand => "yes", -fill => "both", -padx => 5, -pady => 5); my $format = "gif"; my $gifF = $notebook->add("gif", -label => "GIF", -raisecmd => sub { $format = "gif"; }); my $pngF = $notebook->add("png", -label => "PNG", -raisecmd => sub { $format = "png"; }); my $tifF = $notebook->add("tiff", -label => "TIFF", -raisecmd => sub { $format = "tiff"; }); $win->{PicQuality} = 95; $pngF->{sq} = labeledScale($pngF, 'top', 24, "Quality (%)", \$win->{PicQuality}, 0, 100, 1); $balloon->attach($pngF->{sq}, -msg => 'Quality range from 0% (fastest compression) to 100% (best but slowest). For 0%, the Huffman-only strategy is used, which is fastest but not necessarily the worst compression. The default is 75%, which means nearly the best compression with adaptive filtering. If the image is a natural image (a photo), then use "adaptive" filtering with quality 95%. The quality setting has no effect on the appearance of PNG images, since the compression is always lossless. For PNG images, quality is regarded as two decimal figures. The first (tens) is the zlib compression level, 1-9. The second (ones digit) is the PNG filtering type: 0 is none, 1 is "sub", 2 is "up", 3 is "average", 4 is "Paeth", and 5 is "adaptive".'); my $ButF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $win->destroy(); #my $format = $notebook->raised(); print "format = $format\n"; $userinfo = "converting ".scalar @sellist." $format pictures"; $userInfoL->update; print $userinfo."\n"; my ($dpic, $ndpic); my $i = 0; my $pw = progressWinInit($top, "Convert pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); progressWinUpdate($pw, "convert picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); $i++; $ndpic = $dpic; $ndpic =~ s/(.*)\.jp(g|eg)$/$1.$format/i; if (-f $ndpic) { my $rc = $top->messageBox(-icon => 'question', -message => "$ndpic exists already.\nShould I really overwrite it?", -title => "Overwrite?", -type => 'OKCancel'); next if ($rc !~ m/Ok/i); } $userinfo = "convert picture ".basename($dpic); $userInfoL->update; my $command = "convert"; $command .= " -quality ".$win->{PicQuality} if ($format eq "png"); $command .= " \"$dpic\" \"$ndpic\""; print "convertPics:: com = $command\n"; # if $verbose; execute($command); progressWinUpdate($pw, "convert picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); } progressWinEnd($pw); $userinfo = "ready!"; $userInfoL->update; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); $ButF->Button(-text => 'Cancel', -command => sub { $win->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->Popup; if ($EvilOS) { # sometimes to dialog disappears when clicked on, so we need a short grab $win->grab; $win->after(50, sub{$win->grabRelease}); } $OKB->focus; $win->waitWindow(); $win->destroy() if Tk::Exists($win); } ############################################################## # renamePic - let the user rename the seleced pictures ############################################################## sub renamePic { my $lb = shift; my @sellist = $lb->info('selection'); my @resellist = @sellist; return unless checkSelection($lb, 1, 0, \@sellist); my ($pic, $dir, $dpic, $newname, $rc, $thumb); my $i = 0; my $errors = ''; my $pw = progressWinInit($lb, "Rename pictures"); foreach $dpic (@sellist){ last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "renaming picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); $dir = dirname($dpic); $thumb = getThumbFileName($dpic); $newname = $pic; next if (!checkWriteable($dpic)); $rc = myEntryDialog("Rename picture", "Please enter a new name for file\n$pic\n(in $dir)", \$newname, getThumbFileName($dpic)); next if (($rc ne 'OK') or ($newname eq "") or ($newname eq $pic)); # check for correct JPEG suffix if (is_a_JPEG($dpic) and ($newname !~ /(.*)(\.jp(g|eg))/i)) { $newname =~ /(.*)\.(.*)/; my $correct = "$1.jpg"; my $rc = $lb->messageBox(-icon => 'question', -message => "$newname has not a correct JPEG suffix.\nShould I change it to $correct?", -title => "Change suffix?", -type => 'OKCancel'); if ($rc eq "Ok") { $newname = "$correct"; } } my $ndpic = "$dir/$newname"; # check if new file name already exists if (-f $ndpic) { my $rc = $lb->Dialog( -title => "File exists", -text => "$newname already exists!", -buttons => ['Overwrite', 'Cancel'])->Show(); next if ($rc ne 'Overwrite'); # skip this file } if (!rename ($dpic, $ndpic)) { $errors .= "Could not rename $pic to $newname: $!"; next; } # correct the searchDB $searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database delete $searchDB{$dpic}; # delete meta info of renamed pic in search database renameCachedPic($dpic, $ndpic); foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); } if ($dpic eq $actpic) { $actpic = $ndpic; } hlistEntryRename($lb, $dpic, $ndpic); # change the displayed name $lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($newname)); $lb->itemConfigure($ndpic, $lb->{filecol}, -text => getAllFileInfo($ndpic)); # rename thumbnail if (-f $thumb) { if (!rename ($thumb, dirname($thumb)."/$newname")) { $errors .= "Could not rename thumbnail $pic to $newname: $!"; } } # rename XMP, WAV, RAW files do_other_files(RENAME, $dpic, $ndpic, \$errors); # rename exif info file, if any if (-f "$dir/$exifdirname/$pic") { if (!rename ("$actdir/$exifdirname/$pic", "$actdir/$exifdirname/$newname")) { $errors .= "Could not rename exif info file $pic to $newname: $!"; } } # rename backup file, if any renameBackup($lb, $dpic, $newname, ASK); } if ($errors ne '') { $errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors"; showText('Error while renaming', $errors, NO_WAIT); } progressWinEnd($pw); reselect($lb, @resellist); if ($lb == $picLB) { setTitle(); $userinfo = "ready! ($i/".scalar @sellist." renamed)"; $userInfoL->update; } } ############################################################## # renameNonJPEG - check if there are any non-JPEG files # and rename them ############################################################## # todo enhance this to cope with other formats sub renameNonJPEG { my $dpic = shift; my $newname = shift; foreach my $suf (split /\|/, $nonJPEGsuffixes) { my $njpic = $dpic; $njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i; if (-f $njpic) { my $nnjpic = "$actdir/$newname"; $nnjpic =~ s/(.*)\.jp(g|eg)$/$1\.$suf/i; my $rc = $top->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to rename it to:\n\"".basename($nnjpic)."\"?", -title => "Rename non-JPEG?", -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); if (!rename ("$njpic", "$nnjpic")) { $top->messageBox(-icon => 'warning', -message => "Could not rename non-JPEG picture $njpic to $nnjpic: $!", -title => 'Error', -type => 'OK'); } } } return 1; } ############################################################## # showBackup ############################################################## sub showBackup { my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'info', -message => "Please select exacty one picture for this function.", -title => "Wrong selection", -type => 'OK'); return; } my $bpic = buildBackupName($sellist[0]); if (-f $bpic) { showPicInOwnWin($bpic); } else { $userinfo = 'Sorry, no backup "'.basename($bpic).'" found.'; $userInfoL->update; } } ############################################################## # renameBackup - check if there is a backup file # and rename it ############################################################## sub renameBackup { my $lb = shift; my $dpic = shift; my $newname = shift; my $ask = shift; return unless $config{RenameBackup}; my $bpic = buildBackupName($dpic); return unless (-f $bpic); # no backup - no rename my $dir = dirname($dpic); my $pic = basename($dpic); my $nbpic = basename(buildBackupName("$dir/$newname")); my $rc = $nbpic; if ((defined $ask) and ($ask == ASK)) { $rc = myButtonDialog("Rename backup?", "Should I also rename the backup file ".basename($bpic)."?\nRename to:", undef, $nbpic, $pic, 'Cancel'); return if ($rc =~ m/Cancel/i); } my $new_bak_name = "$dir/$rc"; if (-f $new_bak_name) { # should not happen $lb->messageBox(-icon => 'warning', -message => "Backup picture $bpic should be renamed to $new_bak_name. But $new_bak_name exists! Skipping rename action.", -title => 'Error', -type => 'OK'); return; } if (rename ($bpic, $new_bak_name)) { hlistEntryRename($lb, $bpic, $new_bak_name); # change the displayed name if ($lb->info("exists", $new_bak_name)) { $lb->itemConfigure($new_bak_name, $picLB->{thumbcol}, -text => getThumbCaption($new_bak_name)); $lb->itemConfigure($new_bak_name, $picLB->{filecol}, -text => getAllFileInfo($new_bak_name)); } # correct the searchDB $searchDB{$new_bak_name} = $searchDB{$bpic}; # copy meta info in search database delete $searchDB{$bpic}; # rename thumbnail my $thumb = getThumbFileName($bpic); if (-f $thumb) { my $nthumb = getThumbFileName($new_bak_name); if (!rename ($thumb, $nthumb)) { $lb->messageBox(-icon => 'warning', -message => "Could not rename thumbnail $thumb to $nthumb: $!", -title => 'Error', -type => 'OK'); } } } else { $lb->messageBox(-icon => 'warning', -message => "Could not rename backup picture $bpic to $new_bak_name: $!", -title => 'Error', -type => 'OK'); } } ############################################################## # getRenameFormat ############################################################## sub getRenameFormat { my $format = $config{FileNameFormat}; # copy to tmp variable my $rc = myEntryDialog("Enter file name format", 'Please enter the file name format %f = file name (without suffix) %xa = EXIF aperture %y = year (yyyy) %xe = EXIF exposure time %m = month (mm) %xm = EXIF camera model %d = day (dd) %xr = EXIF artist %h = hour (hh) %iw = image width %M = Minute (MM) %ih = image height %s = second (ss) %F = file name substring Examples: "%y%m%d-%h%M%s" will rename all pictures to their internal EXIF date e.g. 20081231-155959 (the file date will be used, if there is no EXIF date). "%F4-7" will rename PIC0001.jpg to file name substring from 4th char up to 7th char e.g 0001.jpg If you select 3 pictures and enter "flower" as file name format, the pics will be renamed to "flower.jpg", "flower-01.jpg" and "flower-02.jpg". The suffix ".jpg" will always be added. Leave the format line below empty to use the default format ('.$config{FileNameFormatDef}.').', \$format); return 'Cancel' if ($rc ne 'OK'); if ($format eq "") { $format = $config{FileNameFormatDef}; } if ($format =~ m/.*\/.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but a / is not allowed in a file name.", -title => 'Error', -type => 'OK'); return 'Cancel'; } $config{FileNameFormat} = $format; # save back to the config return $rc; } ############################################################## # renameSmart - rename the selected pictures using e.g. the EXIF date ############################################################## sub renameSmart { my $lb = shift; my @sellist = $lb->info('selection'); my @resellist = @sellist; return unless checkSelection($lb, 1, 0, \@sellist); my ($pic, $dir, $dpic, $ndpic, $rc, @datetime, @times, $time, @dates, $date, $n, $base); my $doForAll = 0; my $errors = ''; my $useFileDate = undef; my @renamed; $rc = getRenameFormat(); return if ($rc ne 'OK'); my $format = $config{FileNameFormat}; my $i = 0; my $pw = progressWinInit($lb, "smart rename"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; $pic = basename($dpic); $dir = dirname($dpic); progressWinUpdate($pw, "renaming ($i/".scalar @sellist.") ...", $i, scalar @sellist); unless (-f $dpic) { # may happen when renaming backups $errors .= "$pic: not found, seems to be an already renamed backup? - skipping\n"; next; } my $newname = ""; $rc = applyRenameFormat($dpic, $format, \$newname, \$doForAll); next if ($rc eq "Skip this picture"); last if ($rc eq "Cancel all"); $newname = findNewName("$dir/$newname"); # todo: handle backup pics it should be possible to preserve the "-bak" part $ndpic = "$dir/$newname"; if (-f $ndpic) { # just a safety check $errors .= "$pic: new name $newname already exists - skipping\n"; next; } # rename the picture if (renamePicInt($dpic, $ndpic, \$errors)) { push @renamed, $ndpic; # rename the hlist entry hlistEntryRename($lb, $dpic, $ndpic); # display the new file name $lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($ndpic)); $lb->itemConfigure($ndpic, $lb->{filecol}, -text => getAllFileInfo($ndpic)); foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); } } } # fix the renaming of the first pic of a set (pic.jpg -> pic-00.jpg) my $renamed = renameSmartFix(\$errors, @renamed); foreach my $dpic (keys %{$renamed}) { my $ndpic = $$renamed{$dpic}; # rename the hlist entry hlistEntryRename($lb, $dpic, $ndpic); # display the new file name $lb->itemConfigure($ndpic, $lb->{thumbcol}, -text => getThumbCaption($ndpic)); $lb->itemConfigure($ndpic, $lb->{filecol}, -text => getAllFileInfo($ndpic)); foreach (@resellist) { $_ = $ndpic if ($_ eq $dpic); } } progressWinEnd($pw); reselect($lb, @resellist); if ($lb == $picLB) { $userinfo = "ready! (renamed $i/".scalar @sellist.")"; $userInfoL->update; setTitle(); } if ($errors ne '') { $errors = "These errors occured while renaming ".scalar @sellist." selected pictures:\n$errors"; showText("Error while renaming", $errors, NO_WAIT); } $lb->focusForce; } ############################################################## # renamePicInt - rename a pic, the thumb, backup, exif, nonjpeg # searchDB and cached pic ############################################################## sub renamePicInt { my $dpic = shift; my $ndpic = shift; my $errors = shift; # ref to error string my $pic = basename($dpic); my $dir = dirname($dpic); my $npic = basename($ndpic); my $rc = 0; if (!rename ($dpic, $ndpic)) { # rename failed $$errors .= "Could not rename $pic to $npic: $!\n"; $rc = 0; } else { # rename worked # rename the thumbnail my $thumbdir = dirname(getThumbFileName($dpic)); if (!rename ("$thumbdir/$pic", "$thumbdir/$npic")) { $$errors .= "Could not rename thumbnail $pic to $npic: $!\n"; } # rename exif info file, if any if (-f "$dir/$exifdirname/$pic") { if (!rename ("$dir/$exifdirname/$pic", "$dir/$exifdirname/$npic")) { $$errors .= "Could not rename exif info file $pic to $npic: $!\n"; } } # rename the XMP, WAV, RAW sidecar files, if any do_other_files(RENAME, $dpic, $ndpic, \$errors); # rename theWAV audio file, if any #rename_WAV_file($dpic, $ndpic, \$errors); # rename backup file, if any renameBackup($picLB, $dpic, $npic); # rename non-JPEG file, if any renameNonJPEG($dpic, $npic); # correct the searchDB $searchDB{$ndpic} = $searchDB{$dpic}; # copy meta info in search database delete $searchDB{$dpic}; # delete meta info of renamed pic in search database renameCachedPic($dpic, $ndpic); $actpic = $ndpic if (($dpic eq $actpic) and (-f $ndpic)); $rc = 1; } return $rc; } ############################################################## # renameSmartFix - fix the renaming of renameSmart by adding # "-000" to the first pic of a set # e.g. pic1.jpg and pic1-001.jpg will become # pic1-000.jpg and pic1-001.jpg # todo: this really is an ugly solution ############################################################## sub renameSmartFix { my $errors = shift; # ref to scalar, errors will be added my @piclist = @_; return unless (@piclist); my %hash; $hash{$_} = 1 foreach (@piclist); my %renamed; # hash of the renamed files (key: old name, value: new name) # search the list for files matching file-001.jpg foreach my $dpic (@piclist) { if ($dpic =~ m/(.*)-001\.(.*)$/i) { # e.g. file-001.jpg my $pic = "$1.$2"; my $npic = "$1-000.$2"; # if there is a file named file.jpg if (defined $hash{$pic}) { # and no file named file-000.jpg unless (defined $hash{$npic}) { print "renameSmartFix: rename $pic to $npic\n" if $verbose; # we rename file.jpg to file-000.jpg if (renamePicInt($pic, $npic, $errors)) { $renamed{$pic} = $npic; } } } } } return \%renamed; } ############################################################## # applyRenameFormat ############################################################## sub applyRenameFormat { my $dpic = shift; my $format = shift; # e.g. %y%m%d-%h%M%s my $newname = shift; # reference to string my $doForAll = shift; # reference to bool my $pic = basename($dpic); $$newname = $format; # replace %f with the file name if (($format =~ m/\%f/) and ($pic =~ /(.*)\.(.*)/)) { my $name = $1; # $1 makes some problems in s/// $$newname =~ s/%f/$name/g; } # idea from Thierry Daucourt # replace %F with the file name substring if ($format =~ m/\%F(\d+)\-(\d+)/) { my $begin = $1 - 1; # we start with index 1, not 0 my $end = $2 - 1; if ($pic =~ /(.*)\.(.*)/) { my $name = $1; #print "begin: $begin end: $end length ($name): ",length($name),"\n"; # some safety checks if (($begin <= $end) and ($end < length($name)) and ($begin >= 0)) { $name = substr($name, $begin, $end - $begin + 1); } $$newname =~ s/\%F(\d+)\-(\d+)/$name/g; } } # get the date and replace it, only when needed if ($format =~ m/(\%y|\%m|\%d|\%h|\%M|\%s)/) { my $datestr = ""; $datestr = getEXIFDate($dpic); if ($datestr eq "") { $datestr = getFileDate($dpic, NO_FORMAT); $datestr = buildEXIFDateTime($datestr); unless ($$doForAll) { my $rc = checkDialog("Use file date?", "$pic has no EXIF date, shall I use the file date ($datestr) instead?", $doForAll, "don't ask again", getThumbFileName($dpic), 'OK', "Skip this picture", "Cancel all"); return $rc if (($rc eq "Skip this picture") or ($rc eq "Cancel all")); } } my @datetime = split / /, $datestr; my @times = split /:/, $datetime[1]; my @dates = split /:/, $datetime[0]; $$newname =~ s/%y/$dates[0]/g; $$newname =~ s/%m/$dates[1]/g; $$newname =~ s/%d/$dates[2]/g; $$newname =~ s/%h/$times[0]/g; $$newname =~ s/%M/$times[1]/g; $$newname =~ s/%s/$times[2]/g; } # get EXIF data and replace it, only when needed if ($format =~ m/(\%xa|\%xe|%xm|%xr)/) { my $aperture = sprintf("%02.1f", getEXIFAperture($dpic, NUMERIC)); $$newname =~ s/%xa/$aperture/g; my $exposure = sprintf("%.3f", getEXIFExposureTime($dpic, NUMERIC)); $$newname =~ s/%xe/$exposure/g; my $model = getEXIFModel($dpic); $model =~ tr/\000/ /; # remove null termination (\000) chars $model =~ s/( )+/ /g; # replace more than one space with one $model =~ s/\s+$//; # cut trailing whitespace $$newname =~ s/%xm/$model/g; my $artist = getEXIFArtist($dpic); $$newname =~ s/%xr/$artist/g; } # get image data and replace it, only when needed if ($format =~ m/(\%iw|\%ih)/) { my ($w, $h) = getSize($dpic); $$newname =~ s/%iw/$w/g; $$newname =~ s/%ih/$h/g; } print "applyRenameFormat: $pic -> -$$newname- (format: $format)\n" if $verbose; return 'OK'; } ############################################################## # findNewName - find a unused name by adding a number # e.g. name-001.jpg # input: filename with dir! with or without suffix # output: new filename - no dir!!! ############################################################## sub findNewName { my $dpic = shift; my $dir = dirname($dpic); my $pic = basename($dpic); if ($pic !~ /(.*)(\.jp(g|eg))/i) { $pic .= ".jpg"; # pic does not have a jpeg suffix - adding .jpg } $pic =~ /(.*)(\.jp(g|eg))/i; # now split again (we need $1 and $2) my $base = $1; my $new = $base; my $suffix = $2; # if a file with this name already exists, we add a number for ( 1 .. 999 ) { # three digits if (-f "$dir/$new$suffix") { $new = sprintf "%s-%03d", $base, $_; # three digits } else { last; } } print "findNewName: $pic -> $new$suffix\n" if $verbose; return "$new$suffix"; } ############################################################## # updateThumbsPlus - update and show the actual pic again ############################################################## sub updateThumbsPlus { updateThumbs(); showPic($actpic); } ############################################################## # updateThumbs - reads the pictures of the actual dir, shows the # thumbnails, the given picture and generates # the thumbnails ############################################################## sub updateThumbs { $userinfo = "loading thumbnails ..."; $top->update; checkCachedPics(); canvasHide(); # delete all photo objects (thumbnnails) foreach (keys %thumbs) { print "updateThumbs: deleting thumbnail object of $_\n" if $verbose; $thumbs{$_}->delete if (defined $thumbs{$_}); # delete photo object delete $thumbs{$_}; # delete hash entry } if ($verbose) { my @check = $top->imageNames; print " there are ".scalar @check." pics left\n"; } if (showThumbs()) { $userinfo = "loading thumbnails ... ready"; $userInfoL->update; generateThumbs(ASK, SHOW); } else { $userinfo = "user abord (not all pictures are loaded!)"; $userInfoL->update; } showNrOf(); check_new_keywords(); } ############################################################## # check_new_keywords - check if new keywords were found in the pictures and ask to add them to the catalog ############################################################## sub check_new_keywords { return unless ($config{CheckNewKeywords}); return if (keys %new_keywords <= 0); return unless (get_new_keywords()); # open window my $win = $top->Toplevel(); $win->title('New IPTC keywords'); $win->iconimage($mapiviicon) if $mapiviicon; my $text = 'Found new IPTC keywords, please choose how to proceed.'; $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 2, -scrollbars => 'osoe', -selectmode => 'extended', -width => 80, -height => 30, )->pack(-expand => 1, -fill => "both"); bindMouseWheel($tlb); $tlb->header('create', 0, -text => 'Keyword', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 1, -text => 'Occurance', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $butF1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $butF2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $butF1->Button(-text => 'add selected to keyword catalog', -command => sub { my @sellist = $tlb->info('selection'); return unless (@sellist); add_new_keywords(\@sellist); my $nr = show_new_keywords($tlb); $win->destroy() if ($nr < 1); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $butF1->Button(-text => 'add selected to ignore list', -command => sub { my @sellist = $tlb->info('selection'); return unless (@sellist); foreach (@sellist) { $ignore_keywords{$_} = 1; delete $new_keywords{$_} if (defined $new_keywords{$_}); } my $nr = show_new_keywords($tlb); $win->destroy() if ($nr < 1); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $butF2->Checkbutton(-variable => \$config{CheckNewKeywords}, -text => "Check for new keywords")->pack(-side => 'left', -anchor => 'w'); my $Xbut = $butF2->Button(-text => 'Ask later', -command => sub { $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { selectAll($tlb); } ); $win->Popup(-popover => 'cursor'); repositionWindow($win); my $nr = show_new_keywords($tlb); $text = "Found $nr new IPTC keywords, please choose how to proceed."; $win->waitWindow; } ############################################################## # show_new_keywords - show a list of keywords in a hlist ############################################################## sub show_new_keywords { my $lb = shift; # the hlist widget my @list = get_new_keywords(); $lb->delete('all'); foreach my $key (sort @list) { $lb->add($key); $lb->itemCreate($key, 0, -text => $key, -style => $comS); $lb->itemCreate($key, 1, -text => $new_keywords{$key}, -style => $iptcS); } return (scalar @list); } ############################################################## # get_new_keywords - get new keywords from global hash, return list with new keywords (e.g. nature.animal.dog) ############################################################## sub get_new_keywords { my @new_keywords; foreach my $key (keys %new_keywords) { # skip if keyword is in the ignore list next if (defined $ignore_keywords{$key}); # replace dot "." with slash "/" - that's the way they are stored in the prekeys list my $keyS = $key; $keyS =~ s|\.|\/|g; # check if this is a new key (not in @prekeys list) if (!isInList($keyS, \@prekeys)) { # add new keyword to list push @new_keywords, $key; } } return @new_keywords; } ############################################################## # add_new_keywords - add new keywords to my keyword catalog (e.g. nature.animal.dog) ############################################################## sub add_new_keywords { my $new_keys_ref = shift; foreach my $key (@{$new_keys_ref}) { my $new_key = ''; # add hierarchical (joined) keywords e.g. nature.animal.dog as nature, nature.dog and nature.animal.dog foreach (split /\./, $key) { $new_key .= $_; push @prekeys, $new_key unless (isInList($new_key, \@prekeys)); $new_key .= '/'; } # remove from global hash delete $new_keywords{$key}; } # show in keyword window (if open) if (Exists($keyw)) { insertTreeList($keyw->{tree}, @prekeys); } } ############################################################## # deletePics - deletes selected pictures # mode: trash|rm # trash = move to $trashdir # rm = remove ############################################################## sub deletePics { my $lb = shift; # the reference to the active listbox widget my $mode = shift; # constant TRASH or REMOVE my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my @childs = $lb->info('children'); my $all = 0; $all = 1 if (@childs == @sellist); # all pics are selected my ($pic, $dpic, $thumb, $rc, $bakpic, $bakthumb, $njpic, $size, $str); my @dummylist = (); my $changed = 0; my $update = 0; my $lastOne; # build the show and the delete list foreach $dpic (@sellist) { $pic = basename($dpic); $size = getFileSize($dpic, FORMAT); $str .= sprintf "%-40s %10s\n", $pic, $size; # after deletion we select the one after the last one deleted $lastOne = $dpic; } my $reselectPic = $lb->info('next', $lastOne); if ($mode == REMOVE) { # remove mode $rc = myButtonDialog("Really delete?", "Please press Ok to delete these ".scalar @sellist." files.\nThere is no undelete!\n\nPath: $actdir\n\n$str", undef, 'OK', 'Cancel'); return unless ($rc eq 'OK'); } elsif ($mode == TRASH) { # remove to trash mode # check if the trash dir is available if (!-d $trashdir) { $lb->messageBox(-icon => 'warning', -message => "Trashdir $trashdir not found!\nPlease create this dir (shell: mkdir $trashdir) and retry.\n\nAborting.", -title => "Delete pictures", -type => 'OK'); return; } # check if we are in the trash dir if ($actdir eq $trashdir) { $lb->messageBox(-icon => 'warning', -message => "Please use to really remove files from the trash!", -title => "Delete pictures", -type => 'OK'); return; } makeDir("$trashdir/$thumbdirname", NO_ASK); } else { warn "deletePics called without or with a wrong mode ($mode). Aborting"; return; } my $errors = ""; my $i = 0; my $pw = progressWinInit($lb, "Delete pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; $pic = basename($dpic); $bakpic = $dpic; $bakpic =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i; $thumb = getThumbFileName($dpic); $bakthumb = $thumb; $bakthumb =~ s/(.*)(\.jp(g|eg))/$1-bak$2/i; progressWinUpdate($pw, "deleting ($i/".scalar @sellist.") ...", $i, scalar @sellist); if ($mode == REMOVE) { if ( removeFile($dpic) ) { $changed++; #delete $searchDB{$dpic}; # line is moved to removeFile() deleteCachedPics($dpic); delete_XMP_file($dpic); $lb->delete('entry', $dpic) unless $all; } } else { # $mode == TRASH - move picture to trash if (move ($dpic, $trashdir)) { $changed++; # count nr of successfull moves my $tpic = "$trashdir/$pic"; # change the location info in the search database $searchDB{$tpic} = $searchDB{$dpic}; $searchDB{$tpic}{odir} = dirname($dpic); delete $searchDB{$dpic}; deleteCachedPics($dpic); $lb->delete('entry', $dpic) unless $all; # only if move was successfull, we also move the thumbnail if ((-d "$trashdir/$thumbdirname") and (-f $thumb)) { if (!move ("$thumb", "$trashdir/$thumbdirname")) { $errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n"; } } do_other_files(MOVE, $dpic, $tpic, \$errors); } else { $errors .= "Could not move picture \"$pic\" to $trashdir: $!\n"; } } # if file is removed and a backup file exists and is not in the delete list, # we offer to rename the backup to the original name # todo this should be done in one dialog for all files at the end if ((!-f $dpic) and (-f $bakpic) and !isInList($bakpic, \@sellist)) { my $age = getAgeOfFile($bakpic); $age = " (which is $age old)" unless ($age eq ""); my $bakname = basename($bakpic); $rc = myButtonDialog('Restore backup?', "Picture \"$pic\" has a backup file$age.\nShould I rename the backup \"$bakname\" to \"$pic\"?", $bakthumb, 'Rename', 'Cancel', 'Cancel all'); last if ($rc eq 'Cancel all'); if ($rc eq 'Rename') { if (!rename ("$bakpic", "$dpic")) { $errors .= "Could not rename $bakpic to $pic: $!\n"; } else { $searchDB{$dpic} = $searchDB{$bakpic}; delete $searchDB{$bakpic}; # rename thumbnail rename ("$bakthumb", "$thumb"); if ($lb->info("exists", $bakpic)) { unless (hlistEntryRename($lb, $bakpic, $dpic)) { warn "error renaming hlist entry $bakpic to $dpic"; } } # if the backup is already visible we don't need an update if ($lb->info("exists", $dpic)) { # change the displayed name $lb->itemConfigure($dpic, $lb->{thumbcol}, -text => getThumbCaption($pic)); $lb->itemConfigure($dpic, $lb->{filecol}, -text => getAllFileInfo($dpic)); } else { $update++; } } } } if (!-f $dpic) { # ask to delete non-JPEG file, if any foreach my $suf (split /\|/, $nonJPEGsuffixes) { $njpic = $dpic; $njpic =~ s/(.*)\.jp(g|eg)$/$1.$suf/i; if (-f $njpic) { $rc = $lb->messageBox(-icon => 'question', -message => "There is a non-JPEG file\n\"".basename($njpic)."\"\nOk to delete it too?", -title => "Delete non-JPEG?", -type => 'OKCancel'); last if ($rc !~ m/Ok/i); if ($mode == REMOVE) { if ( removeFile($njpic) ) { } } elsif ($mode == TRASH) { if (!move ("$njpic", "$trashdir")) { $errors .="Could not move \"".basename($njpic)."\" to $trashdir: $!\n"; } } } } } } # foreach progressWinEnd($pw); $userinfo = "deleted $changed of ".scalar @sellist." pictures"; $userInfoL->update; if ($errors ne "") { $errors = "These errors occured while deleting the ".scalar @sellist." selected pictures:\n$errors"; showText("Error while deleting", $errors, NO_WAIT); } checkTrash() if ($changed > 0); $update++ if $all; if ($update > 0) { if ($lb == $picLB) { updateThumbs(); } else { $lb->delete("all"); } } unless ($reselectPic) { my @childs = $lb->info('children'); $reselectPic = $childs[-1]; } if ($lb->info("exists", $reselectPic)) { if (($lb == $picLB) and $config{ShowNextPicAfterDel}) { showPic($reselectPic); } else { # just select it $actpic = $reselectPic if ($lb == $picLB); selectThumb($lb, $reselectPic); } } $lb->focus; } ############################################################## # getAgeOfFile - returns a string representing the age of the # given file (with max two of the units: # day, hour, minute, second) ############################################################## sub getAgeOfFile { my $file = shift; return "" unless (-f $file); my $diff = abs(time() - (lstat $file)[9]); my @secs = qw/86400 3600 60/; my @unit = qw/days hours minutes/; my $str = ""; my $t; my $count = 0; for $t ( 0 .. $#secs) { my $i = int($diff/$secs[$t]); if ($i > 0) { $str = "$str $i $unit[$t]"; $count++; last if ($count >= 2); # two numbers are enough } $diff %= $secs[$t]; } $str = "$str $diff seconds" if ($count < 2); return "$str"; } ############################################################## # findValidIndex - try to find a index to show e.g. after a # delete ############################################################## sub findValidIndex { my $lb = shift; my $i = shift; # startindex my @pics = $lb->info('children'); if ((defined $i) and ($i > $#pics)) { $i = $#pics; } # if possible show the pic following the last deleted one while ((!$lb->info("exists", $i)) and ($i < $#pics)) { $i++; } if ($i > $#pics) { $i = 0; } return $i; } sub centerWindow { #################################################### # Args: (0) window to center # (1) [optional] desired width # (2) [optional] desired height # # Returns: *nothing* #################################################### my($window, $width, $height) = @_; $window->idletasks; $width = $window->reqwidth unless $width; $height = $window->reqheight unless $height; my $x = int(($window->screenwidth / 2) - ($width / 2)); my $y = int(($window->screenheight / 2) - ($height / 2)); $window->geometry($width . 'x' . $height . "+" . $x . "+" . $y); } ############################################################## # repositionWindow - reposition window to fit in the desktop ############################################################## sub repositionWindow { my $win = shift; my $xoffset = shift; # optional x offset (1 or 0) reposition window by half the width my $border = 40; my $reposition = 0; my $geo = $win->geometry; my ($w, $h, $x, $y) = splitGeometry($geo); print "geo $w $h $x $y\n" if $verbose; $h = $win->screenheight if ($h > $win->screenheight); $w = $win->screenwidth if ($w > $win->screenwidth); if ( ($y+$h+$border) > $win->screenheight) { $y = $y - ( ($y+$h+$border) - $win->screenheight ); $reposition = 1; } if ( ($x+$w+$border) > $win->screenwidth) { $x = $x - ( ($x+$w+$border) - $win->screenwidth ); $reposition = 1; } if ($x < 0) { $x = 0; $reposition = 1; } if ($y < 0) { $y = 0; $reposition = 1; } if ($xoffset) { if ($x > 400) { $x -= int($w/2+10); } else { $x += int($w/2+10); } $reposition = 1; } if ($reposition) { print "reposing to $w $h $x $y\n" if $verbose; $win->geometry($w . 'x' . $h . "+" . $x . "+" . $y); $win->update; } } ############################################################## # printlist ############################################################## sub printlist { print "---\n"; foreach (@_) {print "$_\n";} print "---\n"; } ############################################################## # printhash ############################################################## sub printhash { my $hash = shift; foreach (sort keys %{$hash}) { print "$$hash->{$_} = $_ \n"; } } ############################################################## # bindItem - binds the motion event to the picture ############################################################## sub bindItem { my $id = shift; $c->bind($id, '' => sub { ($idx,$idy)=($Tk::event->x,$Tk::event->y); }); # change the mouse pointer $c->bind($id, '' => sub { # Color picker # get mouse coordinates my $x = $c->canvasx($Tk::event->x); my $y = $c->canvasy($Tk::event->y); # get and apply offset (because pic may be centered in canvas) my ($x1, $y1, $x2, $y2) = $c->bbox($id); $x -= $x1; $y -= $y1; $x = 1 if ($x < 1); $y = 1 if ($y < 1); $x = $x2-$x1-2 if ($x > $x2-$x1-2); $y = $y2-$y1-2 if ($y > $y2-$y1-2); # get the color information from the picture my($r,$g,$b) = $c->itemcget($id, -image)->get($x, $y); #convert to hex from decimal $config{ColorPicker} = sprintf "#%.2x%.2x%.2x", $r, $g, $b; $userinfo = "Color picker: $config{ColorPicker}"; $colorPickerInfo->configure(-background => $config{ColorPicker}); $userInfoL->update; $c->configure(-cursor => "crosshair"); }); $c->bind($id, '' => sub { $c->configure(-cursor => "crosshair"); }); $c->bind($id, '' => sub { $c->configure(-cursor => "top_left_arrow"); }); # enable panning in the canvas (autoscroll) $c->bind($id, '' => sub { # actual mouse coordinates $c->configure(-cursor => "fleur"); my ($mx,$my)=($Tk::event->x,$Tk::event->y); my ($x1,$x2) = $c->xview; my ($y1,$y2) = $c->yview; return if ($x1 == 0 and $x2 == 1 and $y1 == 0 and $y2 == 1); my $dx = 0; $dx = ($mx-$idx)/$width if ($width >= 1); # avoid division by zero my $dy = 0; $dy = ($my-$idy)/$height if ($height >= 1); # avoid division by zero $c->xviewMoveto($x1-$dx) unless ($x1 == 0 and $x2 == 1); $c->yviewMoveto($y1-$dy) unless ($y1 == 0 and $y2 == 1); ($idx,$idy)=($mx,$my); }); # show picture coordinates $c->bind($id, '' => sub { return unless $config{ShowCoordinates}; my $zf = 1; # get mouse coordinates my $x = $c->canvasx($Tk::event->x); my $y = $c->canvasy($Tk::event->y); # get the actual zoom factor from the global variable $zoomFactorStr if ($zoomFactorStr =~ m/(.*)%$/) { # cut off the % sign return if ($1 eq "?"); $zf = $1; # get the zoom factor in % (e.g. 80%) $zf /= 100; # the zoom factor as float (e.g. 0.8) } else { warn "zoomStep: zoomFactorStr not matching *% - returning!" if $verbose; return; } return if ($zf <= 0); # get and apply offset (because pic may be centered in canvas) my ($x1, $y1, $x2, $y2) = $c->bbox($id); $x -= $x1; $y -= $y1; # apply zoom factor $x = int($x/$zf); $y = int($y/$zf); # set borders $x = 0 if ($x < 0); $y = 0 if ($y < 0); $x = $width if ($x > $width); $y = $height if ($y > $height); $userinfo = "mouse coordinates: $x, $y"; $userInfoL->update; }); } ############################################################## # changeDir ############################################################## sub changeDir { my $newDir = shift; return 0 unless defined $newDir; if ( !chdir $newDir ) { my $dialog = $top->Dialog(-title => "Changing to $newDir folder failed", -text => "Can't change to $newDir folder: $!", -buttons => ['OK']); $dialog->Show(); warn "Can't change to $newDir folder: $!"; return 0; } return 1; } ############################################################## # getCorners - get the visible corners of an canvas ############################################################## sub getCorners { my $c = shift; my(@xview) = $c->xview; my(@yview) = $c->yview; my(@scrollregion) = @{$c->cget(-scrollregion)}; ($xview[0] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0], $yview[0] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1], $xview[1] * ($scrollregion[2]-$scrollregion[0]) + $scrollregion[0], $yview[1] * ($scrollregion[3]-$scrollregion[1]) + $scrollregion[1], ); } ############################################################## # autozoom - zooms the given picture to fit into the available size ############################################################## sub autoZoom { if (!$config{AutoZoom}) { #$zoomFactor = 1; return "100%"; } my $photo = shift; # reference to a photo object my $dpic = shift; # the file including dir (e.g. /home/herrmann/Bild.jpg) my $cw = shift; # the available width my $ch = shift; # the available height my ($pw, $ph) = getSize($dpic); my ($wf, $hf, $zoom, $subsample, $max, $i); return "" if (!$$photo); return "" if (!-f $dpic); return "" if (!defined($cw)); return "" if (!defined($ch)); print "autoZoom: place: $cw/$ch pic:$pw/$ph\n" if $verbose; $wf = $pw/($cw - 6); # the offset (6) is needed, maybe because of the border? $hf = $ph/($ch - 6); $max = max($wf, $hf); # find the biggest zoom factor #print "width factor = $wf h fac = $hf max = $max\n"; return "100%" if ($max <= 1); # search for a zoom/subsample pair which will zoom the pic at least to the needed factor 1/$max for ($i = 0; $i < (@frac - 2); $i += 2) { if (($frac[$i]/$frac[$i+1]) < (1/$max)) { last; } } $zoom = $frac[$i]; $subsample = $frac[$i+1]; # show the user what's going on ... my $zoomFactor = $subsample/$zoom; $zoomFactor = int(1/$zoomFactor * 100)."%"; $userinfo = "zooming to $zoomFactor ..."; $userInfoL->update; return "100%" if ($zoom == $subsample); # open new photo object my $zoomed = $top->Photo; $zoomed->blank; $zoomed->copy($$photo, -zoom => $zoom); # first zoom it $$photo->delete; $$photo = undef; $$photo = $top->Photo; #$$photo->blank; $$photo->copy($zoomed, -subsample => $subsample); # then subsample it $$photo->configure(-gamma => $config{Gamma}); $zoomed->delete; $zoomed = undef; print "autoZoom: $zoomFactor\n" if $verbose; return $zoomFactor; } ############################################################## # getZoomAndSub - build a appropriate fraction for zoom and # subsample from a zoomfactor (float) ############################################################## sub getZoomAndSub { my $targetfactor = shift; # the target zoom factor e.g. 0.66 my $step = shift; # -1 = stay beyond $targetfactor; +1 = return a bigger value than $targetfactor my $i = 0; my $dif = 1000; # difference to the targetfactor my $diflast = $dif + 1; # last difference # search the @frac array for the right fraction for ($i = 0; $i < (@frac - 2); $i += 2) { $dif = abs(($frac[$i]/$frac[$i+1]) - $targetfactor); # how far are we away? #$dif *= -1 if ($dif < 0); # the difference must allways be positive #printf " up %1.3f %2d %1.3f %2d/%-2d %1.3f\n", $targetfactor, $i, ($frac[$i]/$frac[$i+1]), $frac[$i], $frac[$i+1], $dif; last if ( $dif > $diflast); # if the difference starts to grow we jump out $diflast = $dif; } $i -= 2; # the last fraction had the lowest difference to the targetfactor $i -= $step*2; # go to the next or previous fraction # boundary checks (stay in the array) $i = 0 if ($i < 0); $i = @frac - 1 if ($i > @frac - 1); return ($frac[$i], $frac[$i+1]); } ############################################################## # max - returns the biggest number in a list ############################################################## sub max { my $max = shift; for(@_) { $max = $_ if $max < $_; } return $max; } ############################################################## # zoomStep - increase/decrease the actual zoom factor ############################################################## sub zoomStep { my $step = shift; # +1 or -1 my $zoom = 1; # fallback value my $subsample = 5; # fallback value # get the actual zoom factor from the global variable $zoomFactorStr if ($zoomFactorStr =~ m/(.*)%$/) { # cut off the % sign print "matching *% $1\n" if $verbose; my $zf = $1; # get the zoom factor in % $zf /= 100; # the zoom factor as float # find the next / previous zoom level ($zoom, $subsample) = getZoomAndSub($zf, $step); print "z = $zoom s = $subsample for $zf\n" if $verbose; } else { warn "zoomStep: zoomFactorStr not matching *% - returning!" if $verbose; return; } # zoom the picture zoom ($zoom, $subsample); } ############################################################## # zoom - zooms the actual displayed picture to the given # zoom and subsample values ############################################################## sub zoom { my ($zoom, $subsample) = @_; print "zoom: $zoom $subsample\n" if $verbose; my $dpic = $actpic; # zoom the actual picture return unless (defined $photos{$dpic}); $top->Busy; $userinfo = "zooming to ".int($zoom/$subsample*100)."% ..."; $userInfoL->update(); $photos{$dpic}->delete; delete $photos{$dpic}; print "reloading $actpic\n" if $verbose; $photos{$dpic} = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); my $zoomed = $top->Photo; $zoomed->blank; $zoomed->copy($photos{$dpic}, -zoom => $zoom); # delete item from canvas $c->delete('withtag', $dpic); # remove it from the canvas #deleteCachedPics($dpic); #$photos{$dpic} = undef; #$photos{$dpic} = $top->Photo; $photos{$dpic}->blank if $photos{$dpic}; $photos{$dpic}->copy($zoomed, -subsample => $subsample); $photos{$dpic}->configure(-gamma => $config{Gamma}); $zoomed->delete; $zoomed = undef; # center pic in canvas, only when it's smaller my $xoffset = 0; my $yoffset = 0; $xoffset = int(($c->width - $photos{$dpic}->width) /2) if ($c->width > $photos{$dpic}->width); $yoffset = int(($c->height - $photos{$dpic}->height)/2) if ($c->height > $photos{$dpic}->height); # insert pic to the canvas my $id = $c->createImage($xoffset, $yoffset, -image => $photos{$dpic}, -anchor => "nw", -tag => ["pic","$dpic"], -state => "hidden"); bindItem($id); addToCachedPics($dpic); $top->Unbusy; showPic($dpic); } ############################################################## # makeButton ############################################################## sub makeButton { my $parentWidget = shift; my $position = shift; my $text = shift; my $picName = shift; my $func = shift; my $pic = "$configdir/$picName"; my $image = $parentWidget->Photo(-file => $pic) if -f $pic; if ($image) { return $parentWidget->Button(-image => $image, -borderwidth => 0, -command => sub { eval "$func"; } )->pack(-side => $position, -padx => 0, -pady => 0); } else { return $parentWidget->Button(-text => $text, -command => sub { eval "$func"; } )->pack(-side => $position, -padx => 0, -pady => 0); } } ############################################################## # layout - an sub, to change the layout of mapivi ############################################################## sub layout { my $withAdjuster = shift; saveAdjusterPos() if $withAdjuster; $config{Layout} = 0 if (($config{Layout} > 5) or ($config{Layout} < 0)); my $info = ""; if ($config{Layout} == 0) { $info = "folders|thumbnails|picture"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 1; } elsif ($config{Layout} == 1) { $info = "folders|thumbnails"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 0; } elsif ($config{Layout} == 2) { $info = "thumbnails"; $config{ShowDirTree} = 0; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 0; } elsif ($config{Layout} == 3) { $info = "thumbnails|picture"; $config{ShowDirTree} = 0; $config{ShowThumbFrame} = 1; $config{ShowPicFrame} = 1; } elsif ($config{Layout} == 4) { $info = "picture"; $config{ShowDirTree} = 0; $config{ShowThumbFrame} = 0; $config{ShowPicFrame} = 1; } elsif ($config{Layout} == 5) { $info = "folders|picture"; $config{ShowDirTree} = 1; $config{ShowThumbFrame} = 0; $config{ShowPicFrame} = 1; } else { warn "error: toggle = ".$config{Layout}.", this should never happen!"; $config{Layout} = 0; return; } if ($info ne "") { $userinfo = "layout $info"; $userInfoL->update; } showHideFrames(); $top->update; setAdjusterPos() if $withAdjuster; $layoutOld = $config{Layout}; # save the actual Layout } ############################################################## # setAdjusterPos - set the position of the Adjusters according # to the global hash values ############################################################## sub setAdjusterPos { my $x = $subF->width; # width of the surrounding frame my $dirS = $dirA->slave; my $thuS = $thumbA->slave; my $min = 40; # min distance for safety my $dirXnew = $min; # width of adjuser $dirA my $thumbXnew = $min; # width of adjuser $thumbA $x = $top->width if ($x == 1); # $x = 1 at startup, so we use the window width if ($config{Layout} == 0) { # dirs thumbs picture $dirXnew = int($config{Layout0dirX}*$x/100); $thumbXnew = int($config{Layout0thumbX}*$x/100); } elsif ($config{Layout} == 1) { # dirs thumbs $dirXnew = int($config{Layout1dirX}*$x/100); $thumbXnew = int($x - $dirXnew); } elsif ($config{Layout} == 2) { } elsif ($config{Layout} == 3) { # thumbs picture $thumbXnew = int($config{Layout3thumbX}*$x/100); } elsif ($config{Layout} == 4) { } elsif ($config{Layout} == 5) { # dirs picture $dirXnew = int($config{Layout5dirX}*$x/100); } else { warn "error: toggle = ".$config{Layout}.", this should never happen!"; $dirXnew = 1, $thumbXnew = 1; $config{Layout} = 0; return; } print "layoutNew=".$config{Layout}." dirXnew=$dirXnew (".int($dirXnew/$x*100)."%) thumbXnew=$thumbXnew (".int($thumbXnew/$x*100)."%) x=$x dir=".$config{ShowDirTree}." thumb=".$config{ShowThumbFrame}." pic=".$config{ShowPicFrame}."\n" if $verbose; $dirS->configure(-width => $dirXnew) if ($dirS->ismapped()); #print "[dirS]" if ($dirS->ismapped()); $thuS->configure(-width => $thumbXnew) if ($thuS->ismapped()); #print "[thuS]" if ($thuS->ismapped());print "\n"; $top->update; } ############################################################## # saveAdjusterPos - save the actual position of the Adjusters # to the global hash ############################################################## sub saveAdjusterPos { my $x = $subF->width; # width of the surrounding frame my $dirS = $dirA->slave; my $thuS = $thumbA->slave; return if ($x < 1); my $dirX = 0; my $thumbX = 0; if ($dirS->ismapped()) { # get the actual width of the dir frame $dirX = $dirS->width; # convert it to a percentual value $dirX = $dirX / $x * 100; # not too small not to wide (between 5% and 95%) $dirX = 95 if ($dirX > 95); $dirX = 5 if ($dirX < 5); } if ($thuS->ismapped()) { # get the actual width of the thumb frame $thumbX = $thuS->width; # convert it to a percentual value $thumbX = $thumbX / $x * 100; # not too small not to wide (between 5% and 95%) $thumbX = 95 if ($thumbX > 95); $thumbX = 5 if ($thumbX < 5); } if ($layoutOld == 0) { $config{Layout0dirX} = $dirX if ($dirS->ismapped()); $config{Layout0thumbX} = $thumbX if ($thuS->ismapped()); } elsif ($layoutOld == 1) { $config{Layout1dirX} = $dirX if ($dirS->ismapped()); } elsif ($layoutOld == 3) { $config{Layout3thumbX} = $thumbX if ($thuS->ismapped()); } elsif ($layoutOld == 5) { $config{Layout5dirX} = $dirX if ($dirS->ismapped()); } print "layoutOld=$layoutOld dirX=$dirX% thumbX=$thumbX% x=$x\n" if $verbose; } ############################################################## # readConfig - read the configuration from file to hash ############################################################## sub readConfig { my $rcfile = shift; my $configRef = shift; print "readConfig: reading $rcfile\n" if $verbose; if (!$rcfile) { warn "readConfig: no file!"; return; } if (ref($configRef) ne 'HASH') { warn "readConfig: $configRef is no hash ref!"; return; } return 0 if (!-f $rcfile); my $file; if (!open($file, "<$rcfile")) { warn "readConfig: Couldn't open $rcfile: $!"; return 0; } my $errors = 0; while (<$file>) { chomp; # no newline s/^#.*//; # no comments (lines starting with #) s/^\s+//; # no leading white s/\s+$//; # no trailing white next unless length; # anything left? my ($key, $value) = split(/\s*=\s*/, $_, 2); # split around the equal sign $value =~ s/
/\n/g; # replace "
" by newline if (!defined $configRef->{$key}) { warn "readConfig: key $key (value: $value) should not belong to the config hash - removing\n" ; $errors++; next; } # save in global config hash, overwrite default value $configRef->{$key} = $value; } close $file; if (($errors > 0) and (-d $trashdir)) { my $datetime = getDateTime(); # save a copy of the old config in the trash # todo: remove very old backups warn "saving a backup of the config in the trash ($trashdir)\n"; mycopy($rcfile, $trashdir."/".basename($rcfile)."-$datetime", OVERWRITE); } return 1; } ############################################################## # saveConfig - save the configuration from hash to file ############################################################## sub saveConfig { my $rcfile = shift; my $config = shift; my $value; print "saveConfig: writing $rcfile\n" if $verbose; my $file; if (!open($file, ">$rcfile")) { warn "saveConfig: Couldn't open $rcfile: $!"; return 0; } print $file "\n# Configuration file for mapivi $version\n\n"; print $file "# last update: ", scalar localtime, "\n\n"; print $file "# This file will be overwritten each time you quit mapivi\n"; #print $file "# or call the \"Save config\" menu item.\n\n"; foreach (sort keys %{$config}) { $value = $$config{$_}; $value =~ s/\n/
/g; # replace newline by "
" print $file $_," = ", $value,"\n"; } close $file; return 1; } ############################################################## # readArrayFromFile - read an array from a file ############################################################## sub readArrayFromFile { my $file = shift; my @list; if (!$file) { warn "readArrayFromFile: no file!"; return; } return () if (!-f $file); my $fileH; if (!open($fileH, "<$file")) { warn "readArrayFromFile:: Couldn't open $file: $!"; return (); } while (<$fileH>) { chomp; # no newline s/^#.*//; # no comments (lines starting with #) s/^\s+//; # no leading white s/\s+$//; # no trailing white next unless length; # anything left? push @list, $_; } close $fileH; return @list; } ############################################################## # saveArrayToFile - save a array to a file ############################################################## sub saveArrayToFile { my $file = shift; my $listref = shift; my $value; my $fileH; if (!open($fileH, ">$file")) { warn "saveArrayToFile: Couldn't open $file: $!"; return 0; } foreach (@$listref) { print $fileH "$_\n"; } close $fileH; return 1; } ############################################################## # showPicInOwnWin - displays a picture in a separate window # a mouse click on the picture will close # the window ############################################################## sub showPicInOwnWin { my $dpic = shift; #if ((!defined $dpic) or ($dpic eq "") or (!-f $dpic)) { # no picture given, take selection from main window # my @sellist = $picLB->info('selection'); #return unless checkSelection($top, 1, 0, \@sellist); #$dpic = $sellist[0]; # simply take the first if there are more selected #$lb = $picLB; #} return unless -f $dpic; my @list; push @list, $dpic; show_multiple_pics(\@list, 0); } ############################################################## # show_multiple_pics - displays several pictures in a separate window # a mouse click on the picture will close # the window ############################################################## sub show_multiple_pics($$) { my $pic_list = shift; # reference to a picture list, each with full path my $index = shift; # start index number, first pic is index = 0 unless (defined $pic_list) { warn "pic list undef"; return; } unless (ref($pic_list) eq 'ARRAY') {warn "pic list is no array reference"; return; } unless (@{$pic_list} >= 1) {warn "pic list is empty"; return; } my $fullscreen = 0; my $balloon_addon = "\n\n(Click on picture to close window; use PgUp and PgDown for next/previous picture)"; my $dpic = @{$pic_list}[$index]; my $pic = basename($dpic); my ($photo, $zoomFactor); my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor); return unless ($rc); # open window my $win = $top->Toplevel(-bg => 'black'); my $total_pics = scalar @{$pic_list}; $win->title(sprintf "(%d/%d) %s %s", ($index+1), $total_pics, $pic, $zoomFactor); $win->iconname($pic); # use the picture thumbnail as window icon my $iconfile = getThumbFileName($dpic); my $iconPhoto = $win->Photo(-file => $iconfile) if (-f $iconfile); $win->idletasks if $EvilOS; # this line is crucial (at least on windows) $win->iconimage($iconPhoto) if $iconPhoto; my $but = $win->Button(-image => $photo, -border => 0, -relief => 'flat', -command => sub { $win->grabRelease(); $win->withdraw(); $photo->delete; $iconPhoto->delete if $iconPhoto; $win->destroy(); },)->pack(-anchor => "center", -expand => 1, -padx => 0, -pady => 0); my $balloonmsg = makeBalloonMsg($dpic).$balloon_addon; if ($config{PicWinBalloon}) { $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg); } # the context menu my $menu = $win->Menu(-title => "Menu"); $menu->checkbutton(-label => "Balloon popup info", -variable => \$config{PicWinBalloon}, -command => sub { if ($config{PicWinBalloon}) { $balloon->attach($but, -balloonposition => "mouse", -msg => \$balloonmsg); } else { $balloon->detach($but); } }); #$menu->command(-label => "next picture", -command => sub { print "use PageDown instead\n"; }); # todo #$menu->command(-label => "previous picture", -command => sub { print "use PageUp instead\n"; }); # todo $menu->command(-label => "close window", -command => sub { $but->invoke; }); # mouse and button bindings $win->bind('', sub { $menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $win->bind('', sub { $but->invoke; }); $win->bind('', sub { $but->invoke; }); # invoke $but when the window is closed by the window manager (x-button) $win->protocol("WM_DELETE_WINDOW" => sub { $but->invoke; }); $win->bind('', sub { return if ($total_pics <= 1); $but->Busy; # we can't use $win here else the cursor won't change $index++; $index = 0 if ($index > $#{@{$pic_list}}); $dpic = @$pic_list[$index]; $pic = basename($dpic); $win->title(sprintf "(%d/%d) loading %s ...", ($index+1), ($#{@{$pic_list}}+1), $pic); my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor); $but->invoke unless ($rc); $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $pic, $zoomFactor); $win->iconname($pic); $but->configure(-image => $photo); $balloonmsg = makeBalloonMsg($dpic).$balloon_addon; $but->Unbusy; }); $win->bind('', sub { return if ($total_pics <= 1); $but->Busy; # we can't use $win here else the cursor won't change $index--; $index = $#{@{$pic_list}} if ($index < 0); $dpic = @$pic_list[$index]; $pic = basename($dpic); $win->title(sprintf "(%d/%d) loading %s ...", ($index+1), ($#{@{$pic_list}}+1), $pic); my $rc = load_zoom_pic($dpic, \$photo, \$zoomFactor); $but->invoke unless ($rc); $win->title(sprintf "(%d/%d) %s %s", ($index+1), ($#{@{$pic_list}}+1), $pic, $zoomFactor); $win->iconname($pic); $but->configure(-image => $photo); $balloonmsg = makeBalloonMsg($dpic).$balloon_addon; $but->Unbusy; }); # key-desc,F11,toggle fullscreen mode when displaying picture in own window $win->bind('', sub { toggle(\$fullscreen); # the fullscreen modus is always without border when the option ToggleBorder is set $config{Overrideredirect} = 0; $config{Overrideredirect} = $fullscreen if $config{ToggleBorder}; fullscreen($win, $fullscreen); # the next two lines may hlep if there are focus problems #$win->bind('',sub{$win->focusForce;$win->grabGlobal;}); #$win->bind('',sub{$win->grabRelease}); }); $but->focusForce if (Exists($but)); $userinfo = "ready!"; $userInfoL->update; } ############################################################## # load_zoom_pic - load and zoom a picture # returns 1 on success and 0 on failure ############################################################## sub load_zoom_pic { my $dpic = shift; my $photo = shift; # reference to photo object my $zoomFactor = shift; # reference to zoom factor (string) if (!-f $dpic) { $top->messageBox(-icon => 'warning', -message => "load_zoom_pic: Error no file $dpic", -title => 'Error', -type => 'OK'); return 0; } $userinfo = "opening $dpic in new window ..."; $userInfoL->update; $$photo = $top->Photo(-file => $dpic, -gamma => $config{Gamma}); if (!$$photo) { $top->messageBox(-icon => 'warning', -message => "load_zoom_pic: Error no photo $dpic!", -title => 'Error', -type => 'OK'); $userinfo = ""; $userInfoL->update; return 0; } increasePicPopularity($dpic); if ($config{trackPopularity}) { updateOneRow($dpic, $picLB); # update popularity (viewed x times) info $picLB->update; } $$zoomFactor = autoZoom(\$$photo, $dpic, $top->screenwidth, $top->screenheight); return 1; } ############################################################## # showThumbList - displays a list of thumbs on a scrollable pane ############################################################## sub showThumbList { my $thumbs = shift; # reference on an array containing pictures my $title = shift; # optinal window title unless (@$thumbs) { $userinfo = "$title: no pictures"; $userInfoL->update; return; } my $nr = @$thumbs; # total number $userinfo = "displaying $nr thumbs in new window ..."; $userInfoL->update; #stopWatchStart(); # open window my $win = $top->Toplevel(-bg => "black"); $win->withdraw; $win->title("$title - $nr pictures"); # set the icon $win->iconname("Pictures"); $win->iconimage($mapiviicon) if $mapiviicon; my $topFrame = $win->Frame()->pack(-fill => 'both'); my %tphotos; # local hash to store the thumbnail photo objects $topFrame->Button(-text => "Close", -command => sub { cleanUpAndClose($win, \%tphotos); })->pack(-side => 'left'); $win->{label} = "$nr pictures, 0 selected"; $topFrame->Label(-textvariable => \$win->{label})->pack(-side => 'left'); my $cols = 6; $cols = $nr if ($nr < $cols); my $maxrows = int($win->screenheight/($config{ThumbSize} + 20)); # todo for 10 pics there should be 2 rows but the window is not high enough my $rows = int($nr/$cols) + 1; $rows = $maxrows if ($rows > $maxrows); print "tiler: nr:$nr col:$cols row:$rows maxrows:$maxrows\n" if $verbose; my $tiler = $win->Scrolled("Tiler", -columns => $cols, -rows => $rows, -scrollbars => 'oe', )->pack(-fill => 'both', -expand => 1); bindMouseWheel($tiler->Subwidget("scrolled")); # list of all the window objects of $tiler # special values are $a[$i]->{selected} a boolean value 1=selected 0=not selected # and $a[$i]->{dpic} the path and the name of the displayed picture my @a; # the context menu my $menu = $win->Menu(-title => "Menu"); ############# selection menu my $sel_menu = $menu->cascade(-label => "select ..."); $sel_menu->cget(-menu)->configure(-title => "Selection menu"); ############# select all $sel_menu->command(-label => "select all", -command => sub { foreach (@a) { $_->{selected} = 1; } my $sel = 0; foreach (@a) { $sel++ if $_->{selected}; } $win->{label} = "$nr pictures, $sel selected"; }); ############# select none $sel_menu->command(-label => "select none", -command => sub { foreach (@a) { $_->{selected} = 0; } my $sel = 0; foreach (@a) { $sel++ if $_->{selected}; } $win->{label} = "$nr pictures, $sel selected"; }); ############# invert selection $sel_menu->command(-label => "invert selection", -command => sub { foreach (@a) { toggle(\$_->{selected}); } my $sel = 0; foreach (@a) { $sel++ if $_->{selected}; } $win->{label} = "$nr pictures, $sel selected"; }); ############# list selection $sel_menu->command(-label => "list selection", -command => sub { my @sel = (); # get the selection foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } my $text = scalar @sel." pictures are selected:\n"; foreach (@sel) { $text .= "$_\n"; } showText("selected pictures", $text, NO_WAIT); }); $menu->separator; ############# open picture in main window $menu->command(-label => "open picture in main window", -accelerator => '', -command => sub { my @sel; # get the selection foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } return unless checkSelection($win, 1, 1, \@sel); my $dpic = $sel[0]; my $dir = dirname($dpic); my $pic = basename($dpic); if (!-d $dir) { $win->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK'); return; } $top->deiconify; $top->raise; $top->focus; openDirPost($dir) if ($dir ne $actdir); showPic($dpic); }); ############# add to light table $menu->command(-label => "add to light table", -command => sub { my @sel; # get the selection foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } return unless (@sel); light_table_add(\@sel); }); ############# copy selected $menu->command(-label => "copy selected ...", -command => sub { my @sel; # get the selection foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } return unless (@sel); my $targetdir = getDirDialog("Copy pictures to"); return unless (-d $targetdir); makeDir(dirname(getThumbFileName("$targetdir/dummy.jpg")), ASK); my ($pic, $dpic, $tpic, $thumbpic, $thumbtpic, $njpic); my $pw = progressWinInit($win, "copy pictures"); my $i = 0; my $rc = 1; my $n = 0; # count successfull copied pictures foreach $dpic (@sel) { last if progressWinCheck($pw); $pic = basename($dpic); $i++; progressWinUpdate($pw, "copy picture ($i/".scalar @sel.") ...", $i, scalar @sel); $tpic = "$targetdir/$pic"; # if the pic exists, ask if the user wants to overwrite it $rc = overwritePic($tpic, $dpic, (scalar(@sel) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); if (mycopy ("$dpic", "$tpic", OVERWRITE)) { $n++; $thumbpic = getThumbFileName($dpic); $thumbtpic = getThumbFileName($tpic); if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ("$thumbpic","$thumbtpic", OVERWRITE) } } } # foreach - end progressWinEnd($pw); }); ############# show infos $menu->command(-label => "show picture info", -command => sub { my @sel; foreach (@a) { push @sel, $_->{dpic} if $_->{selected}; } return unless (@sel); return unless askSelection(\@sel, 10, "picture info"); foreach my $dpic (@sel) { my $info = makeBalloonMsg($dpic); showText($dpic, $info, NO_WAIT, getThumbFileName($dpic)); } }); ############# delete $menu->command(-label => "delete selected pictures to trash", -command => sub { delPicsToTrash($win, \@a, $thumbs, $title, \%tphotos); }, -accelerator => ''); $win->bind('', sub { delPicsToTrash($win, \@a, $thumbs, $title, \%tphotos); } ); # mouse and button bindings $win->bind('', sub { $menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); my $i = 0; my $frame; my $pw = progressWinInit($picLB, "Show thumbnails"); foreach my $dpic (@$thumbs) { last if progressWinCheck($pw); progressWinUpdate($pw, "loading thumbnail (".($i+1)."/$nr) ...", ($i+1), $nr); #if ( $i % $cols == 1 or $cols == 1 ) { # start new table row (modulo) # $frame = $tiler->Frame()->pack(); #} my $thumbFile = getThumbFileName($dpic); $tphotos{$dpic} = $win->Photo(-file => $thumbFile, -gamma => $config{Gamma}) if (-f $thumbFile); if (! $tphotos{$dpic}) { #$top->messageBox(-icon => 'warning', -message => "showThumbList: Error no thumb for photo $dpic!", # -title => 'Error', -type => 'OK'); $tphotos{$dpic} = $defaultthumbP if $defaultthumbP; next unless $tphotos{$dpic}; } my $j = $i; # we need a local copy here $a[$i] = $tiler->Frame(-border => 1, -relief => "raised"); $a[$i]->{selected} = 0; $a[$i]->{dpic} = $dpic; my $check = $a[$i]->Checkbutton(-variable => \$a[$i]->{selected}, -border => 1, -padx => 0, -pady => 0, -command => sub { my $sel = 0; foreach (@a) { $sel++ if $_->{selected}; } $win->{label} = "$nr pictures, $sel selected"; },)->pack(-side => "left", -expand => 0, -fill => "none", -anchor => "s", -padx => 0, -pady => 0); my $but = $a[$i]->Button(-image => $tphotos{$dpic}, -border => 0, -relief => "flat", -padx => 0, -pady => 0, -command => sub { $check->invoke if (Exists($check)); },)->pack(-side => "left", -expand => 0, -fill => "none", -padx => 0, -pady => 0); $but->bind('', sub { showPicInOwnWin($dpic); }); my $msg; # the balloon message is generated on demand later, to speed up the loading of the thumbs $balloon->attach($but, -postcommand => sub { $msg = makeBalloonMsg($dpic); $msg .= "\n\nRight mouse button for context menu, middle mouse button to open picture";}, -balloonposition => "mouse", -msg => \$msg); $tiler->Manage($a[$i]); $i++; } progressWinEnd($pw); $win->bind('', sub { cleanUpAndClose($win, \%tphotos); }); $win->bind('', sub { cleanUpAndClose($win, \%tphotos); }); $win->deiconify; $win->raise; #stopWatchStop("showThumbList"); $userinfo = "ready!"; $userInfoL->update; } ############################################################## # cleanUpAndClose - for showThumbList ############################################################## sub cleanUpAndClose($$) { my $win = shift; my $hashref = shift; $win->withdraw; foreach (keys %{$hashref}) { if ($$hashref{$_}) { # do not delete the default thumbnail! $$hashref{$_}->delete unless ($$hashref{$_} == $defaultthumbP); } } Tk->break; } ############################################################## # delPicsToTrash ############################################################## sub delPicsToTrash { my ($win, $a, $thumbs, $title, $tphotos) = @_; unless (defined $a) { warn "a undef"; return; } unless (ref($a) eq 'ARRAY') {warn "a is no array"; return; } unless (defined $thumbs) { warn "thumbs undef"; return; } unless (ref($thumbs) eq 'ARRAY') {warn "thumbs is no array"; return; } my @sel; my $deleted = 0; my $errors = ""; if (!-d $trashdir) { $win->messageBox(-icon => 'warning', -message => "Trashdir $trashdir not found!\nPlease create this dir (shell: mkdir $trashdir) and retry.\n\nAborting.", -title => "Delete pictures", -type => 'OK'); return; } # check if we are in the trash dir if ($actdir eq $trashdir) { $win->messageBox(-icon => 'warning', -message => "Please use to really remove files from the trash!", -title => "Delete pictures", -type => 'OK'); return; } makeDir("$trashdir/$thumbdirname", NO_ASK); foreach my $i (reverse 0 .. $#{$a}) { if ($$a[$i]->{selected}) { my $dpic = $$a[$i]->{dpic}; my $pic = basename($dpic); if (move ($dpic, $trashdir)) { $deleted++; # count nr of successfull moves my $tpic = "$trashdir/$pic"; $searchDB{$tpic} = $searchDB{$dpic}; $searchDB{$tpic}{odir} = dirname($dpic); delete $searchDB{$dpic}; deleteCachedPics($dpic); my $thumb = getThumbFileName($dpic); if ((-d "$trashdir/$thumbdirname") and (-f $thumb)) { if (!move ($thumb, "$trashdir/$thumbdirname")) { $errors .= "Could not move thumbnail \"$thumb\" to $trashdir/$thumbdirname: $!\n"; } } splice @$thumbs, $i, 1; # remove picture from list } else { $errors .= "Could not move picture \"$dpic\" to $trashdir: $!\n"; } } } # clean up and close window if ($errors ne "") { $errors = "These errors occured while deleting the selected pictures:\n$errors"; showText("Error while deleting", $errors, NO_WAIT); } $userinfo = "deleted $deleted pictures"; $userInfoL->update; # while it's not possible to remove objects from Tk::Tiler we need to close the # window and reload the function with the rest of the pictures cleanUpAndClose($win, $tphotos); # recursive call of this function showThumbList($thumbs, $title); } ############################################################## # makeBalloonMsg ############################################################## sub makeBalloonMsg { my $dpic = shift; return "$dpic\nis currently not available" if (!-f $dpic); my $linktarget = ""; my $pic = basename($dpic); my $dir = dirname($dpic); my $fsize = getFileSize($dpic, FORMAT); my $fdate = getFileDate($dpic, FORMAT); my ($w, $h) = getSize($dpic); my $exif = getShortEXIF($dpic, NO_WRAP); if ($exif ne "") { $exif = formatString($exif, 80, -1); $exif = "\nEXIF: ".$exif; } my $iptc = getIPTC($dpic, SHORT); $iptc = formatString($iptc, 80, -1); # needed for many joined keywords if ($iptc ne '') { $iptc = "\n\n".$iptc; # if IPTC is not empty, add a little distance } my $comment = getComment($dpic, LONG); # show only the first 800 chars of the comment, else the balloon box is too full $comment = cutString($comment, 797, "..."); $comment = formatString($comment, 80, -1); if ($comment ne "") { $comment = "\n\n".$comment; # if comment is not empty, add a little distance } if (-l $dpic) { $linktarget = "\nLink: links to: ".readlink($dpic); } return "File: $pic\nDir: $dir\nSize: $fsize (${w}x$h)\nDate: $fdate $linktarget$exif$iptc$comment"; } ############################################################## # saveOffsets ############################################################## # sub saveOffsets { # my $win = shift; # my $geo = $win->geometry; # my ($w, $h, $x, $y) = splitGeometry($geo); # $picwinx = $x; # $picwiny = $y; # print "saveOffsets: $x $y\n" if $verbose; # } ############################################################## # options ############################################################## sub options { if (Exists($ow)) { $ow->deiconify; $ow->raise; return; } $ow = $top->Toplevel(); $ow->withdraw; $ow->title("Mapivi options"); $ow->iconname("Options"); $ow->iconimage($mapiviicon) if $mapiviicon; my $notebook = $ow->NoteBook(-width => 500, -background => $config{ColorBG}, # background of active page (including its tab) -inactivebackground => $config{ColorEntry}, # tabs of inactive pages -backpagecolor => $config{ColorBG}, # background behind notebook )->pack(-expand => "yes", -fill => "both", -padx => 5, -pady => 5); my $aF = $notebook->add("gen", -label => "General"); my $bF = $notebook->add("thumbs", -label => "Thumbnails"); my $cF = $notebook->add("view", -label => "Window"); my $eF = $notebook->add("col", -label => "Colors"); my $dF = $notebook->add("adv", -label => "Advanced"); $notebook->raise($config{OptionsLastPad}); my %tmpconf = %{ dclone(\%config) }; my $w = 37; labeledEntry($aF,'top',20,"Copyright notice",\$tmpconf{Copyright}); my $sdbB = $aF->Checkbutton(-variable => \$tmpconf{SaveDatabase}, -text => "Store the search database to a file")->pack(-anchor => 'w'); $balloon->attach($sdbB, -msg => "If this is enabled all image meta information (Comments, EXIF, IPTC, file name) of all images visited will be stored into a database. The database can be used to search pictures. It is highly recommended to enable this option."); my $sexfeB = $aF->Checkbutton(-variable => \$tmpconf{saveEXIFforEdit}, -text => "Save EXIF information before editing picture in The GIMP")->pack(-anchor => 'w'); $balloon->attach($sexfeB, -msg => "Some older picture editors (e.g. GIMP 1.3.15 and lower) won't save the picture EXIF information. With this option the EXIF info is saved and you can restore it later. (see menu Edit->EXIF info->restore)"); $aF->Checkbutton(-variable => \$tmpconf{ShowHiddenDirs}, -text => 'Show hidden folders (starting with a dot ".")')->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{AskGenerateThumb}, -text => "Ask before generating thumbnails")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{AskDeleteThumb}, -text => "Ask before deleting thumbnails")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{AskMakeDir}, -text => "Ask before making a folder (e.g. $thumbdirname)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{WarnBeforeResize}, -text => "Warn me before using change size/quality")->pack(-anchor => 'w'); my $cfnjB = $aF->Checkbutton(-variable => \$tmpconf{CheckForNonJPEGs}, -text => "Check for non-JPEG pictures")->pack(-anchor => 'w'); $balloon->attach($cfnjB, -msg => "If this is enabled and there are some non-JPEGs Mapivi will ask the user if they should be converted to JPEGs. After the conversion the images can be displayed by Mapivi. The originals (non-JPEGs) may be left untouched or deleted."); $aF->Checkbutton(-variable => \$tmpconf{ShowMoreEXIF}, -text => "Show detailed EXIF data (sharpness, contrast, artist, white balance, ...)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{BitsPixel}, -text => "Calculate and show picture compression in bit per pixel")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{AspectRatio}, -text => "Calculate and show image aspect ratio (e.g. 4:3 or 3:2)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{ShowFileDate}, -text => "Show file date in the size column")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{RenameBackup}, -text => "Rename backup file, if the file is renamed")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{WAV_file_operations}, -text => "WAV audio files follow picture file operations (copy, move, rename, delete *.wav file)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{XMP_file_operations}, -text => "XMP sidecar files follow picture file operations (copy, move, rename, delete *.xmp file)")->pack(-anchor => 'w'); $aF->Checkbutton(-variable => \$tmpconf{RAW_file_operations}, -text => "RAW (nef, crw) files follow picture file operations (copy, move, rename, delete *.nef or *.crw file)")->pack(-anchor => 'w'); my $trb = $aF->Checkbutton(-variable => \$tmpconf{jpegtranTrim}, -text => "use the -trim switch when doing lossless rotation")->pack(-anchor => 'w'); $balloon->attach($trb, -msg => "The rotation operates rather oddly if the image dimensions are not a multiple of the iMCU size (usually 8 or 16 pixels), because they can only transform complete blocks in the desired way. jpegtran's default behavior when transforming an odd-size image is designed to preserve exact reversibility and mathematical consistency of the transformation set. For practical use, you may prefer to discard any untransformable edge pixels using the -trim switch rather than having a strange-looking strip along the right and/or bottom edges of a transformed image."); my $aFcp = labeledScale($aF, 'top', $w, "Max number of cached pictures", \$tmpconf{MaxCachedPics}, 2, 10, 1); $balloon->attach($aFcp, -msg => "MaPiVi is able to cache some pictures.\nCached pictures can be displayed very fast, but eat up memory."); my $aFtp = labeledScale($aF, 'top', $w, "Max number of displayed thumbnails", \$tmpconf{ThumbMaxLimit}, 10, 10000, 10); $balloon->attach($aFtp, -msg => "Each thumbnail eats up a little bit of memory (about 40kByte), so opening a folder with a huge number of pictures may be dangerous. With this option you are able to limit the memory consumption of the thumbnails. The remaining thumbnails will be displayed with the default thumbnail."); my $aFst = labeledScale($aF, 'top', $w, "Maximum size of trash (MB)", \$tmpconf{MaxTrashSize}, 1, 500, 5); $balloon->attach($aFst, -msg => "The trash size is not really limited, but there will be a warning, when this limit is reached."); labeledScale($aF, 'top', $w, "Slideshow pause time (sec)", \$tmpconf{SlideShowTime}, 1, 300, 1); # ############### Thumbnail notepad ######################## my $abF = $bF->Frame()->pack(-fill => 'x', -expand => 0); my $a1bF = $abF->Frame()->pack(-side => "left", -fill => 'x', -expand => 0); my $a2bF = $abF->Frame()->pack(-side => "left", -fill => 'x', -expand => 0); my $bFst = $a1bF->Checkbutton(-variable => \$tmpconf{ShowThumbs}, -text => "Show thumbnail pictures")->pack(-anchor => 'w'); $balloon->attach($bFst, -msg => "Show thumbnails or nothing at all\n(disable this for compact view)"); my $bFuet = $a1bF->Checkbutton(-variable => \$tmpconf{UseEXIFThumb}, -text => "Use EXIF thumbnails where available")->pack(-anchor => 'w'); $balloon->attach($bFuet, -msg => "Use the EXIF thumbnails where availabe,\nif not available a thumbnail is generated from the picture\n(very fast, but may not reflect a post processed picture)."); $a1bF->Checkbutton(-variable => \$tmpconf{RotateThumb}, -text => "Rotate EXIF thumbnail when rotating picture")->pack(-anchor => 'w'); my $bFudt = $a1bF->Checkbutton(-variable => \$tmpconf{UseDefaultThumb}, -text => "Use default thumbnail")->pack(-anchor => 'w'); $balloon->attach($bFudt, -msg => "Show default thumbnail if no thumbnail available."); my $example; my $previewB; if (-f $thumbExample) { $example = $top->Photo(-file => "$thumbExample", -gamma => $config{Gamma}); if ($example) { $a2bF->Label(-text => 'Click here for a preview')->pack(); $previewB = $a2bF->Button(-image => $example, -bd => $config{Borderwidth}, -command => sub { my $thumb = "$trashdir/thumbExample.jpg"; my $com = makeCommandString(\%tmpconf); $com .= " \"$thumbExample\" \"$thumb\" "; $ow->Busy; if ((system "$com") != 0) { warn "$com failed: $!"; $ow->Unbusy; return; } if (-f $thumb) { my $prev = $top->Photo(-file => "$thumb", -gamma => $config{Gamma}); $previewB->configure(-image => $prev) if $prev; } $ow->Unbusy; })->pack(); $balloon->attach($previewB, -msg => "Press here to update the thumbnail\nwith the choosen options"); } } $previewB->invoke if (Exists($previewB)); my $bFdt = labeledEntryButton($bF,'top',$w,"Path/name of default thumbnail",'Set',\$tmpconf{DefaultThumb}); $balloon->attach($bFdt, -msg => "This default thumbnail will be displayed when the real thumbnail\nis not available (e.g. while building the thumbnails)."); #my $bfF = $bF->Frame()->pack(-fill => 'x', -expand => "1"); my $bFstp = labeledScale($bF, 'top', $w, "Size (pixel)", \$tmpconf{ThumbSize}, 10, 200, 1); $balloon->attach($bFstp, -msg => "This is the length and the heigt of the thumbnail.\nWith a value of e.g. 100 you will get a 100x100 thumbnail."); my $bFqt = labeledScale($bF, 'top', $w, "Quality (%)", \$tmpconf{ThumbQuality}, 30, 100, 5); qualityBalloon($bFqt); #my $zF = $bF->Frame()->pack(-fill => 'x', -expand => "1"); my $zshS = labeledScale($bF, 'top', $w, "Sharpness (radius)", \$tmpconf{ThumbSharpen}, 0, 40, 0.1); $balloon->attach($zshS, -msg => "The higher the value, the slower the conversion\n(suggestion: between 0 and 4)"); my $bFbs = labeledScale($bF, 'top', $w, "Frame size (pixel)", \$tmpconf{ThumbBorder}, 0, 50, 1); $balloon->attach($bFbs, -msg => "Set the thumbnail frame size."); $bF->Checkbutton(-variable => \$tmpconf{UseThumbShadow}, -text => "Add a shadow")->pack(-anchor => 'w'); my $bFbgc = labeledEntryColor($bF,'top',$w,"Thumbnail frame color",'Set',\$tmpconf{ColorThumbBG}); $balloon->attach($bFbgc, -msg => "Set the thumbnail frame color."); my $bFnob = labeledScale($bF, 'top', 42, "Number of processes generating thumbnails", \$tmpconf{MaxProcs}, 1, 10, 1); $balloon->attach($bFnob, -msg => "MaPiVi will generate the thumbnails in the background.\nChoose the maximum number of parallel executed processes.\nNumbers greater than one or two may only be appropriate on a muliprocessor plattform."); # ############### window notepad ######################## $cF->Checkbutton(-variable => \$tmpconf{ShowClock}, -text => "Display a clock in the status bar")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowMenu}, -text => "Show menu bar")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowInfoFrame}, -text => "Show info frame on the upper side")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowDirTree}, -text => "Show folder tree on the left side")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowThumbFrame}, -text => "Show thumbnail list")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowPicFrame}, -text => "Show picture frame on the right side")->pack(-anchor => 'w'); my $aFe = $cF->Checkbutton(-variable => \$tmpconf{ShowEXIFField}, -text => "Show EXIF info and buttons in picture view")->pack(-anchor => 'w'); $balloon->attach($aFe, -msg => "show/hide the textfield containing the picture EXIF data\nand the EXIF- and IPTC-show buttons.\nThis field is usually located above the actual picture"); my $aFc = $cF->Checkbutton(-variable => \$tmpconf{ShowCommentField}, -text => "Display comment info in picture view")->pack(-anchor => 'w'); $balloon->attach($aFc, -msg => "show/hide the textfield containing the picture comments\nand the buttons to add, edit and remove a comment.\nThis field is usually located above the actual picture"); my $aFic = $cF->Checkbutton(-variable => \$tmpconf{ShowCaptionField}, -text => "Display IPTC caption info in picture view")->pack(-anchor => 'w'); $balloon->attach($aFic, -msg => "show/hide the textfield containing the picture IPTC caption\nand a button to store it.\nThis field is usually located above the actual picture"); my $aFp = $cF->Checkbutton(-variable => \$tmpconf{ShowPicInfo}, -text => "Show picture info as a balloon on the actual picture")->pack(-anchor => 'w'); $balloon->attach($aFp, -msg => "if this is enabled and you move and hold your mouse pointer\nover the actual picture (right frame of the main window)\na balloon info box (with EXIF, comment, size, ...) will appear"); my $aIc = $cF->Checkbutton(-variable => \$tmpconf{ShowInfoInCanvas}, -text => "Overlap picture with picture info (EXIF, IPTC, ...)")->pack(-anchor => 'w'); $balloon->attach($aIc, -msg => "show/hide picture infos on the picture itself"); $cF->Checkbutton(-variable => \$tmpconf{AutoZoom}, -text => "Zoom big pictures to fit the canvas (auto zoom)")->pack(-anchor => 'w'); $cF->Checkbutton(-variable => \$tmpconf{ShowCoordinates}, -text => "Display the coordinates of the mouse cursor in the status bar")->pack(-anchor => 'w'); my $fontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($fontF, -msg => "Font for the main window and nearly all dialogs.\nIt's recommeded to choose a fixed font."); my $fontL = $fontF->Label(-text => "Font family: ", -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Label(-textvariable => \$tmpconf{FontFamily}, -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Button(-text => 'Set', -command => sub { my $font = $tmpconf{FontFamily}; my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{FontSize}); return unless $rc; $tmpconf{FontFamily} = $font; $ow->Busy; my $font2 = $top->Font(-family => $tmpconf{FontFamily}, -size => $tmpconf{FontSize}); $fontL->configure(-font => $font2); $fontL->update(); $ow->Unbusy; })->pack(-side => "left"); $fontF->Label(-text => " Font size: ", -bg => $config{ColorBG})->pack(-side => "left"); $fontF->Scale( -variable => \$tmpconf{FontSize}, -from => 5, -to => 20, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 0, -width => 15, -bd => $config{Borderwidth}, -command => sub { $ow->Busy; my $font = $top->Font(-family => $tmpconf{FontFamily}, -size => $tmpconf{FontSize}); $fontL->configure(-font => $font); $fontL->update(); $ow->Unbusy; })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $fontF->Label(-textvariable => \$tmpconf{FontSize})->pack(-side => "left"); my $propFontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($propFontF, -msg => "Please choose a propotional font here which is available in different sizes.\nIt will be used in the keyword browser (tag cloud)."); my $propFontL = $propFontF->Label(-text => "Proportional font family: ", -bg => $config{ColorBG})->pack(-side => "left"); $propFontF->Label(-textvariable => \$tmpconf{PropFontFamily}, -bg => $config{ColorBG})->pack(-side => "left"); $propFontF->Button(-text => 'Set', -command => sub { my $font = $tmpconf{PropFontFamily}; my $rc = myFontDialog($ow, 'Select font family', \$font, $tmpconf{PropFontSize}); return unless $rc; $tmpconf{PropFontFamily} = $font; $ow->Busy; my $font2 = $top->Font(-family => $tmpconf{PropFontFamily}, -size => $tmpconf{PropFontSize}); $propFontL->configure(-font => $font2); $propFontL->update(); $ow->Unbusy; })->pack(-side => "left"); $propFontF->Label(-text => " Font size: ", -bg => $config{ColorBG})->pack(-side => "left"); $propFontF->Scale( -variable => \$tmpconf{PropFontSize}, -from => 5, -to => 30, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 0, -width => 15, -bd => $config{Borderwidth}, -command => sub { $ow->Busy; my $font = $top->Font(-family => $tmpconf{PropFontFamily}, -size => $tmpconf{PropFontSize}); $propFontL->configure(-font => $font); $propFontL->update(); $ow->Unbusy; })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $propFontF->Label(-textvariable => \$tmpconf{PropFontSize})->pack(-side => "left"); my $tfontF = $cF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $tfontL = $tfontF->Label(-text => "Thumbnail font size:", -bg => $config{ColorBG})->pack(-side => "left"); $tfontF->Scale( -variable => \$tmpconf{ThumbCaptFontSize}, -from => 5, -to => 20, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 0, -width => 15, -bd => $config{Borderwidth}, -command => sub { $ow->Busy; my $font = $top->Font(-family => $tmpconf{FontFamily}, -size => $tmpconf{ThumbCaptFontSize}); $tfontL->configure(-font => $font); $tfontL->update(); $ow->Unbusy; })->pack(-side => "left", -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $tfontF->Label(-textvariable => \$tmpconf{ThumbCaptFontSize})->pack(-side => "left"); # ############### color notepad ######################## $w = 36; $eF->Label(-text => 'Please restart Mapivi to see all color changes')->pack(); my $presets = $eF->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); $presets->Label(-text => 'Presets')->pack(-side => 'left', -anchor => 'w'); $presets->Button(-text => 'bright', -command => sub { $tmpconf{ColorBG} = "#efefef"; $tmpconf{ColorMenuBG} = "LightGoldenrod2"; $tmpconf{ColorMenuFG} = "black"; $tmpconf{ColorBG2} = "#e5e5e5"; $tmpconf{ColorBGCanvas} = "#efefef"; $tmpconf{ColorHlBG} = "#eeeeee"; $tmpconf{ColorActBG} = "LightGoldenrod1"; $tmpconf{ColorEntry} = "gray90"; $tmpconf{ColorSel} = "LightGoldenrod2"; $tmpconf{ColorSelBut} = "red3"; $tmpconf{ColorSelFG} = "black"; $tmpconf{ColorName} = "black"; $tmpconf{ColorComm} = "black"; $tmpconf{ColorIPTC} = "black"; $tmpconf{ColorEXIF} = "black"; $tmpconf{ColorFile} = "black"; $tmpconf{ColorDir} = "black"; $tmpconf{ColorThumbBG} = "azure3"; })->pack(-side => 'left'); $presets->Button(-text => 'white/yellow', -command => sub { $tmpconf{ColorBG} = "white"; $tmpconf{ColorMenuBG} = "LightGoldenrod3"; $tmpconf{ColorMenuFG} = "black"; $tmpconf{ColorBG2} = "#fff9d8"; $tmpconf{ColorBGCanvas} = "white"; $tmpconf{ColorHlBG} = "white"; $tmpconf{ColorActBG} = "LightGoldenrod1"; $tmpconf{ColorEntry} = "gray90"; $tmpconf{ColorSel} = "LightGoldenrod2"; $tmpconf{ColorSelBut} = "red3"; $tmpconf{ColorSelFG} = "black"; $tmpconf{ColorName} = "black"; $tmpconf{ColorComm} = "black"; $tmpconf{ColorIPTC} = "black"; $tmpconf{ColorEXIF} = "black"; $tmpconf{ColorFile} = "black"; $tmpconf{ColorDir} = "black"; $tmpconf{ColorThumbBG} = "LightGoldenrod1"; })->pack(-side => 'left'); $presets->Button(-text => 'blue', -command => sub { $tmpconf{ColorBG} = "SlateGray1"; $tmpconf{ColorMenuBG} = "SlateGray3"; $tmpconf{ColorMenuFG} = "black"; $tmpconf{ColorBG2} = "SlateGray2"; $tmpconf{ColorBGCanvas} = "SlateGray1"; $tmpconf{ColorHlBG} = "#e3f6ff"; $tmpconf{ColorActBG} = "DeepSkyBlue1"; $tmpconf{ColorEntry} = "SlateGray1"; $tmpconf{ColorSel} = "DeepSkyBlue1"; $tmpconf{ColorSelBut} = "red3"; $tmpconf{ColorSelFG} = "black"; $tmpconf{ColorName} = "black"; $tmpconf{ColorComm} = "black"; $tmpconf{ColorIPTC} = "black"; $tmpconf{ColorEXIF} = "black"; $tmpconf{ColorFile} = "black"; $tmpconf{ColorDir} = "black"; $tmpconf{ColorThumbBG} = "SlateGray3"; })->pack(-side => 'left'); $presets->Button(-text => 'bright/blue', -command => sub { $tmpconf{ColorBG} = "#efefef"; $tmpconf{ColorMenuBG} = "gray40"; $tmpconf{ColorMenuFG} = "white"; $tmpconf{ColorBG2} = "#e5e5e5"; $tmpconf{ColorBGCanvas} = "#efefef"; $tmpconf{ColorHlBG} = "#eeeeee"; $tmpconf{ColorActBG} = "#9fb6cd"; $tmpconf{ColorEntry} = "gray90"; $tmpconf{ColorSel} = "#9fb6cd"; $tmpconf{ColorSelBut} = "red3"; $tmpconf{ColorSelFG} = "black"; $tmpconf{ColorName} = "black"; $tmpconf{ColorComm} = "black"; $tmpconf{ColorIPTC} = "black"; $tmpconf{ColorEXIF} = "black"; $tmpconf{ColorSize} = "black"; $tmpconf{ColorDir} = "black"; $tmpconf{ColorThumbBG} = "gray85"; })->pack(-side => 'left'); $presets->Button(-text => 'gray', -command => sub { $tmpconf{ColorBG} = "#aeaeae"; $tmpconf{ColorMenuBG} = "#aaa"; $tmpconf{ColorMenuFG} = "black"; $tmpconf{ColorBG2} = "#c8c8c8"; $tmpconf{ColorBGCanvas} = "#222"; $tmpconf{ColorHlBG} = "#a1a1a1"; $tmpconf{ColorActBG} = "#ae6666"; $tmpconf{ColorEntry} = "#ccc"; $tmpconf{ColorSel} = "#9fb6cd"; $tmpconf{ColorSelBut} = "red3"; $tmpconf{ColorSelFG} = "#000"; $tmpconf{ColorName} = "#000060"; $tmpconf{ColorComm} = "#600000"; $tmpconf{ColorIPTC} = "#404000"; $tmpconf{ColorEXIF} = "#006000"; $tmpconf{ColorFile} = "#004040"; $tmpconf{ColorDir} = "#000060"; $tmpconf{ColorThumbBG} = "#ccc"; })->pack(-side => 'left'); labeledEntryColor($eF,'top',$w,"Background color: window",'Set',\$tmpconf{ColorBG}); labeledEntryColor($eF,'top',$w,"Background color: menu",'Set',\$tmpconf{ColorMenuBG}); labeledEntryColor($eF,'top',$w,"Background color: thumbnail table",'Set',\$tmpconf{ColorBG2}); labeledEntryColor($eF,'top',$w,"Background color: picture",'Set',\$tmpconf{ColorBGCanvas}); labeledEntryColor($eF,'top',$w,"Background color: highlight",'Set',\$tmpconf{ColorHlBG}); labeledEntryColor($eF,'top',$w,"Background color: active",'Set',\$tmpconf{ColorActBG}); labeledEntryColor($eF,'top',$w,"Background color: entry fields",'Set',\$tmpconf{ColorEntry}); labeledEntryColor($eF,'top',$w,"Background color: selections",'Set',\$tmpconf{ColorSel}); labeledEntryColor($eF,'top',$w,"Background color: selected button",'Set',\$tmpconf{ColorSelBut}); labeledEntryColor($eF,'top',$w,"Foreground color: selections",'Set',\$tmpconf{ColorSelFG}); labeledEntryColor($eF,'top',$w,"Font color: menu",'Set',\$tmpconf{ColorMenuFG}); labeledEntryColor($eF,'top',$w,"Font color: name",'Set',\$tmpconf{ColorName}); labeledEntryColor($eF,'top',$w,"Font color: comment",'Set',\$tmpconf{ColorComm}); labeledEntryColor($eF,'top',$w,"Font color: IPTC",'Set',\$tmpconf{ColorIPTC}); labeledEntryColor($eF,'top',$w,"Font color: EXIF",'Set',\$tmpconf{ColorEXIF}); labeledEntryColor($eF,'top',$w,"Font color: size",'Set',\$tmpconf{ColorFile}); labeledEntryColor($eF,'top',$w,"Font color: folder",'Set',\$tmpconf{ColorDir}); # ############### advanced notepad ######################## $w = 37; $dF->Checkbutton(-variable => \$verbose, -text => "verbose: print some debug info to STDOUT")->pack(-anchor => 'w'); my $trackB = $dF->Checkbutton(-variable => \$tmpconf{trackPopularity}, -text => "Track popularity of pictures (how often viewed in Mapivi)")->pack(-anchor => 'w'); $balloon->attach($trackB, -msg => "If this is enabled Mapivi will increase a counter\neverytime a picture is viewed with Mapivi.\nThe counter value is not saved in the picture\njust in the Mapivi database."); $dF->Checkbutton(-variable => \$tmpconf{CheckForLinks}, -text => "Check if a file is a link before processing it")->pack(-anchor => 'w'); my $addMapB = $dF->Checkbutton(-variable => \$tmpconf{AddMapiviComment}, -text => "add a comment to pictures created/processed by mapivi")->pack(-anchor => 'w'); $balloon->attach($addMapB, -msg => "If this is enabled Mapivi will add a JPEG comment\nto each created or processed picture."); $dF->Checkbutton(-variable => \$tmpconf{EXIFshowApp}, -text => "show App*-Info and MakerNotes and ColorComponents in EXIF info")->pack(-anchor => 'w'); my $ctcb = $dF->Checkbutton(-variable => \$tmpconf{CenterThumb}, -text => "center selected thumbnail")->pack(-anchor => 'w'); $balloon->attach($ctcb, -msg => "center the selected thumbnail,\nto show at least the next\nand the previous thumbnail"); $dF->Checkbutton(-variable => \$tmpconf{ShowNextPicAfterDel}, -text => "jump to next picture after delete")->pack(-anchor => 'w'); $dF->Checkbutton(-variable => \$tmpconf{BeepWhenLooping}, -text => "play a beep sound when jumping to the first e.g. last picture")->pack(-anchor => 'w'); my $ctdb = $dF->Checkbutton(-variable => \$tmpconf{CentralThumbDB}, -text => "Store all thumbnails in a central place")->pack(-anchor => 'w'); $balloon->attach($ctdb, -msg => "If this is enabled all thumbnails will be\nstored in a central place (~/.maprogs/thumbDB),\nif disabled thumbnails will be stored\ndecentral in sub folders (.thumbs)."); my $tbb = $dF->Checkbutton(-variable => \$tmpconf{ToggleBorder}, -text => "Remove the window border in fullscreen mode (experimental)")->pack(-anchor => 'w'); $balloon->attach($tbb, -msg => "Enable a real fullscreen mode,\nbut may not work as expected on all\noperating systems and window managers.\nTry it, switch to fullscreen (key: F11),\nif it works it's fine, if not just disable it again."); my $fblfb = $dF->Checkbutton(-variable => \$tmpconf{SlowButMoreFeatures}, -text => "enable some time intensive features (needs restart)")->pack(-anchor => 'w'); $balloon->attach($fblfb, -msg => "If this is selected, you will get e.g. some\nmore zoom levels.\nThis may slow down Mapivi a bit, so this option\nis only recommended for faster computers."); $dF->Checkbutton(-variable => \$tmpconf{CheckNewKeywords}, -text => "Check for new keywords and ask to add them to my catalog")->pack(-anchor => 'w'); $dF->Checkbutton(-variable => \$tmpconf{UrgencyChangeWarning}, -text => "Show a warning when a rating/urgency has been changed")->pack(-anchor => 'w'); $dF->Checkbutton(-variable => \$tmpconf{AutoImport}, -text => "Start import wizard at Mapivi startup if source folder is available")->pack(-anchor => 'w'); $dF->Checkbutton(-variable => \$tmpconf{SelectLastPic}, -text => "Select last shown picture after Mapivi startup")->pack(-anchor => 'w'); my $opfb = $dF->Checkbutton(-variable => \$tmpconf{supportOtherPictureFormats}, -text => "Show also other picture formats than just JPEG. Danger! (experimental feature)")->pack(-anchor => 'w'); $balloon->attach($opfb, -msg => "If this is selected, Mapivi will also show other picture formats (e.g. GIF and PNG),\nat least as thumbnails. But adding IPTC and other meta information is not possible.\nThis feature is not tested, so use it on your own risk."); my $aspS = labeledScale($dF, 'top', $w, "Delta factor for aspect ratio (%)", \$tmpconf{AspectSloppyFactor}, 0, 5, 0.1); $balloon->attach($aspS, -msg => "Adjust the accuracy of the aspect ratio display (rightmost column size).\nThis is the delta factor in percent when calculating the aspect ratio.\nFor example a picture with size 304x200 will still be displayed as a 3:2 picture,\nif the factor is equal or bigger than 1.4%.\nUse 0.0% if you need really exact values.\n3.0% is acceptable for me."); labeledScale($dF, 'top', $w, "preview size in filter dialog (pixel)", \$tmpconf{FilterPrevSize}, 50, 500, 5); labeledScale($dF, 'top', $w, "Comment text box height (lines)", \$tmpconf{CommentHeight}, 1, 50, 1); labeledScale($dF, 'top', $w, "Gamma value, when displaying pictures", \$tmpconf{Gamma}, 0.1, 10.0, 0.01); labeledScale($dF, 'top', $w, "Maximum number of lines of a IPTC info/comment", \$tmpconf{LineLimit}, 1, 20, 1); labeledScale($dF, 'top', $w, "Maximum length of a comment line", \$tmpconf{LineLength}, 5, 80, 1); my $epv = labeledEntry($dF, 'top', $w, "External picture viewer",\$tmpconf{ExtViewer}); $balloon->attach($epv, -msg => "Enter the command to start the external picture viewer here.\nYou may also add options.\nExamles: \"gqview -f\", \"gthumb --fullscreen\""); my $evmf = $dF->Checkbutton(-variable => \$tmpconf{ExtViewerMulti}, -text => "External picture viewer can handle multiple files")->pack(-anchor => 'w'); $balloon->attach($evmf, -msg => 'If the external viewer is able to handle multiple files enable this. Example: You have selected 3 pictures. If this option is enabled one viewer will be started like this: "viewer pic1.jpg pic2.jpg pic3.jpg", if not 3 viewers will be started like this: "viewer pic1.jpg" "viewer pic2.jpg" "viewer pic3.jpg".'); my $emt = labeledEntry($dF, 'top', $w, "External mail tool",\$tmpconf{MailTool}); $balloon->attach($emt, -msg => "Enter the command to start the external mail tool here.\nExamles: \"thunderbird\", \"mozilla-thunderbird\", \"evolution\""); # ############### button frame ######################## my $butF = $ow->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $butF->Button(-text => 'OK', -command => sub { %config = %{ dclone(\%tmpconf) }; applyConfig(); $example->delete if $example; $config{OptionsLastPad} = $notebook->raised(); $ow->destroy(); } )->pack(-side=>'left', -expand => 1, -fill =>'x'); # bind ctrl-x to OK button $ow->bind('', sub { $OKB->invoke; }); $butF->Button(-text => "Apply", -command => sub { %config = %{ dclone(\%tmpconf) }; $previewB->invoke() if (Exists($previewB)); applyConfig(); } )->pack(-side=>'left', -expand => 1, -fill =>'x'); my $Xbut = $butF->Button(-text => 'Cancel', -command => sub { $example->delete if $example; $config{OptionsLastPad} = $notebook->raised(); $ow->destroy(); } )->pack(-side=>'left', -expand => 1, -fill =>'x'); $ow->bind('', sub { $Xbut->invoke; }); $ow->bind('', sub { $Xbut->invoke; }); $ow->Popup; } ############################################################## # applyConfig ############################################################## sub applyConfig { $progressBar->configure(-blocks => $config{MaxProcs}, -to => $config{MaxProcs}); $dirtree->configure(-showhidden => $config{ShowHiddenDirs}); $comS->configure( -foreground=>$config{ColorComm}, -background=>$config{ColorBG2}); $iptcS->configure(-foreground=>$config{ColorIPTC}, -background=>$config{ColorBG}); $exifS->configure(-foreground=>$config{ColorEXIF}, -background=>$config{ColorBG2}); $fileS->configure(-foreground=>$config{ColorFile}, -background=>$config{ColorBG}); $dirS->configure( -foreground=>$config{ColorDir}, -background=>$config{ColorBG2}); toggleHeaders(); $top->optionAdd('*selectBackground', $config{ColorSel}, 'userDefault'); $picLB->configure(-selectbackground => $config{ColorSel}); # undocumented feature, but does not work (it stops the execution of the sub) # $top->RecolorTree(-background => $config{ColorBG}); # we don't try to color everything, just a few widgets to give a visual feedback $top->configure (-bg => $config{ColorBG}); $dirtree->configure(-bg => $config{ColorBG}, -selectbackground => $config{ColorSel}); $c->configure (-bg => $config{ColorBGCanvas}); $menubar->configure(-bg => $config{ColorBG}); my @wlist = $top->children; foreach my $widget (@wlist) { my $ref = ref($widget); if ($ref eq "Tk::Frame" or $ref eq "Tk::Menu") { $widget->configure(-bg => $config{ColorBG}); } } # don't know if this is very appropriate $top->optionAdd('*selectBackground', $config{ColorSel}, 'userDefault'); $top->optionAdd("*highlightColor", $config{ColorSel}, 'userDefault'); $top->optionAdd("*highlightBackground", $config{ColorHlBG}, 'userDefault'); $top->optionAdd("*background", $config{ColorBG}, 'userDefault'); $top->optionAdd("*activeBackground", $config{ColorActBG}, 'userDefault'); # change font my $font = $top->Font(-family => $config{FontFamily}, -size => $config{FontSize}, ); $top->optionAdd("*font", $font, "userDefault"); $top->Walk( sub { print "changing widget font ",ref($_[0])," to $font\n" if $verbose; eval { $_[0]->configure(-font => $font); } }); showHideFrames(); $top->update; setAdjusterPos(); startStopClock(); #print "Sortby Apply = ".$config{SortBy}."\n"; #??? } ############################################################## # showHideFrames - pack or packForget the EXIF and Comment # frame ############################################################## sub showHideFrames { # the pack command seems only to work, if we packforget all # following widgets # so we always remove them all - from the inner to the outer ones # and pack them again according to the actual settings foreach ($c, $capF, $comF, $exifF, $mainF, $thumbA, $thumbF, $dirA, $dirF, $subF, $infoF) { $_->packForget if ($_->ismapped); } if ($config{ShowMenu}) { $top->configure(-menu => $menubar); } else { $top->configure(-menu => ""); } if ($config{ShowInfoFrame}) { $infoF->pack(-side => 'top', -anchor=>'w', -padx => 0, -pady => 0, -fill => 'x', -expand => "0"); } $subF->pack(-side => 'top', -anchor=>'w', -padx => 0, -pady => 0, -fill => 'both', -expand => 1); if ($config{ShowDirTree}) { $dirF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -expand => 1, -fill => "both"); $dirA->packAfter($dirF, -side => "left", -padx => 3) if (($config{ShowThumbFrame}) or ($config{ShowPicFrame})); } if ($config{ShowThumbFrame}) { $thumbF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -expand => 1, -fill => "both"); } if ($config{ShowPicFrame}) { $thumbA->packAfter($thumbF, -side => "left", -padx => 3) if ($config{ShowThumbFrame}) ; $mainF->pack(-side => "left", -anchor=>'w', -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0); } if ($config{ShowEXIFField}) { $exifF->pack(-fill => 'x', -expand => 1, -padx => 0, -pady => 0); } if ($config{ShowCommentField}) { $comF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ; } if ($config{ShowCaptionField}) { $capF->pack(-fill => 'x',-expand => "1", -anchor=>'w', -padx => 0, -pady => 0) ; } $c->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0, -ipadx => 0, -ipady => 0); } ############################################################## # buttonComment ############################################################## sub buttonComment { my $widget = shift; my $side = shift; my $but = $widget->Checkbutton(-variable => \$config{AddMapiviComment}, -anchor => 'w', -text => "Add comment" )->pack(-side => $side, -anchor => 'w', -padx => 5, -pady => 3); $balloon->attach($but, -msg => "Add a comment to pictures created\nor processed with Mapivi"); } ############################################################## # buttonBackup ############################################################## sub buttonBackup { my $widget = shift; my $side = shift; my $but = $widget->Checkbutton(-variable => \$config{MakeBackup}, -anchor => 'w', -text => "Create backup" )->pack(-side => $side, -anchor => 'w', -padx => 5, -pady => 3); $balloon->attach($but, -msg => "Create a backup of the original picture\nin the same folder named \"name-bak.jpg\""); } ############################################################## # labeledEntryButton - build a frame containing a labeled entry # and a button with a file selector ############################################################## sub labeledEntryButton { # input values my ($parentWidget, $position, $width, $label, $buttext, $varRef, $dir) = @_; my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef); setFileButton($frame,"right",$buttext,$label,$varRef, $dir); return $frame; } ############################################################## # labeledEntryColor - build a frame containing a labeled entry # and a button with a color selector ############################################################## sub labeledEntryColor { # input values my ($parentWidget, $position, $width, $label, $buttext, $varRef) = @_; my $frame = labeledEntry($parentWidget, $position, $width, $label, $varRef); setColorButton($frame,"right",$buttext,$varRef); return $frame; } ############################################################## # labeledEntry - build a frame containing a labeled entry # for backward compability ############################################################## sub labeledEntry { # input values my ($parentWidget, $position, $width, $label, $varRef, $width2) = @_; labeledEntryFlex($parentWidget, $position, $width, $label, $varRef, "left", $width2); } ############################################################## # labeledEntryFlex - build a frame containing a labeled entry ############################################################## sub labeledEntryFlex { # input values my ($parentWidget, $position, $width, $label, $varRef, $int_pos, $width2) = @_; # $width2 is optional and the width of the entry field, defaults to the first width $width2 = $width unless defined $width2; my $frame = $parentWidget->Frame()->pack(-side => $position, -expand => 0, -fill => 'x', -padx => 0, -pady => 3); $frame->Label(-text => $label, -width => $width, -anchor => 'w', )->pack(-side => $int_pos, -padx => 3, -fill => 'x'); my $entry; if (MatchEntryAvail) { # set the choice list to an empty list, if it's undefined $entryHistory{$label} = [] unless (defined $entryHistory{$label}); $entry = $frame->MatchEntry(-textvariable => $varRef, -choices => $entryHistory{$label}, -ignorecase => 0, -maxheight => 20, # add the new value to the list when enter or tab is pressed -entercmd => sub { addItemToList($entry, $entryHistory{$label}, $varRef); }, -tabcmd => sub { addItemToList($entry, $entryHistory{$label}, $varRef); }, -width => $width2, )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0); } else { $entry = $frame->Entry(-textvariable => $varRef, -width => $width2, )->pack(-side => $int_pos, -expand => 1, -fill => 'x', -padx => 0); } $entry->xview('end'); $entry->icursor('end'); return $frame; } ############################################################## # addItemToList - add a new value to the list and remove double entries ############################################################## sub addItemToList { my $widget = shift; my $listref = shift; my $varref = shift; return if (!defined $$varref); return if ($$varref eq ""); # todo: remove double values and remove old values push @{$listref}, $$varref; my %d; # build a hash foreach (@{$listref}) { $d{$_} = 1; } @{$listref} = (sort { uc($a) cmp uc($b); } keys %d); $widget->configure(-choices => $listref); } ############################################################## # labeledEntry2 - build a frame containing two labeled entrys ############################################################## sub labeledEntry2 { # input values my ($parentWidget, $position, $width1, $width2, $label1, $varRef1, $label2, $varRef2) = @_; my $frame = $parentWidget->Frame()->pack(-side => $position, -expand => 0, -fill => 'x', -padx => 3, -pady => 3); $frame->Label(-text => $label1, -width => $width1, -anchor => 'w', -bg => $config{ColorBG}, )->pack(-side => "left", -padx => 3); my $entry1 = $frame->Entry(-textvariable => $varRef1, -width => $width2, )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1); $entry1->xview('end'); $entry1->icursor('end'); $frame->Label(-text => $label2, -width => $width1, -anchor => 'w', -bg => $config{ColorBG}, )->pack(-side => "left", -padx => 3); my $entry2 = $frame->Entry(-textvariable => $varRef2, -width => $width2, )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1); $entry2->xview('end'); $entry2->icursor('end'); return $frame; } ############################################################## # labeledDoubleEntry - build a frame containing two labeled entrys ############################################################## sub labeledDoubleEntry { # input values my ($parentWidget, $position, $width, $label, $label2, $dVarRef, $dBalloon, $tVarRef, $tBalloon) = @_; my $fullframe = $parentWidget->Frame()->pack(-side => $position, -fill => 'x', -expand => 0, -padx => 0, -pady => 0); my $frame = labeledEntry($fullframe, 'left', $width, $label, $dVarRef, ($width+5)); $balloon->attach($frame, -msg => $dBalloon); $frame = labeledEntry($fullframe, 'left', $width, $label2, $tVarRef, ($width+5)); $balloon->attach($frame, -msg => $tBalloon); return $fullframe; } ############################################################## # labeledScale - build a frame containing a labeled scale ############################################################## sub labeledScale { # input values my ($parentWidget, $position, $width, $label, $varRef, $from, $to, $res) = @_; my $frame = $parentWidget->Frame(-bd => 0)->pack(-side => $position, -fill => 'x', -padx => 3, -pady => 3); $frame->Label(-text => $label, -width => $width, -anchor => 'w', -bg => $config{ColorBG}, )->pack(-side => "left", -padx => 3); my $scale = $frame->Scale(-variable => $varRef, #-length => $width, -from => $from, -to => $to, -resolution => $res, -sliderlength => 30, -orient => 'horizontal', -width => 15, -showvalue => 0, )->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1); $frame->Label(-textvariable => $varRef, -width => 5, -anchor => "e", -bd => $config{Borderwidth}, -relief => "sunken", -bg => $config{ColorBG}, )->pack(-side => "left", -padx => 1); return $frame; } ############################################################## # setFileButton - open a file selector and set file or dir name ############################################################## sub setFileButton { # input values my ($parentWidget, $position, $butlabel, $fileselLabel, $varRef, $dir) = @_; # $dir is optional, if defined and true a dir will be selected instead of a file $parentWidget->Button(-text => $butlabel, -command => sub { if ($EvilOS) { # windows my $file = $parentWidget->getOpenFile(); if ((defined $file) and (-f $file)) { $$varRef = $file; } if ((defined $dir) and ($dir == 1)) { if (!-d $file) { $$varRef = dirname($file); } } } else { # non windows system my $fs = $parentWidget->FileSelect(-title => $fileselLabel, -directory => dirname($$varRef), -width => 30, -height => 30); if ((defined $dir) and ($dir == 1)) { $fs->configure(-verify => ['-d']); } my $file = $fs->Show; if (defined $file and $file ne "") { if (-f $file) { $$varRef = $file; } if ((defined $dir) and ($dir == 1) and (-d $file)) { $$varRef = $file; } } } }, )->pack(-side => $position); } ############################################################## # setColorButton - open a color selector and set the color ############################################################## sub setColorButton { # input values my ($parentWidget, $position, $butlabel, $varRef) = @_; my $ccbut; $ccbut = $parentWidget->Button(-text => $butlabel, -pady => 0, -bg => $$varRef, -command => sub { my $rc = color_chooser(); if (defined $rc) { $ccbut->configure(-bg => $rc); $$varRef = $rc; # this is needed when updating the button if ($$varRef eq 'black') { $ccbut->configure(-fg => 'white'); } else { $ccbut->configure(-fg => 'black'); } } })->pack(-side => $position, -pady => 0,); # this is needed when drawing the button if ($$varRef eq 'black') { $ccbut->configure(-fg => 'white'); } else { $ccbut->configure(-fg => 'black'); } } ############################################################## # color_chooser - open a window and offer some colors to select ############################################################## sub color_chooser { my $title = 'Please select a color'; # open window my $win = $top->Toplevel(); $win->withdraw; $win->title($title); $win->iconimage($mapiviicon) if $mapiviicon; $win->iconname($title); my $frame; my $return_color = 0; my $colP = $win->Button(-text => 'Color picker', -height => 0, -width => 0, -padx => 0, -pady => 0, -relief => "groove", -background => $config{ColorPicker}, -command => sub { $return_color = $config{ColorPicker}; } )->pack(-padx => 0, -pady => 0); $balloon->attach($colP, -msg => $config{ColorPicker}); my $colorF = $win->Frame()->pack(-fill => 'both', -expand => "1"); my $i = 0; foreach (@allcolors) { $i++; if ($i == 1 or $i % 12 == 1) { # a frame for the first and every 12th button (modulo) $frame = $colorF->Frame()->pack(-side => "left", -anchor => "n"); } my $but; $but = $frame->Button(#-bitmap => "cbut", -text => " ", -height => 0, -width => 0, -padx => 0, -pady => 0, -relief => "groove", -background => $_, -command => sub { my $col = $but->cget(-bg); $return_color = $col; } )->pack(-padx => 0, -pady => 0); $balloon->attach($but, -msg => $_); } my $xBut = $win->Button(-text => "Close", -command => sub { print "returning: undef\n"; $return_color = undef; }, )->pack(-fill => 'x'); # 50 ways to leave your window ;) $win->bind('' , sub {$xBut->invoke;}); $win->bind('' , sub {$xBut->invoke;}); $win->protocol("WM_DELETE_WINDOW" => sub {$xBut->invoke;} ); $xBut->focus; $win->Popup; #repositionWindow($win); $win->waitVariable(\$return_color); $win->withdraw; $win->destroy; return $return_color; } ############################################################## # makeNewDir - get a new dir name from the user and create this # new dir in the actual dir ############################################################## sub makeNewDir { my $path = shift; my $tree = shift; my $newDir = "newdir"; my $rc = myEntryDialog("Make a new folder","Enter name of new folder in $path",\$newDir); return if ($rc ne 'OK' or $newDir eq ""); if (-d "$path/$newDir") { $top->messageBox(-icon => 'warning', -message => "$newDir already exists!", -title => 'Error', -type => 'OK'); return; } if (!mkdir "$path/$newDir", 0750) { $top->messageBox(-icon => 'warning', -message => "error making dir $path/$newDir: $!", -title => 'Error', -type => 'OK'); return; } dirSave("$path/$newDir"); exists &Tk::DirTree::chdir ? $tree->chdir("$path/$newDir") : $tree->set_dir("$path/$newDir"); exists &Tk::DirTree::chdir ? $dirtree->chdir("$path/$newDir") : $dirtree->set_dir("$path/$newDir"); } ############################################################## # getRightDir - get the selected or the actual dir ############################################################## sub getRightDir { my $dir = ""; # if the dir frame is visible, try to get the selected dir if ($dirF->ismapped()) { $dir = ($dirtree->selectionGet())[0]; # normalize the path if (defined $dir) { $dir =~ s/\\/\//g; # replace Windows path delimiter with UNIX style \ -> / $dir =~ s/\/+/\//g; # replace multiple slashes with one // -> / } } # this is the fall back solution $dir = $actdir if ((!defined $dir) or ($dir eq "") or (!-d $dir)); return $dir; } ############################################################## # cleanOneDir - remove the .thumbs and .exif subdir ############################################################## sub cleanOneDir { my $dir = shift; my ($rc, $subdir); my @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname"); foreach $subdir (@subdirs) { if (-d $subdir) { $rc = rmtree($subdir, 0, 1); # dir, 0 = no message for each file, 1 = skip write protected files print "removed $rc elements in $subdir\n" if $verbose; } } } ############################################################## # deleteDir ############################################################## sub deleteDir { my $dir = getRightDir(); if (!-d $dir) { $top->messageBox(-icon => 'warning', -message => "Sorry, but \"$dir\" does not exists!", -title => 'Error', -type => 'OK'); return; } my $dirname = basename($dir); my $rc = $top->messageBox(-icon => 'question', -message => "Do you really want to delete folder \"$dirname\"\n($dir)?\nThere is no undelete!", -title => "Delete folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); # get some infos about the dir my $dirs = 0; my $files = 0; my $size = 0; my $timeout = ""; my $start_time = Tk::timeofday(); $userinfo = "scanning folder ..."; $userInfoL->update; $top->Busy; find(sub { # jump out after 5 seconds if (Tk::timeofday()-$start_time > 5) { $timeout = " at least (scanning stopped by timeout)"; $File::Find::prune = 1; return; } $dirs++ if (-d "$File::Find::name"); if (-f "$File::Find::name") { $files++; $size += getFileSize("$File::Find::name", NO_FORMAT); } }, "$dir"); $top->Unbusy; $userinfo = "folder scanned!"; $userInfoL->update; $size = computeUnit($size); my $question = sprintf "There are%s\n%8d folders and\n%8d files with a total size of\n%8s in \"%s\".\nReally delete?", $timeout, $dirs, $files, $size, $dirname; $rc = $top->messageBox(-icon => 'question', -message => $question, -title => "Delete folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); print "rmtree: dir = $dir\n" if $verbose; rmtree($dir, 0, 1); # dir, 0 = no message for each file, 1 = skip write protected files # remove the deleted pics from the search database cleanDatabaseFolder($dir); # refresh the dir tree my $path = dirname($dir); while (!-d $path) { $path = dirname($dir); last if ($path eq ""); } my $slash = ""; $slash = "/" if ($Tk::VERSION < 800.025); # the additional slash is needed for older Tk! # todo I don't know if 800.025 is really exactly the version the behavior changed $dirtree->close("$slash$path"); $dirtree->open("$slash$path"); # open parent dir if we've deleted the actual dir openDirPost($path) unless (-d $dir); $userinfo = "ready! (removed folder \"$dirname\" with $files files)"; $userInfoL->update; } ############################################################## # renameDir ############################################################## sub renameDir { my $dir = getRightDir(); if (!-d $dir) { warn "dir $dir is no dir"; return; } my $path = dirname($dir); my $newDir = basename($dir); my $rc = myEntryDialog("rename folder","Enter new name for folder $dir",\$newDir); return if ($rc ne 'OK' or $newDir eq ""); if (-d "$path/$newDir") { $top->messageBox(-icon => 'warning', -message => "$newDir already exists!", -title => 'Error', -type => 'OK'); return; } if (!rename "$dir", "$path/$newDir") { $top->messageBox(-icon => 'warning', -message => "error renaming folder $dir to $path/$newDir: $!", -title => 'Error', -type => 'OK'); return; } # refresh the dir tree display my $slash = ""; $slash = "/" if ($Tk::VERSION < 800.025); # the additional slash is needed for older Tk! $dirtree->close("$slash$path"); $dirtree->open("$slash$path"); exists &Tk::DirTree::chdir ? $dirtree->chdir("$path/$newDir") : $dirtree->set_dir("$path/$newDir"); $dirtree->Subwidget("scrolled")->configure(-directory => "$path/$newDir"); if ($dirtree->info("exists", "$path/$newDir")) { $dirtree->see("$path/$newDir"); } # select the new dir $dirtree->selectionSet("$slash$path/$newDir"); $actdir = "$path/$newDir" if (!-d $actdir); } ############################################################## # calcSize - calc new picture size # considering the aspect ratio and landscape/portait # mode ############################################################## sub calcSize { my ($w, $h, $ow, $oh) = @_; my $aspect = $ow/$oh; my ($nw, $nh); if ($ow >= $oh) { # landscape $nw = $w; $nh = round($nw/$aspect); } else { # portrait $nh = $w; $nw = round($aspect*$nh); } return ($nw, $nh); } ############################################################## # qualityBalloon ############################################################## sub qualityBalloon { $balloon->attach(shift, -msg => "Quality of picture\nAppropriate settings are between 50% and 95%,\n80% is often a good tradeoff between size and quality for web and email\nfor further processing and best quality 95% is recommended\nValues over 95% just increase file size, not quality"); } ############################################################## # changeSizeQuality - change the size and quality of all # selected JPEG pictures # based on code from Hans-Peter Rangol 10/13/2002. # Needs mogrify from ImageMagick, preserves Exif-Data, # depending on the version of mogrify (at least 5.1.1 does not!) ############################################################## sub changeSizeQuality { return if (!checkExternProgs("changeSizeQuality", "mogrify")); my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirthumb, $dirtpic, $i); my $rc = 0; if ($config{WarnBeforeResize}) { my $rc = checkDialog("Change size quality", "This function will change the size and/or quality\ of $selected selected pictures to a choosable value.\ The EXIF/IPTC and JPEG comment may be preserved,\ depending on your version of the program mogrify.\ So please make a test with a backup picture first.\ It's possible to save and restore the EXIF info with\ menu: \"EXIF info\"->\"save\".\n", \$config{WarnBeforeResize}, "ask every time", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); } # get the size of the first picture my ($width, $height) = getSize($sellist[0]); my $origW = $width; my $origH = $height; my $widthP = 100; my $heightP = 100; if ($height == 0) { # avoid division by zero $top->messageBox(-message => "Sorry, but the size of ".basename($sellist[0])." is not available - Aborting.", -icon => 'warning', -title => "No size info", -type => 'OK'); return; } my $aspect = $width/$height; my $PixPro = "pro"; # open dialog window my $myDiag = $top->Toplevel(); $myDiag->title("Change size/quality"); $myDiag->iconimage($mapiviicon) if $mapiviicon; $myDiag->Label(-text =>"Change the size and/or quality of $selected selected pictures", -bg => $config{ColorBG} )->pack(-anchor => 'w',-padx => 3,-pady => 3); #my $scf = $myDiag->Frame()->pack(-expand => 1, -fill =>'both',-padx => 3,-pady => 3); my $qS = labeledScale($myDiag, 'top', 18, "Quality (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); # check if the Imagemagick version supports the strip command my $strip = 0; $strip = 1 if (`mogrify` =~ m/.*-strip.*/); # check, if the ImageMagick version supports the unsharp command my $unsharp = 0; $unsharp = 1 if (`mogrify` =~ m/.*-unsharp.*/); my $keepaspect = 1; my $csf1 = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); $csf1->Button(-text => "original size", -width => 12, -command => sub { $height = $origH; $width = $origW; $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf1->Button(-text => "email preset", -command => sub { $PixPro = "pix"; $keepaspect = 1; $config{PicQuality} = 80; if ($unsharp) { $config{Unsharp} = 1; $config{PicSharpen} = 0; } else { $config{Unsharp} = 0; $config{PicSharpen} = 1; } $config{PicBlur} = 0; ($width, $height) = calcSize(640, 480, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf1->Button(-text => "half", -width => 9, -command => sub { $PixPro = "pro"; $keepaspect = 1; $widthP = 50; $heightP = 50; $width = round($origW * $widthP/100); $height = round($origH * $heightP/100); })->pack(-side => "left", -padx => 0); my $csf2 = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); $csf2->Button(-text => "640x480", -width => 9, -command => sub { $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(640, 480, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "720x576", -width => 9, -command => sub { $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(720, 576, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "800x600", -width => 9, -command => sub { $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(800, 600, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "1024x768", -width => 9, -command => sub { $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(1024, 768, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); $csf2->Button(-text => "1280x960", -width => 9, -command => sub { $PixPro = "pix"; $keepaspect = 1; ($width, $height) = calcSize(1280, 960, $origW, $origH); $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); })->pack(-side => "left", -padx => 0); my $w = 20; $myDiag->Checkbutton(-variable => \$keepaspect, -anchor => 'w', -text => "Keep aspect ratio (original size ${origW}x$origH)")->pack(-anchor => 'w'); $myDiag->Radiobutton(-text => "use absolute size (pixel)", -variable => \$PixPro, -value => "pix")->pack(-anchor => 'w'); my $labFw = labeledEntry($myDiag, 'top', $w, "Width (pixel)", \$width); my $labFh = labeledEntry($myDiag, 'top', $w, "Height (pixel)", \$height); $myDiag->Radiobutton(-text => "use relative size (%)", -variable => \$PixPro, -value => "pro")->pack(-anchor => 'w'); my $labFwp = labeledEntry($myDiag, 'top', $w, "Width (%)", \$widthP); my $labFhp = labeledEntry($myDiag, 'top', $w, "Height (%)", \$heightP); my $labEw = ($labFw->children)[1]; my $labEh = ($labFh->children)[1]; my $labEwp = ($labFwp->children)[1]; my $labEhp = ($labFhp->children)[1]; $labEw->bind('', sub { if ($keepaspect) { $height = round($width/$aspect); # int() does not round! } $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); $PixPro = "pix"; }); $labEh->bind('', sub { if ($keepaspect) { $width = sprintf("%.0f",($aspect*$height)); } $widthP = round($width/$origW * 100); $heightP = round($height/$origH * 100); $PixPro = "pix"; }); $labEwp->bind('', sub { if ($keepaspect) { $heightP = $widthP; # int() does not round! } $width = round($origW * $widthP/100); $height = sprintf("%.0f",($origH * $heightP/100)); $PixPro = "pro"; }); $labEhp->bind('', sub { if ($keepaspect) { $widthP = $heightP; } $width = round($origW * $widthP/100); $height = sprintf("%.0f",($origH * $heightP/100)); $PixPro = "pro"; }); my $filf = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); $filf->Label(-text => "Resize filter", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $filf->Optionmenu(-options => [qw(Point Box Triangle Hermite Hanning Hamming Blackman Gaussian Quadratic Cubic Catrom Mitchell Lanczos Bessel Sinc)], -variable => \$config{ResizeFilter}, -textvariable => \$config{ResizeFilter})->pack(-side => "left", -anchor => 'w'); if ($strip) { $myDiag->Checkbutton(-variable => \$config{PicStrip}, -anchor => 'w', -text => "Strip all meta info (EXIF, IPTC, ...)")->pack(-anchor => 'w'); } # option to sharpen the image with an unsharp mask operator if ($unsharp) { my $umF = $myDiag->Frame()->pack(-fill =>'x'); my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp}, -anchor => 'w', -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $balloon->attach($umcB, -msg => "The unsharp option sharpens an image. We convolve the image with a Gaussian operator of the given radius and standard deviation (sigma). For reasonable results, radius should be larger than sigma. Use a radius of 0 to have the method select a suitable radius."); $umF->Button(-text => "Options", -anchor => 'w', -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3); } my $sS = labeledScale($myDiag, 'top', 18, "Sharpness (radius)", \$config{PicSharpen}, 0, 10, 0.1); $balloon->attach($sS, -msg => "Resizing a picture to a smaller size usually causes some blurring\nuse this function to sharpen the picture and reduce the blurring\nHowever if the unsharp mask option is available I recommend using it instead of sharpen\nThis function is deactivated when set to 0"); my $blS = labeledScale($myDiag, 'top', 18, "Blur (radius)", \$config{PicBlur}, 0, 10, 0.1); $balloon->attach($blS, -msg => "Maybe used in conjunction with Sharpness"); buttonBackup($myDiag, 'top'); buttonComment($myDiag, 'top'); my $ButF = $myDiag->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 1; $myDiag->withdraw(); $myDiag->destroy(); })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $myDiag->withdraw(); $myDiag->destroy(); } )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $OKB->focus; $myDiag->Popup; $myDiag->waitWindow; return if ($rc != 1); # check if some files are links return if (!checkLinks($picLB, @sellist)); return if (checkWriteableMulti(@sellist) eq 'Cancel All'); $userinfo = "changing the size/quality of $selected pictures ..."; $userInfoL->update; my $pw = progressWinInit($top, "changing size/quality"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; $pic = basename($dpic); $dirthumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); my ($w, $h) = getSize($dpic); if ($PixPro eq "pro") { if (($w == 0) or ($h == 0)) { # avoid division by zero $top->messageBox(-message => "Sorry, but the size of $pic is not available - skipping picture.", -icon => 'warning', -title => "No size info", -type => 'OK'); next; } $width = sprintf("%.0f",($w * $widthP/100)); $height = sprintf("%.0f",($h * $heightP/100)); print "resizing to procent $w $h -> $width $height ($widthP $heightP)\n" if $verbose; } # call external command mogrify # the comment option of mogrify overwrites all existing comments! my $command = "mogrify"; $command .= " -blur ".$config{PicBlur} if ($config{PicBlur} > 0); $command .= " -size ${width}x${height}"; $command .= " -geometry ${width}x${height}"; $command .= "\\\!" if (!$keepaspect); $command .= " -filter ".$config{ResizeFilter}; $command .= " -strip ".$config{PicStrip} if ($config{PicStrip} and $strip); $command .= " -sharpen ".$config{PicSharpen} if ($config{PicSharpen} > 0); $command .= " -unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if ($config{Unsharp} and $unsharp); $command .= " -quality ".$config{PicQuality}." \"$dpic\""; print "changeSizeQuality: com = $command\n" if $verbose; execute($command); progressWinUpdate($pw, "changing size/quality ($i/$selected) ...", $i, $selected); # touch the thumbnail pic (set actual time stamp), to suppress rebuilding the next time print "new $width x $height old: $w x $h\n" if $verbose; touch($dirthumb) if (($width == $w) and ($height == $h)); # only when the size changed if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); showImageInfo($dpic) if ($dpic eq $actpic); } # foreach end progressWinEnd($pw); $userinfo = "ready! ($i of $selected changed)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # dragPic - enable panning of an object in a canvas # needs $c->{picWidth} and $c->{picHeight} to be # set to the object (picture) width and height ############################################################## sub dragPic { my $c = shift; # the canvas my $i = shift; # the item to drag $c->bind($i, '' => sub { ($c->{idx}, $c->{idy})=($Tk::event->x,$Tk::event->y); }); $c->bind($i, '' => sub { # actual mouse coordinates $c->configure(-cursor => "fleur"); my ($mx,$my) = ($Tk::event->x,$Tk::event->y); my ($x1,$x2) = $c->xview; my ($y1,$y2) = $c->yview; return if ($x1 == 0 and $x2 == 1 and $y1 == 0 and $y2 == 1); my $dx = 0; $dx = ($mx-$c->{idx})/$c->{picWidth} if ($c->{picWidth} >= 1); # avoid division by zero my $dy = 0; $dy = ($my-$c->{idy})/$c->{picHeight} if ($c->{picHeight} >= 1); # avoid division by zero $c->xviewMoveto($x1-$dx) unless ($x1 == 0 and $x2 == 1); $c->yviewMoveto($y1-$dy) unless ($y1 == 0 and $y2 == 1); ($c->{idx},$c->{idy}) = ($mx,$my); }); } ############################################################## # filterPic - apply a image filter to the picture ############################################################## sub filterPic { if (Exists($filterW)) { $filterW->deiconify; $filterW->raise; return; } my $fdir = $actdir; return if (!checkExternProgs("filterPic", "mogrify")); # check, if a new version of ImageMagick's mogrify with the unsharp and level option is available my $unsharp = 0; my $level = 0; my $usage = `mogrify`; $unsharp = 1 if ($usage =~ m/.*-unsharp.*/); $level = 1 if ($usage =~ m/.*-level.*/); my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); # check if some files are links return if (!checkLinks($picLB, @sellist)); my ($pic, $dpic, $dirtpic, $i); $userinfo = "image processing: preparing preview ..."; $userInfoL->update; # take the first picture as preview picture $dpic = $sellist[0]; $pic = basename($dpic); # open dialog window $filterW = $top->Toplevel(); $filterW->withdraw(); # hide window while populating $filterW->title("Image processing $pic"); $filterW->iconimage($mapiviicon) if $mapiviicon; my $p = $filterW; my $lF = $p->Frame()->pack(-anchor => "n", -side => "left"); my $rF = $p->Frame()->pack(-anchor => "n", -side => "left"); my $leftF = $lF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => "both", -side => "left"); my $rightF = $lF->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-expand => 1, -fill => "both", -side => "right"); $leftF->Label (-text => "Original")->pack(-fill => 'x'); $rightF->Label(-text => "Processed")->pack(-fill => 'x'); my %filters = ( "equalize" => 0, "normalize" => 0, "despeckle" => 0, "grayscale" => 0, "enhance" => 0, "negate" => 0, "antialias" => 0, "contrast" => 0, ); # try to get the saved filter settings if (-f "$configdir/filters") { my $hashRef = retrieve("$configdir/filters"); warn "could not retrieve filter settings" unless defined $hashRef; %filters = %{$hashRef}; } # layout infos: # leftF rightF # original processed # $icon($thumb) $thumbicon($thumbnew) # $photo($actdir/pic) $previewP($prevpic) my @xy = (0, 0); my $pc; my $icon; my $thumbicon; my $previewP; # the preview thumb my $thumb = "$trashdir/$thumbdirname/$pic.jpg"; my $thumbnew = "$trashdir/$thumbdirname/$pic"; my $thumbPreviewB; return if (!mycopy ("$fdir/$pic", "$thumb", OVERWRITE)); return if (!resizePic("$thumb", $config{FilterPrevSize}, $config{FilterPrevSize}, $config{PicQuality})); # the cropped preview pic my $prevpic = "$trashdir/$pic"; my $previewB; return if (!mycopy ("$fdir/$pic", $prevpic, OVERWRITE)); return if (!cropPic($prevpic, $config{FilterPrevSize}, $config{FilterPrevSize},0,0, $config{PicQuality})); if ((defined $thumb) and (-f $thumb)) { $icon = $top->Photo(-file => "$thumb", -gamma => $config{Gamma}); if ($icon) { $leftF->Label(-image => $icon )->pack(-padx => 3, -pady => 3,-anchor => "e"); $thumbPreviewB = $rightF->Button(-image => $icon, -command => sub { return if !mycopy("$thumb" , "$thumbnew", OVERWRITE); return if !mycopy("$fdir/$pic", "$prevpic" , OVERWRITE); # we need to recrop everytime, because the crop sector may be changed by the user @xy = getCorners($pc); # get the crop offset return if !cropPic($prevpic, $config{FilterPrevSize},$config{FilterPrevSize},$xy[0],$xy[1], $config{PicQuality}); $filterW->Busy; applyFilter("$thumbnew", \%filters, PREVIEW); if ($thumbicon) { # if the photo object is already defined we just need to configure it $thumbicon->configure(-file => "$thumbnew", -gamma => $config{Gamma}); } else { # else we define it $thumbicon = $top->Photo(-file => "$thumbnew", -gamma => $config{Gamma}); $thumbPreviewB->configure(-image => $thumbicon); } applyFilter("$prevpic", \%filters, PREVIEW); if ($previewP) { # if the photo object is already defined we just need to configure it $previewP->configure(-file => "$prevpic", -gamma => $config{Gamma}); } else { # else we define it $previewP = $top->Photo(-file => "$prevpic", -gamma => $config{Gamma}); $previewB->configure(-image => $previewP); } $filterW->Unbusy; })->pack(-padx => 3, -pady => 3,-anchor => 'w'); $balloon->attach($thumbPreviewB, -msg => "Press on the thumbnail or the Preview-button\nto see how the settings affect the picture"); } } # load the original picture in original size into a scrollable canvas # to set the crop frame $pc = $leftF->Scrolled("Canvas", -scrollbars => 'osoe', -width => $config{FilterPrevSize}, -height => $config{FilterPrevSize}, -relief => 'sunken', #-cursor => "fleur", -bd => $config{Borderwidth})->pack(-expand => 1, -fill => "both"); # this is needed for dragPic() ($pc->{picWidth}, $pc->{picHeight}) = getSize("$fdir/$pic"); $top->Busy; my $photo = $top->Photo(-file => "$fdir/$pic", -gamma => $config{Gamma}); my $id = $pc->createImage(0, 0, -image => $photo, -anchor => "nw"); dragPic($pc, $id); # enable panning of the pic in the canvas my ($x1, $y1, $x2, $y2) = $pc->bbox($id); $pc->configure(-scrollregion => [0, 0, $x2-$x1, $y2-$y1]); # load the croped preview picture $previewP = $top->Photo(-file => "$prevpic", -gamma => $config{Gamma}); if ($previewP) { $previewB = $rightF->Button(-image => $previewP, -command => sub {$thumbPreviewB->invoke();}, )->pack(-expand => 1, -fill => "both", -padx => 0, -pady => 0, -anchor => "nw"); $balloon->attach($previewB, -msg => "Press on the picture or the Preview-button\nto see how the settings affect the picture"); } $top->Unbusy; my $mF = $rF->Frame()->pack(-expand => 1, -fill => "both"); my $lbf = $mF->Frame()->pack(-expand => 1, -fill => "both", -side => "left"); my $rbf = $mF->Frame()->pack(-expand => 1, -fill => "both", -side => "right"); foreach (sort keys %filters) { $lbf->Checkbutton(-variable => \$filters{$_}, -anchor => 'w', -text => "$_")->pack(-anchor => 'w'); } #my $scF = $rF->Frame()->pack(-fill =>'x', -expand => "1"); my $qS = labeledScale($rF, 'top', 12, "Quality (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); my $sS = labeledScale($rF, 'top', 12, "Sharpness", \$config{PicSharpen}, 0, 10, 0.1); $balloon->attach($sS, -msg => "appropriate settings are between 0 (no sharpen) and 4,\nthe higher the value the slower the conversion"); my $colF = $rF->Frame()->pack(-fill =>'x'); my $colcB = $colF->Checkbutton(-variable => \$config{ColorAdj}, -anchor => 'w', -text => "Color adjustment")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $balloon->attach($colcB, -msg => "Adjust brightness, hue,\nsaturation and gamma"); $colF->Button(-text => "Options", -anchor => 'w', -command => sub { colorDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3); # sharpen the image with an unsharp mask operator if ($unsharp) { my $umF = $rF->Frame()->pack(-fill =>'x'); my $umcB = $umF->Checkbutton(-variable => \$config{Unsharp}, -anchor => 'w', -text => "Unsharp mask")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $balloon->attach($umcB, -msg => "The -unsharp option sharpens an image. We convolve the image with a Gaussian operator of the given radius and standard deviation (sigma). For reasonable results, radius should be larger than sigma. Use a radius of 0 to have the method select a suitable radius."); $umF->Button(-text => "Options", -anchor => 'w', -command => sub { unsharpDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3); } if ($level) { my $lvF = $rF->Frame()->pack(-fill =>'x'); my $lvB = $lvF->Checkbutton(-variable => \$config{Level}, -anchor => 'w', -text => "Level")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $balloon->attach($lvB, -msg => "Level adjusts the levels of an image by scaling the colors falling between specified white and black points to the full available quantum range."); $lvF->Button(-text => "Options", -anchor => 'w', -command => sub { levelDialog(); })->pack(-side => "left", -anchor => 'w', -padx => 3); } my $decoF = $rF->Frame()->pack(-fill =>'x'); $decoF->Checkbutton(-variable => \$config{FilterDeco}, -anchor => 'w', -text => "Add border or text")->pack(-side => "left", -anchor => 'w', -fill => 'x', -expand => 1); $decoF->Button(-text => "Options", -anchor => 'w', -command => sub {decorationDialog(scalar @sellist,0);})->pack(-side => "left", -anchor => 'w', -padx => 3); buttonBackup($rF, 'top'); buttonComment($rF, 'top'); my $ButF = $rF->Frame()->pack(-fill =>'x'); $ButF->Button(-text => "Preview", -command => sub {$thumbPreviewB->invoke();} )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { # save the filter settings nstore(\%filters, "$configdir/filters") or warn "could not store filter settings in file"; $uw->withdraw if (Exists($uw)); $lw->withdraw if (Exists($lw)); $colw->withdraw if (Exists($colw)); $decoW->withdraw if (Exists($decoW)); $filterW->withdraw(); # close window my $pw = progressWinInit($top, "Process pictures"); my $nr = 0; foreach my $dpic (@sellist) { last if progressWinCheck($pw); $pic = basename($dpic); next if (!checkWriteable($dpic)); last if (!makeBackup($dpic)); $nr++; progressWinUpdate($pw, "processing ($nr/".scalar @sellist.") ...", $nr, scalar @sellist); # we need to reread the picture to show the effect, # so we should clear the cachedPics list first deleteCachedPics($dpic); applyFilter($dpic, \%filters, NO_PREVIEW, "processing ($nr/".scalar @sellist.") ..."); updateOneRow($dpic, $picLB); # redisplay the processed picture if it is the actual picture showPic($dpic) if ($dpic eq $actpic); } progressWinEnd($pw); reselect($picLB, @sellist); $userinfo = "ready! ($nr of ".scalar @sellist." processed)"; $userInfoL->update; generateThumbs(ASK, SHOW); $filterW->destroy; })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $filterW->destroy if (Exists($filterW)); $uw->destroy if (Exists($uw)); $lw->destroy if (Exists($lw)); $colw->destroy if (Exists($colw)); $decoW->destroy if (Exists($decoW)); } )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $filterW->bind('', sub { $Xbut->invoke; }); $filterW->bind('', sub { $Xbut->invoke; }); $OKB->focus; $filterW->Popup; $userinfo = "image processing: preview ready!"; $userInfoL->update if (Exists($userInfoL)); $filterW->waitWindow; $userinfo = "image processing: cleaning up ..."; $userInfoL->update if (Exists($userInfoL)); $icon->delete if $icon; $photo->delete if $photo; $thumbicon->delete if $thumbicon; $previewP->delete if $previewP; $uw->destroy if (Exists($uw)); $lw->destroy if (Exists($lw)); $colw->destroy if (Exists($colw)); $decoW->destroy if (Exists($decoW)); removeFile($prevpic); removeFile($thumb); removeFile($thumbnew); $userinfo = "image processing ready!"; $userInfoL->update if (Exists($userInfoL)); } ############################################################## # applyFilter ############################################################## sub applyFilter { my $dpic = shift; my $filters = shift; my $preview = shift; # PREVIEW = preview mode, NO_PREVIEW = real conversion my $info = shift; # optional, user info text $info = "processing ".basename($dpic)." ..." if (!defined $info); $userinfo = $info; $userInfoL->update; # check if file is a link and get the real target return if (!getRealFile(\$dpic)); # call external command mogrify my $command = "mogrify "; foreach (keys %{$filters}) { if ($_ eq "grayscale") { $command .= "-colorspace GRAY -colors 256 " if $$filters{$_}; } else { $command .= "-$_ " if $$filters{$_}; } } $command .= "-sharpen ".$config{PicSharpen}." " if ($config{PicSharpen} > 0); $command .= "-gamma ".$config{PicGamma}." " if (($config{PicGamma} != 1.0) and ($config{ColorAdj})); $command .= "-modulate ".$config{PicBrightness}.",".$config{PicSaturation}.",".$config{PicHue}." " if ($config{ColorAdj}); $command .= makeDrawOptions($dpic) if ((!$preview) and ($config{FilterDeco})); # do not add a border or a text in the preview $command .= "-unsharp ".$config{UnsharpRadius}.'x'.$config{UnsharpSigma}."+".$config{UnsharpAmount}."+".$config{UnsharpThreshold}." " if $config{Unsharp}; $command .= "-level \"".$config{LevelBlack}."%/".$config{LevelWhite}."%/".$config{LevelGamma}."\" " if $config{Level}; $command .= "-quality ".$config{PicQuality}; execute($command." \"$dpic\" "); addDropShadow($dpic) if ($config{FilterDeco}); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } $userinfo = "image processing ready!"; $userInfoL->update; } ############################################################## # removeFile - delete a file ############################################################## sub removeFile { my $file = shift; return 1 if (!-f $file); if ( unlink($file) != 1) { # unlink returns the number of successfull removed files $top->messageBox(-icon => 'warning', -message => "Could not delete file \"$file\": $!", -title => 'Error', -type => 'OK'); return 0; } else { # remove file from search database, if it exists delete $searchDB{$file}; } return 1; } ############################################################## # resizePic ############################################################## sub resizePic { my ($dpic, $x, $y, $quality) = @_; unless (-f $dpic) { warn "no picture $dpic found!"; return 0; } my $command = "mogrify -size ${x}x${y} -geometry ${x}x${y} -quality $quality \"$dpic\" "; execute($command); return 1; } ############################################################## # crop - crop pictures in a lossless way ############################################################## sub crop { if (!checkExternProgs("crop", "jpegtran")) { $top->messageBox(-icon => 'warning', -message => "Could not find jpegtran, so there is no support for lossless JPEG cropping!\nYou will get jpegtran here: http://jpegclub.org\nNote: Download and install the jpegtran version with crop patch.\nNormal cropping is however possible.", -title => "No jpegtran available", -type => 'OK'); } else { # check if jpegtran supports lossless cropping my $usage = `jpegtran -? 2>&1`; if ($usage !~ m/.*-crop.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless cropping!\nTry to get the lossless crop patch from http://jpegclub.org.\nNormal cropping is however possible.", -title => "Wrong jpegtran version", -type => 'OK'); } } my $lb = shift; # the reference to the active listbox widget my @sellist = $lb->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($pic, $dpic, $w, $h, $wo, $ho, $x, $y); my $i = 0; my $doforall = 0; my $askDifSize = 1; my $first = $sellist[0]; my ($wm, $hm) = getSize($first); my $pw = progressWinInit($lb, "Crop pictures"); foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "cropping picture ($i/".scalar @sellist.") ...", $i, scalar @sellist); $pic = basename($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); next if (!checkWriteable($dpic)); ($wo, $ho) = getSize($dpic); if ($wo == 0 or $ho == 0) { $top->messageBox(-icon => 'warning', -message => "Sorry, picture $pic has no correct size (${wo}x$ho)!", -title => "Crop file", -type => 'OK'); next; } if ($doforall and $askDifSize and (($wo != $wm) or ($ho != $hm))) { my $rc = $top->messageBox(-icon => 'question', -message => "Picture $pic has not the same size as the preview picture.\nShould I continue and adjust the crop range if necessary?\nNote:\nThis will be done for all following pictures too!", -title => "Question", -type => 'OKCancel'); if ($rc !~ m/Ok/i) { $i--; last; } else { $askDifSize = 0; } } if (!$doforall) { ($w, $h) = calcAspectSize($wo, $ho); $x = 0; $y = 0; last if (!cropDialog($dpic, \$x, \$y, \$w, \$h, $wo, $ho, \$doforall, scalar @sellist)); print "cropDialog returned $pic x:$x y:$y w:$w h:$h" if $verbose; } # save crop frame offset before adjusting too small pics my $xsave = $x; my $ysave = $y; if (($x + $w) > $wo) { # crop frame outside the picture $x = $wo - $w; if ($x < 0) { $top->messageBox(-icon => 'warning', -message => "Skipping picture $pic!\nThe width ($wo) is too small for the crop frame ($w).", -title => "Picture too small", -type => 'OK'); # restore crop frame offset after adjusting to small pics $x = $xsave; $y = $ysave; next; } } if (($y + $h) > $ho) { # crop frame outside the picture $y = $ho - $h; if ($y < 0) { $top->messageBox(-icon => 'warning', -message => "Skipping picture $pic!\nThe height ($ho) is too small for the crop frame ($h).", -title => "Picture too small", -type => 'OK'); # restore crop frame offset after adjusting to small pics $x = $xsave; $y = $ysave; next; } } printf "cropping $pic %4dx%4d+%4d+%4d\n", $w, $h, $x, $y if $verbose; next if (!makeBackup($dpic)); # crop the picture $top->Busy; cropPic($dpic,$w,$h,$x,$y,95); $top->Unbusy; # check if crop has the right size # due to the 8 pixel blocks, sometimes the size is too big (a few pixels) my ($nw, $nh) = getSize($dpic); if (($nw > $w) or ($nh > $h)) { # but a recrop will help ... $top->Busy; cropPic($dpic,$w,$h,0,0,95); $top->Unbusy; print "recropping $pic w:$nw > $w h: $nh > $h n" if $verbose; } # restore crop frame offset after adjusting to small pics $x = $xsave; $y = $ysave; addCommentToPic("Picture lossless cropped by Mapivi ($mapiviURL)", $dpic, NO_TOUCH) if ($config{AddMapiviComment}); updateOneRow($dpic, $lb); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } # foreach end progressWinEnd($pw); reselect($lb, @sellist); $userinfo = "ready! ($i of ".scalar @sellist." cropped)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # calcAspectSize ############################################################## sub calcAspectSize { my $w = shift; # width my $h = shift; # height my $m = shift; # (optional) master ('w' if the width is the master or "h" for height) # calculate new size if ($config{CropAspect} != 0) { # if there is no aspect ratio there is nothing to do if (defined $m) { # master defined if ($m eq 'w') { # width is master if ($w >= $h) { # landscape image $h = sprintf "%.0f", ($w / $config{CropAspect}); # int() does not round! } else { # portait image $h = sprintf "%.0f", ($w * $config{CropAspect}); } } else { # height is master if ($w >= $h) { # landscape image $w = sprintf "%.0f", ($h * $config{CropAspect}); } else { # portait image $w = sprintf "%.0f", ($h / $config{CropAspect}); # round } } } else { # no master defined if ($w >= $h) { # landscape image if (($h != 0) and ($w/$h >= $config{CropAspect})) { # too wide $w = sprintf "%.0f", ($h * $config{CropAspect}); # round } else { # too high $h = sprintf "%.0f", ($w / $config{CropAspect}); # round } } else { # portait image if (($h != 0) and ($w/$h >= 1/$config{CropAspect})) { # too wide $w = sprintf "%.0f", ($h / $config{CropAspect}); # round } else { # too high $h = sprintf "%.0f", ($w * $config{CropAspect}); # round } } } } return ($w, $h); } ############################################################## # setNewAspect ############################################################## sub setNewAspect { my $c = shift; my $info_ref = shift; my $w = $c->{m_x2} - $c->{m_x1}; my $h = $c->{m_y2} - $c->{m_y1}; ($w, $h) = calcAspectSize($w, $h); $c->{m_x2} = $c->{m_x1} + $w; $c->{m_y2} = $c->{m_y1} + $h; $c->{m_aspect} = getAspectRatio($w, $h); drawFrame($c); } ############################################################## # bindForResize # based on code from Jason Tiller and Ala Qumsieh posted in the Perl/TK (ptk; comp.lang.perl.tk) list in 2003 ############################################################## sub bindForResize { my $canvas = shift; # Drag requests: # 0 = No drag requested in this direction. # 1 = Drag top (for y) or left (for x) edge of rectangle. # -1 = Drag bottom (for y) or right (for x) edge of rectangle. my ( $dx, $dy ) = ( 0, 0 ); # Drag mode: NO_ACTIVE_MODE, MOVE_MODE, or RESIZE_MODE. use constant M_NO_ACTIVE_MODE => 0; use constant M_MOVE_MODE => 1; use constant M_RESIZE_MODE => 2; my $mode = M_NO_ACTIVE_MODE; # How close to the edge we have to be to initiate a resize (instead # of a move) drag. Expressed in percentage of overall # height/width. my $resize_within = 0.05; # Within 5% of edge to resize. # Initial location of mouse pointer. my ($oldx, $oldy) = (0) x 2; # ID of rectangle that we're resizing. my $rect; # Bind left-mouse clicks (<1>) over any widget with a 'RECT' tag to # do... $canvas->CanvasBind('<1>' => sub { my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1); #my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); my ( $width, $height ) = ( $x1 - $x0, $y1 - $y0 ); # Determine if the user wants to size in the x direction. If # the user clicks within $resize_within of the edge, then he # wants to resize. $dx = 0; if( $x < ( $x0 + $resize_within * $width ) ) { $dx = 1; } elsif( $x > ( $x1 - $resize_within * $width ) ) { $dx = -1; } # Do the same for the y direction. $dy = 0; if( $y < ( $y0 + $resize_within * $width ) ) { $dy = 1; } elsif( $y > ( $y1 - $resize_within * $width ) ) { $dy = -1; } # If resizing in either direction, set resize mode. $mode = ( $dx || $dy ) ? M_RESIZE_MODE : M_MOVE_MODE; my $id = $canvas ->find( qw|withtag RECT| ); ( $oldx, $oldy, $rect ) = ( $x, $y, $id ); return; } ); # Bind motion with the left mouse button down () over a # widget with a 'RECT' tag to do... $canvas->CanvasBind('' => sub { my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); #print "B1 Motion: $x $y\n"; if( $mode == M_RESIZE_MODE ) { #print "M_RESIZE_MODE\n"; # Get coordinates of resizing rectangle. my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); # Resize logic. If we're moving the left border, then # change the coordinates of the left edge ($x0) to be the # current mouse position's x position ($x), else set the # rectangle's right edge. if ( $dx == 1 ) { $x0 = $x; } elsif ( $dx == -1 ) { $x1 = $x; } if ( $dy == 1 ) { $y0 = $y; } elsif ( $dy == -1 ) { $y1 = $y; } $x0 = 0 if ($x0 < 0); $x1 = $canvas->width if ($x1 > $canvas->width); $y0 = 0 if ($y0 < 0); $y1 = $canvas->height if ($y1 > $canvas->height); # Set the coordinates of the resizing rectangle. $canvas->coords( 'RECT', $x0, $y0, $x1, $y1 ); draw_grid($canvas, $x0, $y0, $x1, $y1); } else { #print "M_MOVE_MODE\n"; my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); return if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1); # Move the rectangle under mouse pointer relative to its # old position. $canvas->move( $canvas->find( 'withtag', 'RECT' ), $x - $oldx, $y - $oldy ); draw_grid($canvas, $canvas->coords( 'RECT' )); # Update "old" coordinates. ( $oldx, $oldy ) = ( $x, $y ); } } ); # Set to false when we've changed the cursor. Tells us we want to # reset the cursor when we leave a rectangle. my $cursor_is_normal = 1; # Maps cursor position to cursor shape. # 0 = middle of shape, 1 = left/top edge, 2 = right/bottom edge. # [$x][$y] my @cursors = ( # [ (0,0), (0,1), (0,2) ] [ 'fleur', 'top_side', 'bottom_side' ], # [ (1,0), (1,1), (1,2) ] [ 'left_side', 'top_left_corner', 'bottom_left_corner' ], # [ (2,0), (2,1), (2,2) ] [ 'right_side', 'top_right_corner', 'bottom_right_corner' ] ); my @old_cursors = ( 3, 3 ); # ( x, y ) $canvas->CanvasBind( '' => sub { my @coords = $canvas->coords( 'RECT' ); $mode = M_NO_ACTIVE_MODE; $canvas->configure( -cursor => 'left_ptr' ); @old_cursors = ( 3, 3 ); $cursor_is_normal = 1; drawFrame($canvas, @coords); $canvas->raise($rect); } ); # Update the mouse cursor based on where the pointer is on the # canvas. If it's not over a rectangle, set it to the default # ('left_ptr'). If it's over a rectangle, set to a target cursor # if the pointer is in the drag region (center) else to a resize # cursor. $canvas->CanvasBind( '' => sub { #print "CanvasBind Motion\n"; #my $id = $canvas->find( qw|withtag current| ); #my @tags = $canvas->gettags($id); #for (0 .. $#tags) { print "$_ $tags[$_]\n"; } # Bail if we're not over a rectangle. my ( $x, $y ) = ( $Tk::event->x, $Tk::event->y ); my ( $x0, $y0, $x1, $y1 ) = $canvas->coords( 'RECT' ); if ( !defined $x0 or !defined $y0 or !defined $x1 or !defined $y1 or $x < $x0 or $x > $x1 or $y < $y0 or $y > $y1) { unless( $cursor_is_normal ) { $canvas->configure( -cursor => 'left_ptr' ); @old_cursors = ( 3, 3 ); $cursor_is_normal = 1; } return; } # Don't update the cursor once we've started a drag or resize # operation. return unless $mode == M_NO_ACTIVE_MODE; my( $width, $height ) = ( $x1 - $x0, $y1 - $y0 ); # Now figure out where we are in the widget. my ( $px, $py ) = ( 0, 0 ); # Determine if the user wants to size in the x direction. If # the user clicks within $resize_within of the edge, then he # wants to resize. if( $x > ( $x1 - $resize_within * $width ) ) { $px = 2; } elsif( $x < ( $x0 + $resize_within * $width ) ) { $px = 1; } # Do the same for the y direction. if( $y > ( $y1 - $resize_within * $width ) ) { $py = 2; } if( $y < ( $y0 + $resize_within * $width ) ) { $py = 1; } # Don't update cursor unless it's changed. return if ( $px == $old_cursors[0] and $py == $old_cursors[1] ); $canvas->configure( -cursor => $cursors[$px][$py] ); @old_cursors = ( $px, $py ); $cursor_is_normal = 0; } ); } ############################################################## # cropDialog - let the user set the crop offset ############################################################## sub cropDialog { my ($dpic, $xr, $yr, $wr, $hr, $wo, $ho, $doforallr, $nr) = @_; # $xr, $yr, $wr $hr x,y-offset and width and height of crop frame (type: reference on scalar) # $wo, $ho width and height of original picture (type: scalar) # $doforallr bool (type: reference on scalar) # $nr number of pics to crop my $rc; my $pc; # the canvas widget my $x2 = $$xr + $$wr; my $y2 = $$yr + $$hr; $userinfo = "crop: creating preview picture ..."; $userInfoL->update; my $zpic = "$trashdir/".basename($dpic); warn "copy error" if (!mycopy($dpic, $zpic, OVERWRITE)); my $per = 0.75; # preview pic should be 75% of the min screen size my $cropPreviewSize = int($per * $top->screenwidth); $cropPreviewSize = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth); # just shrink big pictures, do not blow up small ones my $command = 'mogrify -geometry "'.$cropPreviewSize.'x'.$cropPreviewSize.'>" -quality 80 "'.$zpic.'"'; print "croppreview: $command\n" if $verbose; $top->Busy; (system $command) == 0 or warn "$command failed: $!"; $top->Unbusy; $userinfo = "ready!"; $userInfoL->update; if (!-f $zpic) { $top->messageBox(-icon => 'warning', -message => "Sorry, error zooming $dpic!", -title => "Crop file", -type => 'OK'); return 0; } # open window my $cropW = $top->Toplevel(); $cropW->title("Crop picture (lossless)"); $cropW->iconimage($mapiviicon) if $mapiviicon; my $cropFL = $cropW->Frame()->pack(-side => "left", -anchor => 'w'); my $cropFR = $cropW->Frame()->pack(-side => "left", -anchor => 'n'); my ($zpicx, $zpicy) = getSize($zpic); my $fc = $cropFL->Frame()->pack(); $pc = $fc->Canvas(-width => $zpicx, -height => $zpicy, -relief => 'sunken', -bd => $config{Borderwidth})->pack(-side => "left", -padx => 3); # store some values in the canvas hash $pc->{m_aspect} = "[x:y]"; $pc->{m_wo} = $wo; $pc->{m_ho} = $ho; my $fF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x'); $fF->Label(-text => "Help")->pack(-expand => 0, -fill => 'x'); my $rotext = $fF->ROText(-wrap => "word", -bg => $config{ColorBG}, -bd => "0", -width => 26, -height => 3)->pack(-expand => 0, -fill => 'x', -anchor => 'w'); $rotext->insert('end', "Use left mouse button to move and to adjuste the crop frame"); $fF->Checkbutton(-variable => \$config{CropGrid}, -anchor => 'w', -text => 'display 1/3 crop grid', -command => sub { drawFrame($pc); }, )->pack(-anchor => 'w'); my $iF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x'); $iF->Label(-text => "Info")->pack(-expand => 0, -fill => 'x'); $iF->Label(-text => "File: ".basename($dpic), -bg => $config{ColorBG})->pack(-anchor => 'w'); $iF->Label(-text => "old size: ${wo} x ${ho}", -bg => $config{ColorBG})->pack(-anchor => 'w'); my $lf = $iF->Frame()->pack(-anchor => 'w'); $lf->Label(-text => "new size:", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $lf->Label(-textvariable => \$pc->{m_w}, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $lf->Label(-text => 'x', -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $lf->Label(-textvariable => \$pc->{m_h}, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); my $caF = $iF->Frame()->pack(-anchor => 'w'); $caF->Label(-text => "crop area:", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $caF->Label(-textvariable => \$pc->{m_xyxy}, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); my $cropRect; my @cropRectCoords; #$pc->bind('' => sub { $pc->Tk::focus }); bindForResize($pc); my $zpicP = $cropFL->Photo(-file => "$zpic", -gamma => $config{Gamma}) if (-f $zpic); if (!$zpicP) { $top->messageBox(-icon => 'warning', -message => "Error displaying $zpic!", -title => "Crop file", -type => 'OK'); return 0; } # insert pic my $id = $pc->createImage(0, 0, -image => $zpicP, -anchor => "nw", -tags =>"PIC") if $zpicP; my ($px1, $py1, $px2, $py2) = $pc->bbox($id); print "cropDialog: x1 $px1 x2 $px2 y1 $py1 y2 $py2 $wo $ho\n" if $verbose; if (($px1 == $px2) or ($py1 == $py2)) { $top->messageBox(-icon => 'warning', -message => "Error displaying $zpic!", -title => "Crop file", -type => 'OK'); return 0; } # calculate the x and y zoom factor my $xz = $wo/($px2-$px1); my $yz = $ho/($py2-$py1); # store info in canvas widget $pc->{m_xzoom} = $xz; $pc->{m_yzoom} = $yz; $pc->{m_step} = 16; # resolution/step width for lossless crop must be 16 or 8, depends on picture encoding plusMinusEntry($iF, \$pc->{m_y1}, \$pc->{m_step}, 0, $ho, \&drawFrame, $pc, 'h'); my $iF1 = $iF->Frame()->pack(); my $iF11 = $iF1->Frame()->pack(-side => 'left'); my $iF12 = $iF1->Frame()->pack(-side => 'left'); plusMinusEntry($iF11, \$pc->{m_x1}, \$pc->{m_step}, 0, $wo, \&drawFrame, $pc, 'w'); plusMinusEntry($iF12, \$pc->{m_x2}, \$pc->{m_step}, 0, $wo, \&drawFrame, $pc, 'w'); plusMinusEntry($iF, \$pc->{m_y2}, \$pc->{m_step}, 0, $ho, \&drawFrame, $pc, 'h'); my $stepF = $iF->Frame()->pack(-anchor => 'w'); $stepF->Label(-text => "step width")->pack(-side => 'left', -anchor => 'w'); $stepF->Radiobutton(-variable => \$pc->{m_step}, -anchor => 'w', -text => "1", -value => 1, )->pack(-side => 'left', -anchor => 'w'); $stepF->Radiobutton(-variable => \$pc->{m_step}, -anchor => 'w', -text => "8", -value => 8, )->pack(-side => 'left', -anchor => 'w'); $stepF->Radiobutton(-variable => \$pc->{m_step}, -anchor => 'w', -text => "16", -value => 16, )->pack(-side => 'left', -anchor => 'w'); my $aF = $cropFR->Frame(-bd => $config{Borderwidth}, -relief => 'groove' )->pack(-anchor => 'w', -padx => 3, -pady => 3, -expand => 0, -fill => 'x'); $aF->Label(-text => "Aspect ratio")->pack(-expand => 0, -fill => 'x'); my $aspF = $aF->Frame()->pack(-anchor => 'w'); $aspF->Label(-text => "actual aspect ratio:", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); $aspF->Label(-textvariable => \$pc->{m_aspect}, -width => 8, -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); my $dummy; $aF->Optionmenu(-variable => \$config{CropAspect}, -options => [ ['X:Y (any aspect ratio)' => 0], ['3:2 (e.g. 10x15)' => 3/2], ['4:3' => 4/3], ['5:4 (PAL)' => 5/4], ['7:5 (e.g. 13x18)' => 7/5], ['16:9' => 16/9], ['1:1' => 1/1], ], -textvariable => \$dummy)->pack(-side => 'top', -anchor => 'w'); # my $portLandB = # $aF->Button(-text => "portrait/landscape", # -command => sub { # my $tmp = $$wr; # $$wr = $$hr; # $$hr = $tmp; # if ($$wr+$$xr > $wo) { # $$wr = $wo - $$xr; # ($$wr, $$hr) = calcAspectSize($$wr, $$hr); # } # if ($$hr+$$yr > $ho) { # $$hr = $ho - $$yr; # ($$wr, $$hr) = calcAspectSize($$wr, $$hr); # } # $x2 = $$xr + $$wr; # $y2 = $$yr + $$hr; # #$xyxy = sprintf "%d,%d - %d,%d", $$xr, $$yr, ($$xr + $$wr), ($$yr + $$hr); # #$aspect = getAspectRatio($$wr, $$hr); # drawFrame($pc, $$xr, $$yr, $$wr, $$hr, $xz, $yz); # })->pack(-fill => 'x', -padx => 3, -pady => 3); # $balloon->attach($portLandB, -msg => "Switch crop frame between portrait and landscape mode"); buttonBackup($cropFR, 'top'); buttonComment($cropFR, 'top'); if ($nr > 1) { $cropFR->Checkbutton(-variable => \$$doforallr, -anchor => 'w', -text => "use this setting for all pics" )->pack(-anchor => 'w'); } my $ButF = $cropFR->Frame()->pack(-fill =>'x', -expand => 1, -padx => 0, -pady => 2); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $$xr = $pc->{m_x1}; $$yr = $pc->{m_y1}; $$wr = $pc->{m_x2} - $pc->{m_x1}; $$hr = $pc->{m_y2} - $pc->{m_y1}; $cropW->withdraw(); $rc = 1; $cropW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $cropW->withdraw(); $cropW->destroy(); })->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 3); $cropW->bind('', sub { $Xbut->invoke; }); $cropW->bind('', sub { $Xbut->invoke; }); # first popup the window then draw the frame! $cropW->Popup; $cropW->update; my $distx = int($zpicx/10); my $disty = int($zpicy/10); drawFrame($pc, $distx, $disty, ($zpicx-$distx), ($zpicy-$disty)); $cropW->waitWindow; # clean up $zpicP->delete; removeFile($zpic); return $rc; } ############################################################## # plusMinusEntry ############################################################## sub plusMinusEntry { my ($widget, $value, $step, $min, $max, $callback, $cb_para1, $cb_para2) = @_; $$value = 0 unless (defined $$value); my $frame = $widget->Frame(-relief => 'sunken')->pack(); $frame->Label(-textvariable => $value, -bg => $config{ColorBG}, -width => 6)->pack(-side => 'left', -anchor => 'w'); my $r_frame = $frame->Frame()->pack(-side => 'left', -padx => 0, -pady => 0); $r_frame->Button(-bitmap => "plusbut", -padx => 0, -pady => 0, -command => sub { $$value += $$step; $$value = $min if ($$value < $min); $$value = $max if ($$value > $max); $callback->($cb_para1, $cb_para2); })->pack(-anchor => 'w', -padx => 0, -pady => 0); $r_frame->Button(-bitmap => "minusbut", -padx => 0, -pady => 0, -command => sub { $$value -= $$step; $$value = $min if ($$value < $min); $$value = $max if ($$value > $max); $callback->($cb_para1, $cb_para2); })->pack(-anchor => 'w', -padx => 0, -pady => 0); } ############################################################## # normalizeCoords - assign coordinates to allowed values (stepwidth) ############################################################## sub normalizeCoords { my $canvas = shift; foreach my $coord qw(m_x1 m_x2 m_y1 m_y2) { # assign it to the step width $canvas->{$coord} = sprintf "%.0f", ($canvas->{$coord}/$canvas->{m_step}); $canvas->{$coord} *= $canvas->{m_step}; # check lower bound $canvas->{$coord} = 0 if ($canvas->{$coord} < 0); } # check upper bound foreach my $coord qw(m_x1 m_x2) { $canvas->{$coord} = $canvas->{m_wo} if ($canvas->{$coord} > $canvas->{m_wo}); } foreach my $coord qw(m_y1 m_y2) { $canvas->{$coord} = $canvas->{m_ho} if ($canvas->{$coord} > $canvas->{m_ho}); } } ############################################################## # drawFrame ############################################################## sub drawFrame { my $canvas = shift; my @coords; my $direction = 'h'; if (@_ == 4) { # canvas coordinates are given @coords = @_; $canvas->{m_x1} = int($coords[0] * $canvas->{m_xzoom}); $canvas->{m_y1} = int($coords[1] * $canvas->{m_yzoom}); $canvas->{m_x2} = int($coords[2] * $canvas->{m_xzoom}); $canvas->{m_y2} = int($coords[3] * $canvas->{m_yzoom}); normalizeCoords($canvas); } elsif (@_ == 0) { # use the real coordinates normalizeCoords($canvas); $coords[0] = int($canvas->{m_x1} / $canvas->{m_xzoom}); $coords[1] = int($canvas->{m_y1} / $canvas->{m_yzoom}); $coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom}); $coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom}); } elsif (@_ == 1) { # optional direction h or w $direction = shift; normalizeCoords($canvas); } else { warn "drawFrame:: error wrong number of args ".scalar @_."\n"; return; } my $w = $canvas->{m_x2} - $canvas->{m_x1}; my $h = $canvas->{m_y2} - $canvas->{m_y1}; ($w, $h) = calcAspectSize($w, $h, $direction); #($w, $h) = calcAspectSize($w, $h); $canvas->{m_x2} = $canvas->{m_x1} + $w; $canvas->{m_y2} = $canvas->{m_y1} + $h; $canvas->{m_xyxy} = $canvas->{m_x1}.",".$canvas->{m_y1}." - ".$canvas->{m_x2}.",".$canvas->{m_y2}; $canvas->{m_w} = $w; $canvas->{m_h} = $h; $canvas->{m_aspect} = getAspectRatio($w, $h); $coords[0] = int($canvas->{m_x1} / $canvas->{m_xzoom}); $coords[1] = int($canvas->{m_y1} / $canvas->{m_yzoom}); $coords[2] = int($canvas->{m_x2} / $canvas->{m_xzoom}); $coords[3] = int($canvas->{m_y2} / $canvas->{m_yzoom}); $canvas->delete('withtag', 'RECT'); $canvas->createRectangle(@coords, -tags => ['RECT'], -outline => 'red'); # draw 1/3 grid - divide the crop frame in nine rectangles draw_grid($canvas, @coords); #my $rect = $canvas->find('withtag', 'RECT'); #$canvas->coords( $rect => @coords ); $canvas->raise('RECT'); # black dashed line # $canvas->createRectangle( @coords, # -tags => ['RECT'], # -outline => "black", # -dash => [6,4,2,4], # ); # white dashed line # $canvas->createRectangle( @coords, # -tags => ['RECT'], # -outline => "white", # -dash => [2,6,2,4], # ); } ############################################################## ############################################################## sub draw_grid { my $canvas = shift; my @coords = @_; # draw 1/3 grid - divide the crop frame in nine rectangles $canvas->delete('withtag', 'GRID'); if ($config{CropGrid}) { my $grid_dist_h = round(($coords[3] - $coords[1])/3); my $grid_dist_w = round(($coords[2] - $coords[0])/3); $canvas->createLine($coords[0],$coords[1] + $grid_dist_h, $coords[2],$coords[1] + $grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -width => 1, -fill => '#ccc'); $canvas->createLine($coords[0],$coords[1] + 2*$grid_dist_h,$coords[2],$coords[1] + 2*$grid_dist_h, -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); $canvas->createLine($coords[0] + $grid_dist_w, $coords[1],$coords[0] + $grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); $canvas->createLine($coords[0] + 2*$grid_dist_w,$coords[1],$coords[0] + 2*$grid_dist_w,$coords[3], -dash => [6,4,2,4],-tags => ['GRID'], -fill => '#ccc'); } $canvas->delete('withtag', 'FRAME'); # draw a pseudo transparent box around the crop frame $canvas->createRectangle( 1, 1, $coords[0], $canvas->height-1, -tags => ['FRAME'], -outline => undef, -fill => 'black', -stipple => 'transp', ); $canvas->createRectangle( $coords[0], 1, $canvas->width-1, $coords[1], -tags => ['FRAME'], -outline => undef, -fill => 'black', -stipple => 'transp', ); $canvas->createRectangle( $coords[2], $coords[1], $canvas->width-1, $canvas->height-1, -tags => ['FRAME'], -outline => undef, -fill => 'black', -stipple => 'transp', ); $canvas->createRectangle( $coords[0], $coords[3], $coords[2], $canvas->height-1, -tags => ['FRAME'], -outline => undef, -fill => 'black', -stipple => 'transp', ); } ############################################################## # cropPic - cut a rect out of the pic # needs a geometry (e.g. 200x200+33+66) # overwrites the given file!!! # returns true if it worked ############################################################## sub cropPic { my $dpic = shift; return 0 if (!-f $dpic); # pic will be overwritten!!! my $w = shift; # width my $h = shift; # height my $x = shift; # x offset my $y = shift; # y offset my $qua = shift; # quality my ($pw, $ph) = getSize($dpic); #return 1 if (($pw <= $w) and ($ph <= $h)); # if the requested size is bigger than the pic we adapt to the real pic size $w = $pw if ($w > $pw); $h = $ph if ($h > $ph); my $geo = "${w}x${h}+${x}+${y}"; my $command = ""; # try to use lossless cropping for JPEGs if available if (is_a_JPEG($dpic) and checkExternProgs("crop", "jpegtran")) { # check if jpegtran supports lossless cropping my $usage = `jpegtran -? 2>&1`; if ($usage =~ m/.*-crop.*/) { $command = "jpegtran -copy all -crop $geo -outfile \"$dpic\" \"$dpic\""; print "$dpic: cropping lossless using jpegtran\n" if $verbose; } } # the fallback solution if ($command eq "") { $command = "mogrify -crop $geo -quality $qua \"$dpic\""; print "$dpic: cropping lossy using mogrify (reason: not a JPEG or wrong jpegtran version\n"; # if $verbose; } if ((system $command) != 0) { warn "$command failed: $!"; return 0; } else { return 1; } } ############################################################## # mycopy ############################################################## sub mycopy { my $from = shift; my $to = shift; my $overwrite = shift; # OVERWRITE = overwrite without asking ASK_OVERWRITE = ask before overwrite if (!-f $from) { $top->messageBox(-icon => 'warning', -message => "file $from not found!", -title => "Copy file", -type => 'OK'); return 0; } return 1 if ($from eq $to); # no need to copy a file on itself # if target exists and ask overwrite modus on if ((-f $to) and ($overwrite == ASK_OVERWRITE)) { my $rc = $top->messageBox(-icon => 'warning', -message => "file $to exist. Ok to overwrite?", -title => 'Copy file', -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } if (!copy ($from, $to)) { $top->messageBox(-icon => 'warning', -message => "Could not copy $from to $to: $!", -title => 'Copy file', -type => 'OK'); return 0; } return 1; } ############################################################## # mylink ############################################################## sub mylink { my $old = shift; my $new = shift; my $overwrite = shift; # 1 = overwrite without asking 0 = ask before overwrite return 0 if $EvilOS; # sorry, no links on non-UNIX system, use Linux instead ;) if (!-f $old) { $top->messageBox(-icon => 'warning', -message => "file $old not found!", -title => "Link file", -type => 'OK'); return 0; } if ((-f $new) and !$overwrite) { my $rc = $top->messageBox(-icon => 'warning', -message => "file $new exist. Ok to overwrite?", -title => "Link file", -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } if (!symlink ("$old", "$new")) { $top->messageBox(-icon => 'warning', -message => "Could not link $old to $new: $!", -title => "Link file", -type => 'OK'); return 0; } return 1; } ############################################################## # checkLinks - check if there are links, count them and ask # whether to proceed ############################################################## sub checkLinks { my $lb = shift; # listbox ref my @list = @_; my $selected = @list; return 1 unless ($config{CheckForLinks}); if (@list < 1) { warn "checkLinks: uops, list is empty. Aborting!"; return 0; } my $dpic; my $links = 0; foreach $dpic (@list) { if (-l $dpic) { $links++; } } if ($links > 0) { my $rc = $top->messageBox(-message => "$links of $selected selected pictures are links.\nDo you really want to change them?", -icon => 'question', -title => "Work on linked files?", -type => 'OKCancel'); if ($rc eq "Ok") { return 1; } else { return 0; } } return 1; # no links, Ok to continue ... } ############################################################## # getBitPix - calculate picture compression in bit per pixel ############################################################## sub getBitPix { my $dpic = shift; return $quickSortHashBitsPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashBitsPixel{$dpic}); my $b = getFileSize($dpic, NO_FORMAT); # in Bytes $b *= 8; # Bytes * 8 = bits my $p = getPixels($dpic); # avoid division by zero if ($p == 0) { $p = 1; $b = 0; } $quickSortHashBitsPixel{$dpic} = ($b/$p) if $quickSortSwitch; return ($b/$p); } ############################################################## # getPixels - get the number of pixels of a picture ############################################################## sub getPixels { my $dpic = shift; return $quickSortHashPixel{$dpic} if ($quickSortSwitch and defined $quickSortHashPixel{$dpic}); my $x = 0; my $y = 0; $x = $searchDB{$dpic}{PIXX} if $searchDB{$dpic}{PIXX}; $y = $searchDB{$dpic}{PIXY} if $searchDB{$dpic}{PIXY}; $quickSortHashPixel{$dpic} = int($x*$y) if $quickSortSwitch; return int($x*$y); } ############################################################## # getSize - get the image size of a picture ############################################################## sub getSize { my $dpic = shift; my $meta = shift; # optional, the Image::MetaData::JPEG object of $dpic if available if ((!defined $dpic) or ($dpic eq "")) { warn "getSize: Sorry, but there is no file!"; return (0, 0); } if (!-f $dpic) { warn "Sorry, but \"$dpic\" is no file!"; return (0, 0); } my $w = 0; my $h = 0; if (is_a_JPEG($dpic)) { $meta = getMetaData($dpic, "SOF", 'FASTREADONLY') unless (defined($meta)); ($w, $h) = $meta->get_dimensions() if $meta; } else { my $info = image_info($dpic); if (my $error = $info->{error}) { warn "getSize: Can't parse image info: $error\n"; } ($w, $h) = dim($info); } $w = 0 unless (defined $w); $h = 0 unless (defined $h); return ($w, $h); } ############################################################## # is_a_JPEG - returns true (1) if the given file is a JPEG/JFIF ############################################################## sub is_a_JPEG($) { my $dpic = shift; return 0 unless ($dpic); return 0 unless (-f $dpic); my @c; # open file and read the first 3 bytes return 0 unless (open FILE,"<$dpic"); for my $i (0 .. 2) { read(FILE, $c[$i], 1); } close FILE; # JPEG JFIF files start with 0xFF 0xD8 0xFF # todo: this check is necessary but not sufficent if ( (ord($c[0]) == 0xFF) && (ord($c[1]) == 0xD8) && (ord($c[2]) == 0xFF) ) { return 1; } else { return 0; } } ############################################################## # makeConfigDir ############################################################## sub makeConfigDir { if (!-d $configdir) { # ask the user for permission to create a configdir my $rc = $top->messageBox(-icon => 'question', -message => "MaPiVi would like to create a folder \"$configdir\" in your home folder to store the configuration of Mapivi and some button and background pictures.", -title => "Mapivi installation", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } # make config dir if (!-d $maprogsdir) { if ( !mkdir $maprogsdir, 0700 ) { # 0700 = only for the user $top->messageBox(-icon => 'warning', -message => "Error making $maprogsdir: $!", -title => "Mapivi installation", -type => 'OK'); return; } } if (!-d $configdir) { if ( !mkdir $configdir, 0700 ) { $top->messageBox(-icon => 'warning', -message => "Error making configdir $configdir: $!", -title => "Mapivi installation", -type => 'OK'); return; } } if (!-d $trashdir) { if ( !mkdir $trashdir, 0755 ) { $top->messageBox(-icon => 'warning', -message => "Error making trashdir $trashdir: $!", -title => "Mapivi installation", -type => 'OK'); return; } } if (!-d "$trashdir/$thumbdirname") { if ( !mkdir "$trashdir/$thumbdirname", 0755 ) { $top->messageBox(-icon => 'warning', -message => "Error making trashthumbdir $trashdir/$thumbdirname: $!", -title => "Mapivi installation", -type => 'OK'); return; } } if (!-d $plugindir) { if ( !mkdir "$plugindir", 0755 ) { $top->messageBox(-icon => 'warning', -message => "Error making PlugIn dir $plugindir: $!", -title => "Mapivi installation", -type => 'OK'); return; } } } ############################################################## # copyConfigPics ############################################################## sub copyConfigPics { print "sub copyConfigPics ...\n" if $verbose; return if (!-d $configdir); # try to find the pictures in the actual dir and in the dir where mapivi is located my $searchdir; my @pics; my @searchDirList = ("$actdir/pics", dirname($0)."/pics"); foreach $searchdir (@searchDirList) { print "searching $searchdir ...\n" if $verbose; next if (!-d $searchdir); @pics = getFiles($searchdir); # mapivi should be startet as mapivi or mapivi . # so $actdir points to the dir where mapivi is stored last if (@pics > 0); } if (@pics <= 0) { print "Mapivi Warning:\nCould not find any pictures!\nPlease stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n"; #todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i); return; } # copy the pictures to the config dir foreach (@pics) { if (-f "$configdir/$_") { my $rc = $top->Dialog(-text => "I found a button/icon picture \"$_\" in the mapivi config folder (seem like there was another mapivi version installed before). Ok to overwrite?", -title => "Mapivi installation", -width => 40, -buttons => ['OK', 'Cancel', "Cancel all"])->Show(); next if ($rc eq 'Cancel'); last if ($rc eq "Cancel all"); } mycopy ("$searchdir/$_", "$configdir/$_", OVERWRITE); } } ############################################################## # copyOtherStuff - this will copy some mapivi files to # the config dir (all optional) ############################################################## sub copyOtherStuff { return if (!-d $configdir); my @files = qw/Changes.txt License.txt Tips.txt FAQ/; my $dir = dirname($0); # copy the files to the config dir foreach (@files) { if (-f "$dir/$_") { mycopy ("$dir/$_", "$configdir/$_", OVERWRITE); } } } ############################################################## # copyPlugIns ############################################################## sub copyPlugIns { return if (!-d $plugindir); # try to find the PlugIns in the actual dir and in the dir where mapivi is located my $searchdir = dirname($0)."/PlugIns"; my @plugs; my @searchDirList = ("$actdir/PlugIns", dirname($0)."/PlugIns"); foreach $searchdir (@searchDirList) { print "searching $searchdir ...\n" if $verbose; next if (!-d $searchdir); @plugs = getFiles($searchdir); # mapivi should be startet as mapivi or mapivi . # so $actdir points to the dir where mapivi is stored last if (@plugs > 0); } if (@plugs <= 0) { print "Mapivi Warning:\nCould not find any PlugIns! Please stop Mapivi, change to the folder where Mapivi is installed and restart Mapivi\n"; # todo $config{NrOfRuns}-- if ($rc =~ m/Ok/i); return; } # copy the PlugIns to the plugin dir foreach (@plugs) { if (-f "$plugindir/$_") { my $rc = $top->messageBox(-icon => 'question', -message => "I found a PlugIn\n $_\nin the mapivi PlugIn folder (seem like there was another mapivi version installed before).\n\nOk to overwrite?", -title => "Mapivi installation", -type => 'OKCancel'); next if ($rc !~ m/Ok/i); } if (!copy ("$searchdir/$_", "$plugindir/$_")) { $top->messageBox(-icon => 'warning', -message => "Could not copy $_ to $plugindir: $!", -title => "Mapivi installation", -type => 'OK'); } } } ############################################################## # checkGeometry ############################################################## sub checkGeometry($) { my $geoRef = shift; my ($w, $h, $x, $y) = splitGeometry($$geoRef); my $screenx = $top->screenwidth; my $screeny = $top->screenheight; my $tw = $top->reqwidth; my $th = $top->reqheight; print "checkGeometry: geo = $w ($tw) x $h ($th) + $x + $y ($screenx x $screeny)\n" if $verbose; if ((($w + $x) > $screenx) or (($h + $y) > $screeny)) { warn "MaPiVi: window is out of screen, resizing!\n"; $screenx -= 20; $screeny -= 80; $$geoRef = "${screenx}x${screeny}+0+0"; } else { warn "geo ok" if $verbose; } } ############################################################## # splitGeometry - returns width, height, x, y of the geomtry ############################################################## sub splitGeometry { my $geo = shift; my @tmp = split /x/, $geo; my $w = $tmp[0]; @tmp = split /\+/, $tmp[1]; return ($w, $tmp[0], $tmp[1], $tmp[2]); } ############################################################## # checkAdjusterGeometry ############################################################## sub checkAdjusterGeometry { my $geoRef = shift; my $adj1Ref = shift; my $adj2Ref = shift; my $letterWidth = $top->fontMeasure($nrofL->cget(-font), "0"); if ($letterWidth < 8) {warn "letterWidth $letterWidth < 8!!!\n"; $letterWidth = 8; } my $x1 = $$adj1Ref * $letterWidth; my $x2 = $$adj2Ref * $letterWidth; my $wx; ($wx, undef, undef, undef) = splitGeometry($$geoRef); print "$x1 + $x2 letter: $letterWidth windowW: $wx?\n" if $verbose; if (($x1 + $x2 + 120) > $wx) { # add x for scrollbars and safety warn "Adjuster need to much place, changing back to minimum!"; $$adj1Ref = 10; $$adj2Ref = 10; } else { warn "Adjuster ok" if $verbose; } } ############################################################## # checkSystem ############################################################## sub checkSystem { # UNIX and Windows have different PATH separators und suffixes my $sep = ":"; $sep = ";" if $EvilOS; my $suffix = ""; $suffix = ".exe" if $EvilOS; # check if the external programs listet in the global hash %exprogs are available my @path = split /$sep/, $ENV{PATH}; my ($dir, $prog); foreach $dir (@path) { foreach $prog (keys %exprogs) { next if ($exprogs{$prog} > 0); # already found it somewhere else if (-x "$dir/$prog$suffix") { $exprogs{$prog}++; #print " $prog in $dir found!\n"; } } } } ############################################################## # checkExternProgs - checks if the external programs needed # for a certain function exist ############################################################## sub checkExternProgs { my $sub = shift; # name of the calling sub my @neededProgs = @_; # list of needed external programs my @missingProgs = missingProgs($sub, @neededProgs); if (@missingProgs > 0) { my $msg = ""; $msg .= explainMissingProg($sub, $_) foreach (@missingProgs); $top->messageBox(-icon => 'warning', -message => $msg, -title => "Extern program(s) not available", -type => 'OK'); return 0; # if just one prog is missing we better abort } return 1; # everything seems to be there } ############################################################## # missingProgs - given a list of required external programs, # return a list of those that are missing ############################################################## sub missingProgs { my $sub = shift; # name of the calling sub my @neededProgs = @_; # list of needed external programs my @missingProgs; if (@neededProgs <= 0) { warn "missingProgs called from sub $sub with no progs to check!"; } else { foreach (@neededProgs) { if (!defined $exprogs{$_}) { warn "missingProgs called from sub $sub with program $_, which is not in the exprogs hash!"; push @missingProgs, $_; } elsif ($exprogs{$_} < 1) { push @missingProgs, $_; } } } return @missingProgs } ############################################################## # explainMissingProg - returns info about a missing program ############################################################## sub explainMissingProg { my $sub = shift; my $missingProg = shift; my $com = ""; my $res = ""; if (defined $exprogscom{$missingProg}) { $com = "$missingProg is needed to ".$exprogscom{$missingProg}."\n"; } if (defined $exprogsres{$missingProg}) { $res = "$missingProg resource: ".$exprogsres{$missingProg}."\n"; } return "Sorry, but to run $sub you need the external program $missingProg. I could not find $missingProg in your PATH.\n${com}${res}Aborting."; } ############################################################## # hlistEntryRename - rename the entrypath of an hlist entry ############################################################## sub hlistEntryRename($$$) { my ($hlist, $old, $new ) = @_; return 0 unless ($hlist->info('exists', $old)); return 0 if ($hlist->info('exists', $new)); hlistCopy($hlist, $old, $new); $hlist->delete('entry', $old) if ($hlist->info('exists', $new)); return 1; } ############################################################## # hlistCopy - copy an item of a hlist to another position ############################################################## sub hlistCopy { my($hl, $from_entry, $to_entry) = @_; if ($hl->info('exists', $to_entry)) { return; } my @entry_args; foreach ($hl->entryconfigure($from_entry)) { push @entry_args, $_->[0] => $_->[4] if defined $_->[4]; } my $next = $hl->info('next', $from_entry); if ($next) {$hl->add($to_entry, @entry_args, -before => $next);} else {$hl->add($to_entry, @entry_args);} foreach my $col (1 .. $hl->cget(-columns)-1) { my @item_args; foreach ($hl->itemConfigure($from_entry, $col)) { push @item_args, $_->[0] => $_->[4] if defined $_->[4]; } $hl->itemCreate($to_entry, $col, @item_args); } } ############################################################## # startStopClock - starts and stops the clock, display # and remove the clock label ############################################################## sub startStopClock { if ($config{ShowClock}) { $clocktimer = $top->repeat(5000, \&showTime) if !$clocktimer; # 5000ms = 5 seconds $clockL->pack(-side => "left"); showTime(); } else { $clocktimer->cancel if $clocktimer; $time = ""; $clockL->packForget() if (Exists($clockL)); } } ############################################################## # getDateTime - returns the actual local time as a string ############################################################## sub getDateTime { my (undef,$m,$h,$d,$M,$y,undef,undef,undef,undef) = localtime(time()); $y += 1900; $M++; my $datetime = sprintf "%04d%02d%02d-%02d%02d", $y, $M, $d, $h, $m; return $datetime; } ############################################################## # showTime - calculate actual time and display it ############################################################## sub showTime { return unless (Exists($clockL)); my (undef,$m,$h,$d,$M,$y,$wd,undef, undef,undef) = localtime(time()); my @workday = qw/Sun Mon Tue Wed Thu Fri Sat/; $y += 1900; $M++; $time = sprintf "%02d:%02d", $h, $m; $date = sprintf "%3s, %02d.%02d.%04d", $workday[$wd], $d, $M, $y; $clockL->update; } my $htmlW; # global make-html window widget my $htmlInfo; ############################################################## # makeHTML - build HTML web pages from the selected pictures ############################################################## sub makeHTML { if (Exists($htmlW)) { $htmlW->deiconify; $htmlW->raise; return; } my $lb = shift; my @sellist = $lb->info('selection'); return unless checkSelection($lb, 1, 0, \@sellist); my $selected = @sellist; my ($pic); # open make html window $htmlW = $lb->Toplevel(); $htmlW->title("Build web pages"); $htmlW->iconimage($mapiviicon) if $mapiviicon; $htmlInfo = "Build HTML web pages of $selected selected pictures"; $htmlW->Label(-textvariable =>\$htmlInfo,-bg => $config{ColorBG} )->pack(-side => 'top',-fill => 'x',-padx => 3,-pady => 3); my $w = 30; my $l1 = labeledEntry($htmlW, 'top', $w, "Title of Gallery", \$config{HTMLGalleryTitle}); my $l2 = labeledEntry($htmlW, 'top', $w, "Link to gallery index page", \$config{HTMLGalleryIndex}); my $l3 = labeledEntry($htmlW, 'top', $w, "Link to homepage", \$config{HTMLHomepage}); my $l4 = labeledEntry($htmlW, 'top', $w, "HTML footer", \$config{HTMLFooter}); my $l5 = labeledEntryButton($htmlW,'top',$w,"HTML target folder",'Set',\$config{HTMLTargetDir},1); my $l6 = labeledEntryButton($htmlW,'top',$w,"HTML template file",'Set', \$config{HTMLTemplate}); $balloon->attach($l1, -msg => "The content of this entry will be\ninserted in the field."); $balloon->attach($l2, -msg => "The content of this entry will be\ninserted in the field."); $balloon->attach($l3, -msg => "The content of this entry will be\ninserted in the field."); $balloon->attach($l4, -msg => "The content of this entry will be\ninserted in the field.\nIt may contain a link to your homepage\nand your email address."); $balloon->attach($l5, -msg => "Mapivi will save the generated\npages and pictures in this folder."); $balloon->attach($l6, -msg => "This is the used HTML template.\nThere are some example templates\nin the Mapivi package."); #labeledEntry($htmlW, 'top', $w, "Background of picture", \$config{HTMLBGcolor}); my $picF; $htmlW->Checkbutton(-variable => \$config{HTMLnoPicChange}, -anchor => 'w', -text => "Leave pictures untouched (just copy them)", -command => sub { my $state = 'normal'; $state = "disabled" if ($config{HTMLnoPicChange}); setChildState($picF, $state); })->pack(-anchor => 'w'); $picF = $htmlW->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $picF->Label(-text =>"HTML pictures",-bg => $config{ColorBG}, -anchor => 'w' )->pack(-side => 'top',-fill => 'x',-padx => 3,-pady => 3); #my $picF2 = $picF->Frame ()->pack(-expand => 1, -fill => 'x', -padx => 0, -pady => 0); my $sS = labeledScale($picF, 'top', $w, "Size (pixel)", \$config{HTMLPicSize}, 100, 2000, 1); $balloon->attach($sS, -msg => "This is the length of the longest side.\nWith a value of 500 a 1000x800 picture will be resized to 500x400."); my $qS = labeledScale($picF, 'top', $w, "Quality (%)", \$config{HTMLPicQuality}, 10, 100, 1); qualityBalloon($qS); my $shS = labeledScale($picF, 'top', $w, "Sharpness (radius)", \$config{HTMLPicSharpen}, 0, 10, 0.1); $balloon->attach($shS, -msg => "The higher the value, the slower the conversion\n0 means no sharping.\n(suggestion: between 0 and 4)"); my $cof = $picF->Frame()->pack(-anchor => 'w'); $cof->Checkbutton(-variable => \$config{HTMLPicCopyright}, -anchor => 'w', -text => "Add some decorations (border, copyright)")->pack(-side => "left", -anchor => 'w'); $cof->Button(-text => "Options", -anchor => 'w', -command => sub {decorationDialog($selected,0);})->pack(-side => "left", -anchor => 'w'); $picF->Checkbutton(-variable => \$config{HTMLPicEXIF}, -anchor => 'w', -text => "Leave EXIF info in HTML pictures")->pack(-anchor => 'w'); labeledScale($htmlW, 'top', $w, "Number of thumbnail columns", \$config{HTMLcols}, 1, 10, 1); $htmlW->Checkbutton(-variable => \$config{HTMLaddComment}, -anchor => 'w', -text => "Show JPEG comments")->pack(-anchor => 'w'); $htmlW->Checkbutton(-variable => \$config{HTMLaddEXIF}, -anchor => 'w', -text => "Show EXIF infos")->pack(-anchor => 'w'); $htmlW->Checkbutton(-variable => \$config{HTMLaddIPTC}, -anchor => 'w', -text => "Show IPTC infos")->pack(-anchor => 'w'); my $ButF = $htmlW->Frame()->pack(-fill =>'x',-padx => 3,-pady => 3); my $OKB = $ButF->Button(-text => "Make HTML", -command => sub { return if ( !checkHTMLSettings() ); return if ( !makeHTMLSubdirs($config{HTMLTargetDir}) ); $lb->update; #my @pics ; #foreach (@sellist){ #push @pics, basename($_); #} # because the building of web galleries should also work # within the search dialog we can't throw away the path here cleanHTMLDirs($config{HTMLTargetDir}, @sellist); return if ( !makeHTMLPics (\%config, @sellist) ); $lb->update; return if ( !copyHTMLThumbs($config{HTMLTargetDir}, @sellist) ); my $table = makeHTMLIndex (\%config, @sellist); makeHTMLPages ($table, \%config, @sellist); $htmlInfo = "make web pages - Ready!"; $htmlW->update; $htmlW->messageBox(-icon => 'info', -message => "Finished building web pages and pictures!", -title => "make HTML", -type => 'OK'); # bring the make html dialog window in front $htmlW->deiconify; $htmlW->raise; } )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $ButF->Button(-text => "Close", -command => sub { $htmlW->withdraw(); $htmlW->destroy(); } )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $htmlW->bind('', sub { $htmlW->destroy; } ); my $state = 'normal'; $state = "disabled" if ($config{HTMLnoPicChange}); setChildState($picF, $state); $OKB->focus; $htmlW->Popup; $htmlW->waitWindow; } ############################################################## # checkHTMLSettings ############################################################## sub checkHTMLSettings { my $targetDir = $config{HTMLTargetDir}; print "checkHTMLSettings: $targetDir\n" if $verbose; if (!-d $targetDir) { my $rc = $htmlW->messageBox(-icon => 'question', -message => "$targetDir does not exists!\nShould I create it?!", -title => "check HTML settings", -type => 'OKCancel'); if ($rc !~ m/Ok/i) { return 0; } if ( !mkdir "$targetDir", 0755 ) { $htmlW->messageBox(-icon => 'warning', -message => "can not create $targetDir: $!", -title => 'Error', -type => 'OK'); return 0; } } return 1; } ############################################################## # copyHTMLThumbs ############################################################## sub copyHTMLThumbs { my $targetDir = shift; my @pics = @_; my ($sthumb, $tthumb); # copy the pictures to the config dir foreach my $dpic (@pics) { my $pic = basename($dpic); $sthumb = getThumbFileName($dpic); $tthumb = "$targetDir/$HTMLThumbDir/$pic"; if (!-f $sthumb) { $htmlW->messageBox(-icon => 'warning', -message => "$sthumb not found! Stopping!", -title => "copy thumbs", -type => 'OK'); return 0; } if (!aNewerThanb($sthumb,$tthumb)) { print "skip thumb $pic (it is up to date)\n" if $verbose; next; } else { print "copy thumb $pic\n" if $verbose; } $htmlInfo = "copy thumb $pic for HTML page ..."; $htmlW->update; mycopy("$sthumb", "$tthumb", OVERWRITE); } return 1; } ############################################################## # makeHTMLSubdirs ############################################################## sub makeHTMLSubdirs { my $tdir = shift; # make pic and thumb dir foreach my $dir ($HTMLPicDir, $HTMLThumbDir) { my $sdir = "$tdir/$dir"; if (!-d $sdir) { if ( !mkdir "$sdir", 0755 ) { $htmlW->messageBox(-icon => 'warning', -message => "makeThumbSubdirs: can not create $sdir: $!", -title => 'Error', -type => 'OK'); return 0; } } } return 1; } ############################################################## # makeHTMLPics ############################################################## sub makeHTMLPics { my $tmpconfR = shift; my @pics = @_; my ($pic, $dpic, $tpic, $command); my $targetDir = $tmpconfR->{'HTMLTargetDir'}; my $i = 0; my $nrpics = @pics; foreach $dpic (@pics) { $i++; $pic = basename($dpic); $tpic = "$targetDir/$HTMLPicDir/$pic"; if (!-f $dpic) { warn "makeHTMLPics: $dpic does not exist!"; return 0; } if (!aNewerThanb($dpic,$tpic)) { warn "makeHTMLPics: $tpic is up to date - skipping\n" if $verbose; next; } else { warn "makeHTMLPics: converting $pic\n" if $verbose; } # just copy the pics ... if ($tmpconfR->{'HTMLnoPicChange'}) { $htmlInfo = "copy $pic ($i/$nrpics) for HTML page ..."; $htmlW->update; mycopy("$dpic", "$tpic", OVERWRITE); } # ... or convert them else { # adding -size XxY speeds up the convertion! (Dan Eble) $command = " convert -size \"$tmpconfR->{'HTMLPicSize'}x$tmpconfR->{'HTMLPicSize'}\" -geometry \"$tmpconfR->{'HTMLPicSize'}x$tmpconfR->{'HTMLPicSize'}>\" -quality $tmpconfR->{'HTMLPicQuality'} "; if ($tmpconfR->{HTMLPicSharpen} > 0) { # ! Sharpen is the most time consuming option, when building thumbnails! $command .= "-sharpen $tmpconfR->{'HTMLPicSharpen'} " # the higher the value the slower the conversion } if ($tmpconfR->{HTMLPicCopyright} > 0) { $command .= makeDrawOptions($dpic); } $command .= " \"$dpic\" \"$tpic\" "; $htmlInfo = "converting $pic ($i/$nrpics) for HTML page ..."; $htmlW->update; #(system "$command") == 0 or warn "$command failed: $!"; execute($command); addDropShadow($tpic); if ($tmpconfR->{HTMLPicEXIF}) { # copy the EXIF header from the original pic to the html pic copyEXIF( $dpic, $tpic ); } else { # remove the EXIF header and thumb from the HTML pic my $errors = ""; removeEXIF($tpic, 'all', \$errors); } } } return 1; } ############################################################## # makeHTMLIndex ############################################################## sub makeHTMLIndex { my $tmpconfR = shift; my @pics = @_; my $targetDir = $tmpconfR->{'HTMLTargetDir'}; my ($pic, $dpic, $opic, $picNoSuffix, $lthumb, $htmlfile, $title, $size, $table, $tx, $ty); $table = "\n"; my $i = 0; $htmlInfo = "building HTML thumbnail index ..."; $htmlW->update; foreach $opic (@pics) { $i++; $pic = basename($opic); if ( $i % $tmpconfR->{HTMLcols} == 1 or $tmpconfR->{HTMLcols} == 1 ) { # start new table row (modulo) $table .= "\n"; } #$lpic = "$HTMLPicDir/$pic"; $dpic = "$targetDir/$HTMLPicDir/$pic"; $lthumb = "$HTMLThumbDir/$pic"; $size = getFileSize($dpic, FORMAT); ($tx, $ty)= getSize("$targetDir/$lthumb"); $picNoSuffix = $pic; # cut off trailing ".jpg" $picNoSuffix =~ s/\..*$//i; # this is the name of the picture without .jpg suffix $title = getIPTCObjectName($opic); $title = "$picNoSuffix" if ($title eq ""); $title .= " ($size)"; # replace (german) umlaute by corresponding HTML-tags $title =~ s/([$umlauteHTML])/$umlauteHTML{$1}/g; $htmlfile = ($i == 1) ? "index.html" : "$picNoSuffix.html"; $table .= "\n"; if ( $i % $tmpconfR->{HTMLcols} == 0 ) { # end table row (modulo) $table .= "\n"; } } $table .= "
\n"; $table .= "\n"; $table .= " \"$pic\"\n"; $table .= "\n"; $table .= "
\n"; return $table; } ############################################################## # createReplacementHashForPic ############################################################## sub createReplacementHashForPic { my $tmpconfR = shift; my $opic = shift; my $pic = basename($opic); my $targetDir = $tmpconfR->{'HTMLTargetDir'}; my $dpic = "$targetDir/$HTMLPicDir/$pic"; my $tpic = "$targetDir/$HTMLThumbDir/$pic"; my $picNoSuffix = $pic; $picNoSuffix =~ s/\..*$//i; my $size = getFileSize($dpic, FORMAT); my ($w, $h) = getSize($dpic); my ($thumbw, $thumbh)= getSize($tpic); my $title = getIPTCObjectName($opic); $title = $picNoSuffix if ($title eq ""); my $IPTCheadline = getIPTCHeadline($opic); my $headline = $IPTCheadline; $headline = $title if ($headline eq ""); my $com = ""; if ($tmpconfR->{'HTMLaddComment'}) { # only the first comment is copied by jhead, so we use the comment(s) of the original picture $com = getComment($opic, 3); # allows big comments (up to 1000 chars) $com =~ s/\n/
/g; # replace newline with the corresponding html tag } my $IPTCcaption = getIPTCCaption($opic); $IPTCcaption =~ s/\n/
/g; # replace newline with the corresponding html tag # caption comes from either the IPTC caption or the JPEG comment my $caption = $IPTCcaption; $caption = $com if ($caption eq ""); my $byline = getIPTCByLine($opic); my $bylinetitle = getIPTCByLineTitle($opic); $bylinetitle .= ": " if ($bylinetitle ne ""); $byline = $bylinetitle.$byline if ($byline ne ""); my $location = getIPTCSublocation($opic); my $city = ""; $city = getIPTCCity($opic); if ($city ne "") { $location .= ", " if ($location ne ""); $location .= $city; } my $province = ""; $province = getIPTCProvince($opic); my $country = ""; $country = getIPTCAttr($opic, "Country/PrimaryLocationName");#getIPTCCountryCode($opic); if ($country ne "") { $province .= ", " if ($province ne ""); $province .= $country; } if ($province ne "") { if ($location ne "") { $location .= " ($province)"; } else { $location = $province; } } my $exif = ""; $exif = getShortEXIF($opic, NO_WRAP) if ($tmpconfR->{'HTMLaddEXIF'}); $exif =~ s/\[t\]//g; # remove thumbnail indicator [t] $exif =~ s/\[s\]//g; # remove saved exif indicator [s] my $iptc = ""; $iptc = getShortIPTC($opic, LONG) if ($tmpconfR->{'HTMLaddIPTC'}); # Escape special HTML characters, except in file names # and in purely numeric values (e.g. width). (by Dan Eble) foreach ($pic, $byline, $caption, $com, $exif, $size, $headline, $iptc, $IPTCcaption, $IPTCheadline, $location, $time, $title) { $_ =~ s/([$htmlChars])/$htmlChars{$1}/g; } my %replace; $replace{''} = $pic; $replace{''} = $byline; $replace{''} = $caption; $replace{''} = $com; $replace{''} = $exif; $replace{''}= $picNoSuffix; $replace{''} = $size; $replace{''} = $headline; $replace{''} = $h; $replace{''} = $iptc; $replace{''} = $IPTCcaption; $replace{''} = $IPTCheadline; $replace{''} = $location; $replace{''} = "$HTMLPicDir/$pic"; $replace{''} = $thumbh; $replace{''} = "$HTMLThumbDir/$pic"; $replace{''} = $thumbw; $replace{''} = $time; $replace{''} = $title; $replace{''} = $w; return %replace; } ############################################################## # makeHTMLPages ############################################################## sub makeHTMLPages { my $table = shift; my $tmpconfR = shift; my @pics = @_; my $targetDir = $tmpconfR->{'HTMLTargetDir'}; my ($pic, $htmlpage, $page, $next, $prev, $galtitle, %bigrep, $maxwidth, $maxheight); my $sum = @pics; $maxwidth = 0; $maxheight = 0; $galtitle = $tmpconfR->{HTMLGalleryTitle}; $galtitle =~ s/ / /g; # replace space by html tag non-breakable space my $index = 0; foreach my $dpic (@pics) { $pic = basename($dpic); $htmlInfo = "extracting data from $pic ..."; $htmlW->update; my %replace = createReplacementHashForPic($tmpconfR, $dpic); if ($replace{''} > $maxheight) { $maxheight = $replace{''}; } if ($replace{''} > $maxwidth) { $maxwidth = $replace{''}; } # Next and previous pages wrap around from end to beginning. my $previndex = ($index - 1) % $sum; my $nextindex = ($index + 1) % $sum; # File names for previous, current, and next page. # The first is "index.html" to simplify the URL of the album. $prev = $previndex ? basename($pics[$previndex]) : "index.html"; $htmlpage = $index ? basename($pics[$index]) : "index.html"; $next = $nextindex ? basename($pics[$nextindex]) : "index.html"; # change extensions to ".html" foreach ($prev, $htmlpage, $next) { $_ =~ s/\..*$/\.html/i; } $replace{''} = $index+1; $replace{''} = $next; $replace{''} = $htmlpage; $replace{''} = $prev; $bigrep{$pic} = \%replace; $index++; } my ($s,$m,$ho,$d,$mo,$y) = localtime(time()); $y += 1900; $mo++; # do some adjustments # build up the date time string my $date = sprintf "%02d.%02d.%04d", $d, $mo, $y; my $time = sprintf "%02d:%02d", $ho, $m; my $datetime = sprintf "%02d.%02d.%04d %02d:%02d", $d, $mo, $y, $ho, $m; my %globalReplace; $globalReplace{''} = $date; $globalReplace{''} = $datetime; $globalReplace{''} = $tmpconfR->{HTMLFooter}; $globalReplace{''}= $tmpconfR->{HTMLGalleryIndex}; $globalReplace{''} = $galtitle; $globalReplace{''} = $tmpconfR->{HTMLHomepage}; $globalReplace{''} = $mapiviInfo; $globalReplace{''} = $maxheight; $globalReplace{''} = $sum; $globalReplace{''} = $maxwidth; $globalReplace{''} = $table; foreach my $dpic (@pics) { $pic = basename($dpic); $htmlpage = $bigrep{$pic}{''}; print "xxx pic=$pic html=$htmlpage ($dpic)\n"; $htmlInfo = "building page $htmlpage ..."; $htmlW->update; $page = openTemplate($tmpconfR->{HTMLTemplate}); # do global substitutions first so that they will not have # to be replaced for each expansion of $page = doSubstitutions($page, \%globalReplace); my $re; my @left = ('(',''); my @right = (')',''); $_ = $page; # find the text inside of sections ($re=$_)=~s/(()|(<\/mapivi:foreachpic>)|.)/$right[!$3]\Q$1\E$left[!$2]/gs; my @inside = (eval{/$re/},$@!~/unmatched/i); # find the text outside of sections ($re=$_)=~s/(()|(<\/mapivi:foreachpic>)|.)/$right[!$2]\Q$1\E$left[!$3]/gs; $re = "(" . $re . ")"; my @outside = (eval{/$re/},$@!~/unmatched/i); # if the sections were parsed without error, # process the templates inside the tags if ($inside[-1] && $outside[-1] && ($#inside+1 == $#outside)) { $page = ""; for (0..$#inside-1) { $page .= $outside[$_] . substituteForEachPic($tmpconfR, $inside[$_], \%bigrep, @pics); } $page .= $outside[-2]; } $page = doSubstitutions($page, $bigrep{$pic}); writePage("$targetDir/$htmlpage", $page); $top->update; } } ############################################################## # doSubstitutions # Input: the pageContent string (from template), followed by hash of # substitutions to make ############################################################## sub doSubstitutions { my ($pageContent, $replaceR )= @_; my($tag, $replacement); while (($tag, $replacement) = each(%$replaceR)) { warn "doSubstitutions: tag not defined" unless defined $tag; warn "doSubstitutions: $tag replacement not defined" unless defined $replacement; $pageContent =~ s/$tag/$replacement/g; } # replace (german) umlaute by corresponding html-tags $pageContent =~ s/([$umlauteHTML])/$umlauteHTML{$1}/g; return $pageContent; } ############################################################## # substituteForEachPic ############################################################## sub substituteForEachPic { my $tmpconfR = shift; my $template = shift; my $bigrepR = shift; my @pics = @_; my $result = ""; my $pic; foreach my $dpic (@pics) { $pic = basename($dpic); $result .= doSubstitutions($template, $$bigrepR{$pic}); } return $result; } ############################################################## # openTemplate - open, read and return template ############################################################## sub openTemplate { my $template = shift; my $file; if (!open ($file, $template)) { die ("cannot open template $template for reading: ($!)"); } my $pageContent = (join '', <$file>); close ($file) || bail ("can't close template: ($!)"); return $pageContent; } ############################################################## # writePage - input path of page to render, not including $root ############################################################## sub writePage { # Spits out a page of HTML. my($file, $pageContent) = @_; my $outfile; open ($outfile, ">$file") or die "Couldn't open $file: $!"; print $outfile $pageContent; close($outfile); } ############################################################## # cleanHTMLDirs - delete all files which are not needed anymore ############################################################## sub cleanHTMLDirs { my $targetDir = shift; my @dpics = @_; my @picsAct; my @toDelete; my $rc; my $pictures; # clean html files my @htmlfiles = grep {m/.*\.html$/i} getFiles($targetDir); if (@htmlfiles >= 1) { $rc = $htmlW->messageBox(-icon => 'question', -message => scalar @htmlfiles." HTML pages should be deleted in $targetDir.\nOk, to delete?", -title => "clean up HTML folders", -type => 'OKCancel'); if ($rc eq "Ok") { foreach (@htmlfiles) { removeFile("$targetDir/$_"); } } } # clean pictures and thumbs foreach my $dir ("$targetDir/$HTMLPicDir", "$targetDir/$HTMLThumbDir") { @picsAct = getPics($dir, JUST_FILE); # no sort needed my @pics; # now we need the pics list without path push @pics, basename($_) foreach (@dpics); @toDelete = diffList(\@picsAct, \@pics); next if (@toDelete < 1); # choose the right word depending on the dir $pictures = "pictures"; $pictures = "thumbnails" if ($dir =~ m/$HTMLThumbDir$/); $rc = $htmlW->messageBox(-icon => 'question', -message => scalar @toDelete." $pictures should be deleted in\n$dir\nOk, to delete?", -title => "clean up HTML folders", -type => 'OKCancel'); if ($rc !~ m/Ok/i) { next; } foreach (@toDelete) { removeFile ("$dir/$_"); } } } ############################################################## # compareLists ############################################################## sub compareLists { my ($first, $second) = @_; no warnings; # silence spurious -w undef complaints return 0 unless @$first == @$second; for ( 0 .. $#{@$first}) { return 0 if $first->[$_] ne $second->[$_]; } return 1; } ############################################################## # diffList - returns a list containing all elements of list1 # which are not in list2 (removes the elements of list2 from list1) ############################################################## sub diffList { my $list1Ref = shift; # reference to first list my $list2Ref = shift; # reference to second list return () unless (@{$list1Ref}); return (@{$list1Ref}) unless (@{$list2Ref}); # build a hash my %d; $d{$_}++ foreach (@{$list1Ref}); # delete all elements in hash, which are in list2 foreach (@{$list2Ref}) { delete $d{$_} if (exists $d{$_}); } return (keys %d); } ############################################################## # listIntersection - returns a list containing all elements # of list1 which are also in list2 ############################################################## sub listIntersection { my $list1Ref = shift; # reference to first list my $list2Ref = shift; # reference to second list my (@intersection, %count, $element); foreach $element (@{$list1Ref}, @{$list2Ref}) { $count{$element}++ } foreach $element (keys %count) { push @intersection, $element if ($count{$element} > 1); } return @intersection; } ############################################################## # dirDiffWindow ############################################################## sub dirDiffWindow { if (Exists($ddw)) { $ddw->deiconify; $ddw->raise; $ddw->focus; return; } # open window $ddw = $top->Toplevel(); $ddw->withdraw; $ddw->title("Compare two folders"); $ddw->iconimage($mapiviicon) if $mapiviicon; my $f1 = $ddw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); my $f1a = $f1->Frame()->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 0, -pady => 0); my $f1b = $f1->Frame()->pack(-side => "left", -fill => "y", -padx => 0, -pady => 0); my $f2 = $ddw->Frame()->pack(-fill => 'x', -padx => 2, -pady => 3); my $f2a = $f2->Frame(-relief => 'groove')->pack(-side => "left", -fill => "y", -expand => 0, -padx => 1, -pady => 0); my $f2b = $f2->Frame(-relief => 'groove')->pack(-side => "left", -fill => "both", -expand => 1, -padx => 1, -pady => 0); #my $f3 = $ddw->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3); my $ddlb; $ddw->Label(-textvariable => \$ddw->{label}, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -anchor => 'w'); $ddw->{label} = 'Choose folders to compare and press the "Compare" button.'; labeledEntryButton($f1a,'top',12,"folder A",'Set',\$config{dirDiffDirA},1); labeledEntryButton($f1a,'top',12,"folder B",'Set',\$config{dirDiffDirB},1); $ddlb = $ddw->Scrolled("HList", -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 12, -scrollbars => 'osoe', -selectmode => "extended", -background => $config{ColorBG}, #8fa8bf -width => 40, -height => 20, )->pack(-expand => 1, -fill => "both"); bindMouseWheel($ddlb); $balloon->attach($ddlb, -msg => "left click : select\nmiddle click: open picture in new window\nright click : open context menu"); my $col = 0; $ddlb->header('create', $col, -text => 'Differences', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{diffcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Name', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{namecol} = $col; $col++; $ddlb->header('create', $col, -text => 'Thumbnail A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{thumbAcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Thumbnail B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{thumbBcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Size A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{sizeAcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Size B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{sizeBcol} = $col; $col++; $ddlb->header('create', $col, -text => 'IPTC A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{iptcAcol} = $col; $col++; $ddlb->header('create', $col, -text => 'IPTC B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{iptcBcol} = $col; $col++; $ddlb->header('create', $col, -text => 'EXIF A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{exifAcol} = $col; $col++; $ddlb->header('create', $col, -text => 'EXIF B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{exifBcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Comments A', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{comAcol} = $col; $col++; $ddlb->header('create', $col, -text => 'Comments B', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $ddlb->{comBcol} = $col; $col++; my $progress = 0; $f1b->Button(-text => "Compare", -command => sub { # check both dirs first foreach ($config{dirDiffDirA}, $config{dirDiffDirB}) { unless (-d $_) { $ddw->messageBox(-icon => 'warning', -message => "Folder \"$_\" is not valid!", -title => 'Error', -type => 'OK'); return; } } if ($config{dirDiffDirA} eq $config{dirDiffDirB}) { $ddw->messageBox(-icon => 'warning', -message => "Please choose two different folders!", -title => 'Error', -type => 'OK'); return; } $ddw->Busy; $ddlb->delete("all"); # clear listbox my (@onlyInDirA, @onlyInDirB, @intersec); dirDiff($config{dirDiffDirA}, $config{dirDiffDirB}, \@onlyInDirA, \@onlyInDirB, \@intersec); $ddw->{label} = "found ".scalar @onlyInDirA." unique pictures in dir A, ".scalar @onlyInDirB." unique pictures in dir B and ".scalar @intersec." matching pictures"; $ddw->update; my $pics = @onlyInDirA + @onlyInDirB + @intersec; my $pic; my $last_time; my $i = 0; foreach $pic (sort @onlyInDirA) { my $dpic = $config{dirDiffDirA}."/$pic"; ddInsertPic($ddlb, $dpic, "", "only in dir A"); $i++; # show progress and found pics every 0.5 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { $progress = int($i/$pics*100); $ddw->update; $last_time = Tk::timeofday(); } } foreach $pic (sort @onlyInDirB) { my $dpic = $config{dirDiffDirB}."/$pic"; ddInsertPic($ddlb, "", $dpic, "only in dir B"); $i++; # show progress and found pics every 0.5 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { $progress = int($i/$pics*100); $ddw->update; $last_time = Tk::timeofday(); } } my $inter = 0; foreach $pic (sort @intersec) { my $dpicA = $config{dirDiffDirA}."/$pic"; my $dpicB = $config{dirDiffDirB}."/$pic"; my $differences = ""; if (compareTwoPics($dpicA, $dpicB, \$differences)) { ddInsertPic($ddlb, $dpicA, $dpicB, $differences); $inter++; } $i++; # show progress and found pics every 0.5 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { $progress = int($i/$pics*100); $ddw->update; $last_time = Tk::timeofday(); } } $progress = 100; $ddw->{label} = "found ".scalar @onlyInDirA." unique pictures in dir A, ".scalar @onlyInDirB." unique pictures in dir B and ".scalar @intersec." matching pictures ($inter of them differ)."; $ddw->Unbusy; })->pack(-fill => "y", -side => "left"); $f1b->Button(-text => "Close", -command => sub { $ddw->destroy; })->pack(-fill => "y", -side => "left"); $f2a->Label(-text => "compare by ", -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3); $f2a->Checkbutton(-variable => \$config{dirDiffSize}, -text => "files size")->pack(-side => "left"); $f2a->Checkbutton(-variable => \$config{dirDiffPixel}, -text => "pixel size")->pack(-side => "left"); $f2a->Checkbutton(-variable => \$config{dirDiffComment}, -text => "comment")->pack(-side => "left"); $f2a->Checkbutton(-variable => \$config{dirDiffEXIF}, -text => "EXIF")->pack(-side => "left"); $f2a->Checkbutton(-variable => \$config{dirDiffIPTC}, -text => "IPTC")->pack(-side => "left"); $f2b->Button(-text => "Copy A->B", -command => sub { return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); my $i = 0; my $rc = 1; my $n = 0; foreach (@sellist) { my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text); $i++; $ddw->{label} = "copy ($i/".scalar @sellist.") ... "; $ddw->update; my $dpic = $config{dirDiffDirA}."/$pic"; next unless (-f $dpic); my $tpic = $config{dirDiffDirB}."/$pic"; # if the pic exists, ask if the user wants to overwrite it $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); if (mycopy ($dpic, $tpic, OVERWRITE)) { # copy pic $n++; my $thumbpic = getThumbFileName($dpic); my $thumbtpic = getThumbFileName($tpic); if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ($thumbpic,$thumbtpic, OVERWRITE) # copy thumbnail } $ddlb->delete("entry", $_); # remove entry from list box } } # foreach - end $ddw->{label} = "ready! ($n/".scalar @sellist." copied)"; $ddw->update; })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2); $f2b->Button(-text => "Copy A<-B", -command => sub { return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); my $i = 0; my $rc = 1; my $n = 0; foreach (@sellist) { my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text); $i++; $ddw->{label} = "copy ($i/".scalar @sellist.") ... "; $ddw->update; my $dpic = $config{dirDiffDirB}."/$pic"; next unless (-f $dpic); my $tpic = $config{dirDiffDirA}."/$pic"; # if the pic exists, ask if the user wants to overwrite it $rc = overwritePic($tpic, $dpic, (scalar(@sellist) - $i + 1)) if ($rc != 2); next if ($rc == 0); last if ($rc == -1); if (mycopy ($dpic, $tpic, OVERWRITE)) { # copy pic $n++; my $thumbpic = getThumbFileName($dpic); my $thumbtpic = getThumbFileName($tpic); if ((-d dirname($thumbtpic)) and (-f $thumbpic)) { mycopy ($thumbpic, $thumbtpic, OVERWRITE) # copy thumbnail } $ddlb->delete("entry", $_); # remove entry from list box } } # foreach - end $ddw->{label} = "ready! ($n/".scalar @sellist." copied)"; $ddw->update; })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2); $f2b->Button(-text => "Delete A", -command => sub { return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirA}."?", -icon => 'question', -title => "Really delete?", -type => 'OKCancel'); return unless ($rc =~ m/Ok/i); my $i = 0; my $n = 0; foreach (@sellist) { my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text); $i++; $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update; my $dpic = $config{dirDiffDirA}."/$pic"; unless (-f $dpic) { print "$dpic not found!\n"; next;} if (move ($dpic, $trashdir)) { # move pic to trash $n++; my $tpic = "$trashdir/$pic"; # change the location info in the search database $searchDB{$tpic} = $searchDB{$dpic}; delete $searchDB{$dpic}; deleteCachedPics($dpic); # todo move thumbnail? # todo deleting the entry is wrong, if picture exists in both dirs $ddlb->delete("entry", $_); # remove entry from list box } } # foreach - end $ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update; })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2); $f2b->Button(-text => "Delete B", -command => sub { return unless ($ddlb->info('children')); my @sellist = $ddlb->info('selection'); return unless (@sellist); my $rc = $ddw->messageBox(-message => "Really delete ".scalar @sellist." pictures in folder ".$config{dirDiffDirB}."?", -icon => 'question', -title => "Really delete?", -type => 'OKCancel'); return unless ($rc =~ m/Ok/i); my $i = 0; my $n = 0; foreach (@sellist) { my $pic = $ddlb->itemCget($_, $ddlb->{namecol}, -text); $i++; $ddw->{label} = "deleting ($i/".scalar @sellist.") ... "; $ddw->update; my $dpic = $config{dirDiffDirB}."/$pic"; unless (-f $dpic) { print "$dpic not found!\n"; next;} if (move ($dpic, $trashdir)) { # move pic to trash $n++; my $tpic = "$trashdir/$pic"; # change the location info in the search database $searchDB{$tpic} = $searchDB{$dpic}; delete $searchDB{$dpic}; deleteCachedPics($dpic); # todo move thumbnail? # todo deleting the entry is wrong, if picture exists in both dirs $ddlb->delete("entry", $_); # remove entry from list box } } # foreach - end $ddw->{label} = "ready! ($n/".scalar @sellist." deleted)"; $ddw->update; })->pack(-fill => 'x', -side => "left", -padx => 2, -pady => 2); $f2b->Label(-text => "progress: ", -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3); my $progBar = $f2b->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -length => 100, -height => 5, -padx => 0, -pady => 0, -variable => \$progress, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => 10, -anchor => 'w', -from => 0, -to => 100, )->pack(-side => 'left', -expand => 1, -fill => "both", -padx => 3, -pady => 3); my $ws = 0.7; my $w = int($ws * $ddw->screenwidth); my $h = int($ws * $ddw->screenheight); my $x = int(((1 - $ws) * $ddw->screenwidth)/3); my $y = int(((1 - $ws) * $ddw->screenheight)/3); #print "geo==${w}x${h}+${x}+${y}\n"; $ddw->geometry("${w}x${h}+${x}+${y}"); $ddw->Popup; $ddw->waitWindow; } ############################################################## # compareTwoPics ############################################################## sub compareTwoPics { my $dpicA = shift; my $dpicB = shift; my $diff = shift; # Ref to differences my $rc = 0; # 0 = no difference 1 = pics are different if ($config{dirDiffSize} and (-s $dpicA != -s $dpicB)) { my $diff_bytes = getFileSize($dpicB, NO_FORMAT) - getFileSize($dpicA, NO_FORMAT); my $sign = '-'; $sign = '+' if ($diff_bytes > 0); if (abs($diff_bytes) > 1024) { $diff_bytes = computeUnit(abs($diff_bytes)); } else { $diff_bytes = abs($diff_bytes).'B'; } $$diff .= "file size ($sign$diff_bytes)\n"; $rc = 1; } if ($config{dirDiffComment} and (getComment($dpicA, LONG) ne getComment($dpicB, LONG))) { $$diff .= "comment\n"; $rc = 1; } if ($config{dirDiffEXIF} and (getShortEXIF($dpicA, NO_WRAP) ne getShortEXIF($dpicB, NO_WRAP))) { $$diff .= "EXIF\n"; $rc = 1; } if ($config{dirDiffIPTC} and (getIPTC($dpicA, SHORT) ne getIPTC($dpicB, SHORT))) { $$diff .= "IPTC\n"; $rc = 1; } if ($config{dirDiffPixel}) { my ($wa, $ha) = getSize($dpicA); my ($wb, $hb) = getSize($dpicB); if (($wa != $wb) or ($ha != $hb)) { $$diff .= "pixel size\n"; $rc = 1; } } return $rc; } ############################################################## # ddInsertPic - insert a row in the dir diff list ############################################################## sub ddInsertPic { my $lb = shift; my $dpicA = shift; # the dir A pic, empty string if non my $dpicB = shift; # the dir B pic, empty string if non my $reason = shift; # the difference if ((!-f $dpicA) and (!-f $dpicB)) { warn "both pics are missing!"; return; } my @childs = $lb->info('children'); my $count = 0; $count = @childs if (@childs); # create new row $lb->add($count); my (%ddthumbs, $sizeA, $sizeB, $comA, $comB, $exifA, $exifB, $iptcA, $iptcB); if (-f $dpicA) { $comA = getComment($dpicA, SHORT); $exifA = getShortEXIF($dpicA, WRAP); $iptcA = getShortIPTC($dpicA, SHORT); $sizeA = getAllFileInfo($dpicA); my $thumbA = getThumbFileName($dpicA); if (-f $thumbA) { $ddthumbs{$thumbA} = $lb->Photo(-file => $thumbA, -gamma => $config{Gamma}); if (defined $ddthumbs{$thumbA}) { $lb->itemCreate($count, $lb->{thumbAcol}, -image => $ddthumbs{$thumbA}, -itemtype => "image"); } } } if (-f $dpicB) { $comB = getComment($dpicB, SHORT); $exifB = getShortEXIF($dpicB, WRAP); $iptcB = getShortIPTC($dpicB, SHORT); $sizeB = getAllFileInfo($dpicB); my $thumbB = getThumbFileName($dpicB); if (-f $thumbB) { $ddthumbs{$thumbB} = $lb->Photo(-file => $thumbB, -gamma => $config{Gamma}); if (defined $ddthumbs{$thumbB}) { $lb->itemCreate($count, $lb->{thumbBcol}, -image => $ddthumbs{$thumbB}, -itemtype => "image"); } } } my $pic; if (-f $dpicA) { $pic = basename($dpicA); } else { $pic = basename($dpicB); } $lb->itemCreate($count, $lb->{diffcol}, -text => $reason, -style => $comS); $lb->itemCreate($count, $lb->{namecol}, -text => $pic, -style => $fileS); $lb->itemCreate($count, $lb->{sizeAcol}, -text => $sizeA, -style => $comS); $lb->itemCreate($count, $lb->{sizeBcol}, -text => $sizeB, -style => $exifS); $lb->itemCreate($count, $lb->{comAcol}, -text => $comA, -style => $comS); $lb->itemCreate($count, $lb->{comBcol}, -text => $comB, -style => $exifS); $lb->itemCreate($count, $lb->{exifAcol}, -text => $exifA, -style => $comS); $lb->itemCreate($count, $lb->{exifBcol}, -text => $exifB, -style => $exifS); $lb->itemCreate($count, $lb->{iptcAcol}, -text => $iptcA, -style => $comS); $lb->itemCreate($count, $lb->{iptcBcol}, -text => $iptcB, -style => $exifS); } ############################################################## # dirDiff ############################################################## sub dirDiff { my $dir1 = shift; my $dir2 = shift; my $only1 = shift; # ref to array my $only2 = shift; # ref to array my $inter = shift; # ref to array return unless (-d $dir1); return unless (-d $dir2); my $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable $config{CheckForNonJPEGs} = 0; # switch the option off my @pics1 = getPics($dir1, JUST_FILE); # no sort needed my @pics2 = getPics($dir2, JUST_FILE); # no sort needed $config{CheckForNonJPEGs} = $tmp; # restore the option @{$only1} = diffList(\@pics1, \@pics2); @{$only2} = diffList(\@pics2, \@pics1); @{$inter} = listIntersection(\@pics2, \@pics1); } ############################################################## # showkeys - show the key bindings ############################################################## sub showkeys { my $file; # open the file mapivi if (!open($file, "<$0")) { warn "could not open $0 for read access!: $!"; return; } my @lines = <$file>; # read the complete file into the array lines close $file; my @keys; foreach my $line (@lines) { $line =~ s/\s+$//; # cut trailing whitespace $line =~ s/^\s+//; # cut leading whitespace # look for lines containing "key-desc" if ($line =~ m/.*key-desc.*/) { push @keys, $line; } } my $text; # sort the keys alphabetical foreach (sort { uc($a) cmp uc($b); } @keys) { my @a = split /,/, $_; if (@a != 3) { print "showKeys: suspicious line: $_\n"; next; } chomp($a[2]); $text .= sprintf "%-13s ... %s\n",$a[1], $a[2]; } my $title = "Keys shortcuts for mapivi $version"; showText($title, $text, NO_WAIT, $mapiviiconfile); } ############################################################## # buildDatabase - scans through all sub folders of # the actual dir an collects JPEG files # let the user select in which dirs # mapivi should build/refresh thumbnails ############################################################## sub buildDatabase { my $mydir = getRightDir(); my $rc = checkDialog( 'Add pictures to database in all sub folders', 'MaPiVi will create a list of all sub folders of folder "'.basename($mydir).'" containing JPEG files. You are then able to select folders from the list.', \$config{SearchDBOnlyNew}, "add only new pictures", "", 'OK', 'Cancel'); return if ($rc ne 'OK'); my $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable $config{CheckForNonJPEGs} = 0; # switch the option off $userinfo = "searching sub folders ..."; $userInfoL->update; my @dirlist; my %nr_of_pics_in_dir; my @pictestlist; my $pic_count = 0; my $pw = progressWinInit($top, "Collect sub folders"); my $break = 0; find(sub { if (progressWinCheck($pw)) { $break = 1; $File::Find::prune = 1; } progressWinUpdate($pw, "collecting folders, found ".scalar @dirlist." ...", 0, 0); # search in dirs, but not in .thumbs/ .xvpics/ etc. if (-d and ($_ ne $thumbdirname) and ($_ ne ".xvpics") and ($_ ne $exifdirname)) { @pictestlist = getPics($File::Find::name, JUST_FILE); # no sorting needed if (@pictestlist > 0) { $pic_count += scalar @pictestlist; $nr_of_pics_in_dir{$File::Find::name} = scalar @pictestlist; push @dirlist, $File::Find::name; $userinfo = "found ".scalar @dirlist." sub folders ..."; $userInfoL->update; } } }, $mydir); progressWinEnd($pw); if ($break) { $userinfo = "user break while counting folders"; return; } $config{CheckForNonJPEGs} = $tmp; # restore the option $userinfo = "found ".@dirlist." sub folders with $pic_count JPEGs"; $userInfoL->update; @dirlist = sort @dirlist; my @sellist; return if (!mySelListBoxDialog("Select folders", "Found ".scalar @dirlist." folders with $pic_count JPEG pictures.\nThe database will be updated with the pictures of the selected folders.", MULTIPLE, "add to database", \@sellist, @dirlist)); # copy the selected elements into the @sel_dirs list my @sel_dirs; $pic_count = 0; foreach (@sellist) { push @sel_dirs, $dirlist[$_]; $pic_count += $nr_of_pics_in_dir{$dirlist[$_]} } my ($dir, $dirshort, @dpics, $pic, $dpic, $com, $exif, $iptcL); $tmp = $config{CheckForNonJPEGs}; # save the option to a temp variable $config{CheckForNonJPEGs} = 0; # switch the option off $pw = progressWinInit($top, "building search database"); my $i = 0; my $new = 0; foreach $dir (@sel_dirs) { last if progressWinCheck($pw); $dirshort = cutString($dir, -40, "..."); print "build database recursive in $dir\n" if $verbose; @dpics = getPics($dir, WITH_PATH); # no sorting needed foreach (@dpics) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding picture ($i/$pic_count) in folder $dirshort", $i, $pic_count); next if ($config{SearchDBOnlyNew} and exists $searchDB{$_}); addToSearchDB($_); $new++; } } progressWinEnd($pw); $config{CheckForNonJPEGs} = $tmp; # restore the option $userinfo = "database updated (scanned $i pictures, $new added)"; $userInfoL->update; check_new_keywords(); } ############################################################## # cleanDatabase - remove all database entries of non existing # files ############################################################## sub cleanDatabase { my $count = 0; my $pics; my $ignoreText = ""; my $ignoreCount = 0; my $keys = keys %searchDB; my %ignorePaths = qw( /mnt/cdrom/ 1 ); # try to get the saved ignore paths if (-f "$configdir/ignorePaths") { my $hashRef = retrieve("$configdir/ignorePaths"); warn "could not retrieve ignorePaths" unless defined $hashRef; %ignorePaths = %{$hashRef}; } my $rc = editHashDialog('Edit ignore paths', 'This function will remove all invalid and outdated entries from the search database. When cleaning the database, all entries without an corresponding file will be removed. It is possible to exclude entries from cleaning depending on their path. This could be done e.g. for pictures on removable media like CDROMs or DVDs. Please add or remove paths from this list according to your file system. A typical entry for a linux system could be /mnt/cdrom', \%ignorePaths, 'Clean database', 'Cancel', 1 ); return if ($rc ne 'OK'); nstore(\%ignorePaths, "$configdir/ignorePaths") or warn "could not store ignorePaths"; $userinfo = "cleaning database - please wait ..."; $userInfoL->update; my $pw = progressWinInit($top, "cleaning search database"); my $i = 0; # loop through all database entries foreach my $pic (sort keys %searchDB) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "checking ($i/$keys) ...", $i, $keys); # if the pic path matches a path of @ignorePaths we skip the entry # this can be used to leave pictures in the database which are # located on removable media like CDs my $ignore = 0; foreach my $ipath (keys %ignorePaths) { if ($pic =~ m/^$ipath/) { $ignore = 1; $ignoreCount++; $ignoreText .= "(ignoring $pic)\n"; last; } } next if $ignore; # delete the picture from the database if it does not exists if (!-f $pic) { delete $searchDB{$pic}; $pics .= "$pic\n"; $count++; } } progressWinEnd($pw); $userinfo = "cleaning database - ready"; $userInfoL->update; my $text = "clean picture info database:\n\n"; if ($count > 0) { $text .= "Removed $count entries of non existing pictures:\n\n$pics"; } else { $text .= "Nothing to clean - database is up to date!\n\n"; } $keys = keys %searchDB; my $size = getFileSize("$configdir/SearchDataBase", FORMAT); $text .= "There are $keys entries in the database (file size: $size)\n\n"; $text .= "The following $ignoreCount entries have been ignored, because their path\nmatches a entry in the \%ignorePaths hash:\n\n$ignoreText" if ($ignoreText ne ""); showText("Clean database", $text, WAIT); } ############################################################## # cleanDatabaseFolder - clean the database in one folder ############################################################## sub cleanDatabaseFolder { my $directory = shift; $userinfo = "updating database - please wait ..."; $userInfoL->update; my $pw = progressWinInit($top, "updating search database"); my $i = 0; my $keys = keys %searchDB; # loop through all database entries foreach my $pic (sort keys %searchDB) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "checking ($i/$keys) ...", $i, $keys); # if the pic path matches the given path # delete the picture from the database if it does not exists if (($pic =~ m/^$directory/) and (!-f $pic)) { #print "deleting pic $pic from DB\n"; delete $searchDB{$pic}; #$pics .= "$pic\n"; #$count++; } } progressWinEnd($pw); $userinfo = "database updated!"; $userInfoL->update; } ############################################################## # editEntryHistory ############################################################## sub editEntryHistory { my $buttext = "Remove"; my $text = "The left list shows all used entry fields, if you select one, the right listbox will show you all elements, that have been typed into this entry field. Select one or multiple element from the right listbox and press the $buttext button to delete them."; my $rc; # open window my $ew = $top->Toplevel(); $ew->title("Edit entry history"); $ew->iconimage($mapiviicon) if $mapiviicon; my $height = ($text =~ tr/\n//); $height += 2; $height = 10 if ($height > 10); # not to big, we have scrollbars my $rotext = $ew->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 110, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w'); $rotext->insert('end', $text); my $size = getFileSize($file_Entry_values, FORMAT); my $info = "File size of $file_Entry_values: $size"; my $lbf = $ew->Frame()->pack(-fill =>'x'); my $listBox = $lbf->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'single', -exportselection => 0, -width => 30, -height => 25, )->pack(-side => 'left', -expand => 1, -fill =>'both', -padx => 3, -pady => 3); bindMouseWheel($listBox); my @ekeys = sort keys %entryHistory; $listBox->insert('end', @ekeys); my $lbfr = $lbf->Frame()->pack(-side => 'left', -expand => 1, -fill =>'both'); my $listBox2 = $lbfr->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, #-width => 80, -height => 25, )->pack(-side => 'top', -expand => 1, -fill =>'both', -padx => 3, -pady => 3); bindMouseWheel($listBox2); $listBox->bind('', sub { my @sel = $listBox->curselection(); my $key = $ekeys[$sel[0]]; my @list = @{$entryHistory{$key}}; $listBox2->delete(0, 'end'); $listBox2->insert('end', @list); }); my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3); $labF->Label(-textvariable => \$info, -bg => $config{ColorBG})->pack(-side => "left"); $lbfr->Button(-text => $buttext, -command => sub { my @sel = $listBox->curselection(); my $key = $ekeys[$sel[0]]; foreach (reverse $listBox2->curselection()) { my $path = $listBox2->get($_); #print "deleting key $key element $_ ".${$entryHistory{$key}}[$_]."\n"; splice @{$entryHistory{$key}}, $_, 1; # remove it from list $listBox2->delete($_); } } )->pack(-expand => 1, -fill =>'x', -anchor => 'w', -padx => 3, -pady => 3); my $ButF = $ew->Frame()->pack(-fill =>'x'); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 'OK'; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); $OKB->focus; $ew->Popup(-popover => 'cursor'); repositionWindow($ew); $ew->waitVariable(\$rc); $ew->withdraw; $ew->destroy; } ############################################################## # database_info - show infos and statistics about search database ############################################################## sub database_info { # first create a chronological statistic (number of pics for each month) my %chrono_hash; my $pic_count = 0; my $error_count = 0; my $i = 0; my $keys = keys %searchDB; my $pw = progressWinInit($top, "Calculating statistic (chronological distribution)"); foreach my $dpic (keys %searchDB) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding picture ($i/$keys) ...", $i, $keys); if ($searchDB{$dpic}{TIME}) { my ($s,$m,$h,$d,$mo,$y) = localtime $searchDB{$dpic}{TIME}; $y += 1900; $mo++; # do some adjustments my $key = sprintf "%04d%02d", $y, $mo; # key = yyyymm $chrono_hash{$key}++; $pic_count++; } else { $error_count++; } } progressWinEnd($pw); #print "found $error_count pictures without date info.\n" if ($error_count > 0); #print "found $pic_count pictures with date info.\n"; # fill up empty months in hash with zero my @chrono_list; foreach (sort keys %chrono_hash) { push @chrono_list, $_; } my $first_ymonth = $chrono_list[0]; my $last_ymonth = $chrono_list[-1]; my $first_month = substr($first_ymonth, 4 , 2); my $last_month = substr($last_ymonth, 4 , 2); my $first_year = substr($first_ymonth, 0 , 4); my $last_year = substr($last_ymonth, 0 , 4); for my $year ($first_year .. $last_year) { for my $month (1 .. 12) { next if (($year == $first_year) and ($month < $first_month)); last if (($year == $last_year) and ($month > $last_month)); my $yyyymm = sprintf "%04d%02d", $year, $month; if ($chrono_hash{$yyyymm}) { #print "$yyyymm is defined\n"; } else { #print "$yyyymm is not defined\n"; $chrono_hash{$yyyymm} = 0; } } } my $month_nr = keys %chrono_hash; #print "found $month_nr differnt month; max. pics $max_pics_per_month in month $max_month. first: $first_ymonth ($first_year $first_month) last: $last_ymonth ($last_year $last_month)\n"; # open window my $win = $top->Toplevel(); $win->title("Database Information - Timeline (Chronological Picture Distribution)"); $win->iconimage($mapiviicon) if $mapiviicon; # canvas size #my $h = int(0.3 * $win->screenheight); #my $w = int(0.9 * $win->screenwidth); my $w = 0; my $h = 0; my $h_scale_factor =1; my $month_w = $w/$month_nr; my $butF = $win->Frame()->pack(-expand => 0, -fill => 'y'); my $canvas = $win->Scrolled('Canvas', -scrollbars => 'osoe', #-width => $w, #-height => $h+26, -width => 10, -height => 10, -relief => 'sunken', )->pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 3, -pady => 3); $canvas->configure(-scrollregion => [0, 0, 10, 10]); $butF->Button(-text => ' -- ', -command => sub { $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width $month_w = $w/$month_nr if ($month_w < 1); $month_w -= 5; $month_w = 1 if ($month_w < 1); database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => ' - ', -command => sub { $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width $month_w = $w/$month_nr if ($month_w < 1); $month_w--; $month_w = 1 if ($month_w < 1); database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => ' + ', -command => sub { $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width $month_w = $w/$month_nr if ($month_w < 1); $month_w++; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => '++', -command => sub { $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width $month_w = $w/$month_nr if ($month_w < 1); $month_w += 5; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => 'minimum', -command => sub { $month_w = 1; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => 'medium', -command => sub { $month_w = 16; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => 'large', -command => sub { $month_w = 36; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => 'fit', -command => sub { $win->update; #$w = $canvas->Subwidget("scrolled")->width; #$h = $canvas->Subwidget("scrolled")->height; #$month_w = $w/$month_nr; $month_w = 0; database_info_update($canvas, \%chrono_hash, $month_w); })->pack(-side => 'left', -padx => 3, -pady => 3); $butF->Button(-text => 'Info', -command => sub { my $text = "Chronological distribution of pictures per month in the search database.\nThis chart uses the picture EXIF date when available.\n$pic_count pictures with and $error_count pictures without date info in database.\nIf you click on a box the pictures of that month will be shown.\nSome information will appear, if mouse hovers above a box."; showText("Information", $text, NO_WAIT); })->pack(-side => 'left', -padx => 3, -pady => 3); my $msg = ''; $balloon->attach($canvas, -postcommand => sub { my @curr = $canvas->find('withtag', 'current'); my @tags = $canvas->gettags($curr[0]); my $yyyymm = ''; foreach (@tags) { next if ($_ eq 'current'); $yyyymm = $_; } return if (length($yyyymm) != 6); my $act_month = substr($yyyymm, 4 , 2); my $act_year = substr($yyyymm, 0 , 4); $msg = "$act_month/$act_year: $chrono_hash{$yyyymm} pictures"; }, -balloonposition => "mouse", -msg => \$msg); $canvas->CanvasBind( '' => sub { my @curr = $canvas->find('withtag', 'current'); my @tags = $canvas->gettags($curr[0]); my $yyyymm = ''; foreach (@tags) { next if ($_ eq 'current'); $yyyymm = $_; } return if (length($yyyymm) != 6); my $act_month = substr($yyyymm, 4 , 2); my $act_year = substr($yyyymm, 0 , 4); my $rc = $win->messageBox(-icon => 'question', -title => "Show $chrono_hash{$yyyymm} pictures from $act_month/$act_year?", -message => "Press OK to display $chrono_hash{$yyyymm} pictures from $act_month/$act_year.", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); my @list; my $start_time = buildUnixTime(sprintf "01.%02d.%04d", $act_month, $act_year); my $next_month = $act_month + 1; my $next_year= $act_year; if ($next_month > 12) { $next_month = 1; $next_year++; } my $end_time = buildUnixTime(sprintf "01.%02d.%04d", $next_month, $next_year) - 1; #print "xxx-start: $start_time .. end: $end_time act:$act_month, $act_year next: $next_month, $next_year\n"; my $i = 0; my $db_keys = keys %searchDB; my $pw = progressWinInit($win, "Searching pictures database"); foreach my $dpic (keys %searchDB) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "searching ($i/$db_keys) ...", $i, $db_keys); my $time = $searchDB{$dpic}{TIME}; next unless (defined $time); next if ($time < $start_time); next if ($time > $end_time); push @list, $dpic; } progressWinEnd($pw); sortPics('exifdate', 1, \@list); showThumbList(\@list, "$act_month/$act_year"); }); $butF->Button(-text => "Close", -command => sub { $win->destroy(); } )->pack(-side => 'left',-expand => 0,-fill => 'x',-padx => 3,-pady => 3); $win->bind('', sub { $win->destroy; } ); $win->Popup; my $ww = int(0.8 * $top->screenwidth); my $wh = int(0.3 * $top->screenheight); $win->geometry("${ww}x${wh}+10+10"); $win->update; database_info_update($canvas, \%chrono_hash, $month_w); } ############################################################## # database_info_update - draw diagram ############################################################## sub database_info_update { my $canvas = shift; #my $w = shift; #my $h = shift; my $chrono_hash = shift; #my $pic_count = shift; #my $error_count = shift; my $month_w = shift; #my $month_nr = shift; #my $h_scale_factor = shift; my $month_nr = keys %{$chrono_hash}; my $w = $canvas->Subwidget("scrolled")->width - $ScW; # $ScW = scrollbar width my $h = $canvas->Subwidget("scrolled")->height - $ScW; # search the maximum number of pictures per month my $max_pics_per_month = 0; foreach (keys %{$chrono_hash}) { if ($chrono_hash->{$_} > $max_pics_per_month) { $max_pics_per_month = $chrono_hash->{$_}; } } my $axis_h = 30; # height for x axis and month and year numbers my $h_scale_factor = $max_pics_per_month/($h - $axis_h); $month_w = $w/$month_nr if ($month_w == 0); $canvas->delete('all'); #$canvas->configure(-scrollregion => [0, 0, $month_nr*$month_w-10, $h+26]); $canvas->configure(-scrollregion => [0, 0, $month_nr*$month_w, $h]); my $x = 2; my $step = 0; foreach my $yyyymm (sort keys %{$chrono_hash}) { my $act_month = substr($yyyymm, 4 , 2); my $act_year = substr($yyyymm, 0 , 4); # draw a box for each month my $id = $canvas->createRectangle( $x, $h-$axis_h, int($x+$month_w-1), $h-$axis_h-int($chrono_hash->{$yyyymm}/$h_scale_factor), -fill => $config{ColorActBG}, -outline => $config{ColorSel}, -tags => $yyyymm, -width => 1, ); # mark month border $canvas->createLine( $x, $h-$axis_h, $x, $h-int(0.5*$axis_h), -fill => $config{ColorFG}); # mark year border if ($act_month eq '01') { $canvas->createLine( $x, $h-$axis_h, $x, $h, -fill => $config{ColorFG}); } # write month if more then 16 pixel available if ($month_w >= 16) { $canvas->createText($x+int($month_w/2), $h-$axis_h+6, -font => $small_font, -text => $act_month, -anchor => 'n', -justify => 'center', -fill => $config{ColorFG}); } # write number of pics if enough space if ($month_w > length($chrono_hash->{$yyyymm})*8) { my $h = $h-$axis_h-int($chrono_hash->{$yyyymm}/$h_scale_factor); $h = 14 if ($h < 14); $canvas->createText($x+int($month_w/2), $h, -font => $small_font, -text => $chrono_hash->{$yyyymm}, -anchor => 's', -justify => 'center', -fill => $config{ColorFG}); } # write year if ($act_month eq '07') { $canvas->createText($x, $h, -font => $small_font, -text => $act_year, -anchor => 's', -justify => 'center', -fill => $config{ColorFG}); } $step++; $x = int($month_w * $step); } # draw x axis $canvas->createLine( 0, $h-$axis_h, $month_nr*$month_w, $h-$axis_h, -fill => $config{ColorFG}); } ############################################################## # keyword_browse - browse picture collection by keywords (tagclouds) ############################################################## sub keyword_browse { # list of keywords to constraint the browsing/searching my @search_keys; # list of keywords to exclude from browsing/searching my @exclude_keys; # get stored values if ($config{KeywordExclude}) { @exclude_keys = split / /, $config{KeywordExclude}; } # open window my $win = $top->Toplevel(); $win->title('Keyword browser (tag cloud)'); $win->iconimage($mapiviicon) if $mapiviicon; my $cc; my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $butF2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $butF3 = $win->Frame(-relief => 'groove'); if ($config{KeywordMore}) { $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3); } else { $butF3->packForget(); } my $add_mode = 1; my $label = ''; my $hb = $butF->Button(-text => 'home', -command => sub { # reset search_keys @search_keys = (); $label = ''; show_keywords($win, \@search_keys, \@exclude_keys); })->pack(-side => 'left', -padx => 3); $balloon->attach($hb, -msg => "Restart\nShow all keywords"); my $bb = $butF->Button(-text => 'back', -command => sub { return unless (@search_keys); # remove last element of array search_keys pop @search_keys; $label = ''; $label .= "$_ " foreach (@search_keys); show_keywords($win, \@search_keys, \@exclude_keys); })->pack(-side => 'left', -padx => 3); $balloon->attach($bb, -msg => "Go back\nRemove last keyword from list"); $butF->Label(-textvariable => \$label, )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); my $addB = $butF->Checkbutton(-text => 'add mode', -variable => \$add_mode)->pack(-side => 'left'); $balloon->attach($addB, -msg => 'If add mode is enabled, keywords will be added and the search is narrowed to pictures containing all displayed keywords. If add mode is disabled, each click on a keyword will start a new search for just this keyword.'); my $Xbut = $butF->Button(-text => 'Close', -command => sub { # store excluded keywords for next session $config{KeywordExclude} = ''; $config{KeywordExclude} .= "$_ " foreach (@exclude_keys); # clode window $win->destroy(); })->pack(-side => 'right', -padx => 3); $balloon->attach($Xbut, -msg => 'Close window (key: ESC)'); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); $butF2->Button(-text => 'show', -command => sub { my @list = get_pics_with_keywords(\@search_keys, \@exclude_keys); showThumbList(\@list, $label); })->pack(-side => 'left', -padx => 3); my $lab2 = $butF2->Label(-textvariable => \$win->{label2}, )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 3, -pady => 1); $balloon->attach($lab2, -msg => "x pictures\nx = number of pictures with the selected keywords\ny/z keywords\n = number of displayed keywords\nz = number of all matching keywords"); my $more_button; $more_button = $butF2->Checkbutton(-variable => \$config{KeywordMore}, -text => 'more options', -command => sub { if ($config{KeywordMore}) { $butF3->pack(-after => $butF2, -expand => 0, -fill => 'x', -padx => 4, -pady => 3); } else { $butF3->packForget(); } })->pack(-side => 'right', -padx => 5); $balloon->attach($more_button, -msg => 'Click here to see some more options'); my $label_ex = ''; $label_ex .= "$_ " foreach (@exclude_keys); my $butF3i = $butF3->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $ceb = $butF3i->Button(-text => 'clear', -command => sub { # reset exclude_keys @exclude_keys = (); $label_ex = ''; show_keywords($win, \@search_keys, \@exclude_keys); })->pack(-side => 'left', -padx => 3); $balloon->attach($ceb, -msg => "Clear all keywords from exclude list"); $butF3i->Label(-text => 'Excluded:', )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $butF3i->Label(-textvariable => \$label_ex, )->pack(-side => 'left', -expand => 0, -fill => 'x', -padx => 1, -pady => 1); $butF3->Label(-text => 'Right click to select a keyword, left click to exclude it')->pack(-anchor => 'w', -padx => 3); my $lib = $butF3->Checkbutton(-variable => \$config{KeywordLimit}, -text => 'Limit to 100 keywords', -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);} )->pack(-anchor => 'w', -padx => 3); $balloon->attach($lib, -msg => 'Limit to a maximum of the 100 most popular keywords.'); my $butF3j = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); my $dab = $butF3j->Checkbutton(-variable => \$config{KeywordDate}, -text => 'Limit by date between ', -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);} )->pack(-side => 'left', -anchor => 'sw', -pady => 0); $balloon->attach($dab, -msg => "Limit to a date range.\nThe first scale is the first day of the selected year\nthe second scale is the last day of the selected year.\nIf both scales show e.g. 2008 only keywords from pictures taken\nbetween 2008-01-01 and 2008-12-31 are shown.\nThe EXIF date is used for this function."); my ($first, $last) = get_date_limits(); my (undef,undef,undef,undef,undef,$start) = localtime $config{KeywordStart}; $start += 1900; my (undef,undef,undef,undef,undef,$end) = localtime $config{KeywordEnd}; $end += 1900; $butF3j->Scale(-variable => \$start, -from => $first, -to => $last, -resolution => 1, -sliderlength => 20, -orient => 'horizontal', -showvalue => 1, -width => 15, -command => sub { $end = $start if ($end < $start); $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); # after 500 msec we recalculate the keywords this gives better responsiveness $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) $config{KeywordStart} = timelocal(0,0,0,1,0,$start); $config{KeywordEnd} = timelocal(0,0,0,31,11,$end); show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate}; }); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); $butF3j->Scale(-variable => \$end, -from => $first, -to => $last, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 1, -width => 15, -command => sub { $start = $end if ($start > $end); $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); # after 500 msec we recalculate the keywords this gives better responsiveness $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) $config{KeywordStart} = timelocal(0,0,0,1,0,$start); $config{KeywordEnd} = timelocal(0,0,0,31,11,$end); show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordDate}; }); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); my $butF3k = $butF3->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); my $rab = $butF3k->Checkbutton(-variable => \$config{KeywordRating}, -text => 'Limit by rating between', -command => sub {show_keywords($win, \@search_keys, \@exclude_keys);} )->pack(-side => 'left', -anchor => 'sw', -pady => 3); $balloon->attach($rab, -msg => "Limit to a rating range.\nIf the first scale shows e.g. 2 and the second scale shows 4\nonly keywords from pictures with a rating of 2, 3 or 4 are shown.\nThe IPTC urgency is used for this function.\nNote: 1 is the highest (best) rating, 8 the lowest."); $butF3k->Scale(-variable => \$config{KeywordRatingA}, -from => 1, -to => 8, -resolution => 1, -sliderlength => 20, -orient => 'horizontal', -showvalue => 1, -width => 15, -command => sub { $config{KeywordRatingB} = $config{KeywordRatingA} if ($config{KeywordRatingB} < $config{KeywordRatingA}); $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); # after 500 msec we recalculate the keywords this gives better responsiveness $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating}; }); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); $butF3k->Scale(-variable => \$config{KeywordRatingB}, -from => 1, -to => 8, -resolution => 1, -sliderlength => 30, -orient => 'horizontal', -showvalue => 1, -width => 15, -command => sub { $config{KeywordRatingA} = $config{KeywordRatingB} if ($config{KeywordRatingA} > $config{KeywordRatingB}); $win->{LAST_RESCALE_TIMER_MH}->cancel if ($win->{LAST_RESCALE_TIMER_MH}); # after 500 msec we recalculate the keywords this gives better responsiveness $win->{LAST_RESCALE_TIMER_MH} = $win->after(500, sub { show_keywords($win, \@search_keys, \@exclude_keys) if $config{KeywordRating}; }); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 0); $cc = $win->Scrolled('Canvas', -scrollbars => 'osoe', -width => 700, -height => 400, -relief => 'sunken' )->pack(-expand => 1, -fill => 'both', -padx => 1, -pady => 1); $cc->configure(-scrollregion => [0, 0, 700, 400]); $win->{canvas} = $cc; $win->Popup(-popover => 'cursor'); show_keywords($win, \@search_keys, \@exclude_keys); # reaction for clicking on a keyword (tag) $cc->CanvasBind('' => sub { my @curr = $cc->find('withtag', 'current'); my @tags = $cc->gettags($curr[0]); foreach (@tags) { next if ($_ eq 'current'); if ($add_mode) { # add new keyword to list, if it is not already there push @search_keys, $_ unless (isInList($_, \@search_keys)); } else { # clear list and add just the new selected keyword @search_keys = (); push @search_keys, $_; } } $label = ''; $label .= "$_ " foreach (@search_keys); show_keywords($win, \@search_keys, \@exclude_keys); }); # reaction for right clicking on a keyword (tag) $cc->CanvasBind('' => sub { my @curr = $cc->find('withtag', 'current'); my @tags = $cc->gettags($curr[0]); foreach (@tags) { next if ($_ eq 'current'); push @exclude_keys, $_ unless (isInList($_, \@exclude_keys)); } $label_ex = ''; $label_ex .= "$_ " foreach (@exclude_keys); show_keywords($win, \@search_keys, \@exclude_keys); }); # wait for the close button $win->waitWindow; } ############################################################## # get_date_limits - get the first and the last year from database ############################################################## sub get_date_limits { my $first = 99999999999; my $last = 0; foreach my $dpic (keys %searchDB) { if ($searchDB{$dpic}{TIME}) { $last = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} > $last); $first = $searchDB{$dpic}{TIME} if ($searchDB{$dpic}{TIME} < $first); } } # from UNIX time to calendar years (undef,undef,undef,undef,undef,$last) = localtime $last; $last += 1900; (undef,undef,undef,undef,undef,$first) = localtime $first; $first += 1900; return ($first, $last); } ############################################################## # show_keywords - add keyword cloud to a canvas ############################################################## sub show_keywords { my $win = shift; # canvas my $search_keys = shift; # list reference for keywords which must be contained my $exclude_keys = shift; # list reference for keywords which must not be contained $win->Busy; # get the keywords according to the search keyword list ($search_keys) my ($count, %keyword_hash) = get_keywords($search_keys, $exclude_keys); my $all_keys = keys %keyword_hash; my $cc = $win->{canvas}; # clear canvas $cc->delete('all'); # limit the number of keywords to the 100 most popular keywords # todo 100 should not be a fixed value my $max_keys = 100; my $key_count = 0; if (($config{KeywordLimit}) and ((keys %keyword_hash) > $max_keys)) { my %new_hash; # sort hash by size of value (number of pictures with this keyword) foreach my $key (sort {$keyword_hash{$b} <=> $keyword_hash{$a}} keys %keyword_hash) { # copy the first 100 to a new hash $new_hash{$key} = $keyword_hash{$key}; $key_count++; last if ($key_count >= $max_keys); } # empty the original hash undef %keyword_hash; # copy the shortened hash back %keyword_hash = %new_hash; } $win->{label2} = "$count pictures (".keys(%keyword_hash)."/$all_keys keywords)"; if (keys %keyword_hash > 0) { # find max an min numbers my $min = 9999999; my $max = 0; foreach (keys %keyword_hash) { $min = $keyword_hash{$_} if ($keyword_hash{$_} < $min); $max = $keyword_hash{$_} if ($keyword_hash{$_} > $max); } # to have a nice size distribution we need the log function my $diff = 1; $diff = log($max - $min) if ($max != $min); # log(1) = 0! log(0) = -infinite #print "max $max min $min diff $diff\n"; $diff = 0.1 if ($diff == 0); # prevent division by zero # maximum and minimum font size for tag cloud my $font_min = 9; my $font_max = 20; my $font_middle = int(($font_max-$font_min)/2 + $font_min); # h and v space between tags/keywords my $x_space = 5; my $y_space = 3; my $x_max = 0; my $x = $x_space; my $y = $y_space + int($font_max/2); # sort keywords alphabetical foreach my $key (sort keys %keyword_hash) { my $size = $font_middle; # to have a nice size distribution we need the log function $size = int(log($keyword_hash{$key} - $min + 1)/$diff * ($font_max-$font_min) + $font_min) if ($max != $min); #printf "%-20s %5d %2.2f size: %2d", $key, $keyword_hash{$key}, log($keyword_hash{$key})/$diff, $size; # safety check $size = $font_max if ($size > $font_max); $size = $font_min if ($size < $font_min); #print " $size\n"; # bold style for the bigger fonts my $style = 'normal'; $style = 'bold' if ($size >= $font_middle); my $font = $top->Font(-family => $config{PropFontFamily}, -size => $size, -weight => $style); # the more often a keyword is used there brighter it is displayed my $color_percent = 100; $color_percent = int(log($keyword_hash{$key} - $min + 1)/$diff * 100) if ($max != $min); my $color = $win->Darken('blue', $color_percent); # add the keyword (tag) to the canvas my $id = $cc->createText($x, $y, -text => $key, -fill => $color, -font => $font, -anchor => 'w', -tags => [$key]); # get the needed canvas space my ($x1, $y1, $x2, $y2) = $cc->bbox($id); # calculate next coordinates $x += ($x2 - $x1) + $x_space; # todo: replace 600 by windo width if ($x > 600) { $x_max = $x if ($x > $x_max); $x = $x_space; $y += ($font_max + $y_space); } } # adjust the canvas scrollbars to the used space $cc->configure(-scrollregion => [0, 0, $x_max, ($y + int($font_max/2) + $y_space)]); } else { # adjust the canvas scrollbars to the used space $cc->configure(-scrollregion => [0, 0, 0, 0]); } $win->Unbusy; } ############################################################## # get_keywords - get all keywords from the searchDB (may be restriced by a keyword list ($search_keys)) ############################################################## sub get_keywords { my $search_keys = shift; # list reference for included keywords my $exclude_keys = shift; # list reference for excluded keywords my %keyword_hash; my $count = 0; #my $start_date = timelocal(0,0,0,1,11,2003); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) #my $end_date = timelocal(0,0,0,1,11,2004); # sec,min,hour,day,mon,year (day = 1-31 month = 0-11) # build keyword/tag hash #stopWatchStart(); # loop through all pictures in the DB foreach my $dpic (keys %searchDB) { # skip if no keywords info in picture next unless (defined $searchDB{$dpic}{KEYS}); if ($config{KeywordDate}) { next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart})); next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd})); } if ($config{KeywordRating}) { next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA})); next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB})); } # check if any items of the exclude_keys list are contained in this keyword string my $wrong = 0; foreach (@{$exclude_keys}) { $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/); last if ($wrong > 0); } next if ($wrong > 0); # check if all items of the search_keys list are contained in this keyword string $wrong = 0; foreach (@{$search_keys}) { $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/); last if ($wrong > 0); } next if ($wrong > 0); # count number of pictures matching all keywords of the search keyword list $count++; # the keywords are stored as a space separated string so we need to split up my @keys = split / /, $searchDB{$dpic}{KEYS}; foreach my $key (@keys) { # hierarchical keywords are joined by an period "." todo this may cause problems ("Mr. X, "Louis XIV.", "Dr. Miller") my @subkeys = split /\./, $key; foreach (@subkeys) { # add keyword to hash and count how often it was found if (defined $keyword_hash{$_}) { $keyword_hash{$_}++; } else { $keyword_hash{$_} = 1; } } } } #stopWatchStop('building keyword hash'); #print "done\nFound ".keys(%keyword_hash)." different keywords in $count pictures (database: ".keys(%searchDB).").\n"; #foreach (sort {$keyword_hash{$b} <=> $keyword_hash{$a}} keys %keyword_hash) { #printf "%5d %-s\n", $keyword_hash{$_}, $_; #} return ($count, %keyword_hash); } ############################################################## # search_by_location ############################################################## sub search_by_location { if (Exists($locw)) { $locw->deiconify; $locw->raise; $locw->focus; return; } my $lb = shift; # thumbnail widget e.g. $picLB # open window $locw = $top->Toplevel(); $locw->withdraw; $locw->title('Locations'); $locw->iconimage($mapiviicon) if $mapiviicon; my $locXBut = $locw->Button(-text => "Close", -command => sub { $config{LocGeometry} = $locw->geometry; $locw->destroy; })->pack(-fill => 'x'); my $rotext = $locw->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -width => 40, -height => 4, -relief => 'flat', -bd => 0 )->pack(-expand => 0, -fill => 'x', -padx => 3, -pady => 3); $rotext->insert('end', "Information:\nDouble click on any location to see pictures.\nThe location information is gathered from the IPTC tags Country, Province/State, City and SubLocation"); my $tree; my $af = $locw->Frame()->pack(-fill =>'x', -padx => 2, -pady => 1); my $add_but = $af->Button(-text => 'Add', -command => sub { my @locs = $tree->info('selection'); return unless checkSelection($locw, 1, 1, \@locs, 'location'); my @loc = split(/%/, $locs[0]); my @sellist = getSelection($lb); return unless checkSelection($locw, 1, 0, \@sellist, 'picture'); my $pics_with_location = check_locations(\@sellist); if ($pics_with_location > 0) { my $rc = $locw->messageBox(-message => "$pics_with_location of the ".scalar @sellist." selected pictures have a location info. This information will be overwritten. Please press Ok to continue.", -icon => 'question', -title => "Ovewrwrite location?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } my $location; $location .= "$_ " foreach (@loc); $userinfo = "adding ${location}to ".scalar @sellist." pictures ..."; $userInfoL->update; my $errors = ''; my $count = 0; # add location info to selected pictures foreach my $dpic (@sellist) { my $meta = getMetaData($dpic, 'APP13'); my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); if ($iptc->{error}) { #warn "IPTC segment of $file has errors!"; $errors .= "$dpic: IPTC segment has errors!\n"; } else { if (defined $loc[0] and $loc[0] ne '[empty]') { $iptc->{'Country/PrimaryLocationName'} = $loc[0]; } else { undef $iptc->{'Country/PrimaryLocationName'}; } if (defined $loc[1] and $loc[1] ne '[empty]') { $iptc->{'Province/State'} = $loc[1]; } else { undef $iptc->{'Province/State'}; } if (defined $loc[2] and $loc[2] ne '[empty]') { $iptc->{'City'} = $loc[2]; } else { undef $iptc->{'City'}; } if (defined $loc[3] and $loc[3] ne '[empty]') { $iptc->{'SubLocation'} = $loc[3]; } else { undef $iptc->{'SubLocation'}; } $meta->set_app13_data($iptc, $config{LocationMode}, 'IPTC'); if (!$meta->save()) { $errors .= "$dpic: writing of location failed!\n"; } else { updateOneRow($dpic, $lb); showImageInfoCanvas($dpic) if ($dpic eq $actpic); $count++; } } } $userinfo = "added ${location}to $count of ".scalar @sellist." pictures."; $userInfoL->update; if ($errors ne '') { $errors = "These errors occured while adding the location info to ".scalar @sellist." pictures.\n\n$errors"; showText("Errors while adding location", $errors, NO_WAIT); } })->pack(-side => 'left'); $balloon->attach($add_but, -msg => "Add selected location to all selected pictures.\nMapivi will ask before overwriting existing location information."); $af->Radiobutton(-text => 'Update', -variable => \$config{LocationMode}, -value => 'UPDATE')->pack(-side => 'left'); $af->Radiobutton(-text => 'Replace', -variable => \$config{LocationMode}, -value => 'REPLACE')->pack(-side => 'left'); $balloon->attach($af, -msg => "In Update mode non-selected location info won't be overwritten.\nIn Replace mode all four locations (Country/State/City/Sublocation)\nwill be overwritten.\nExample: If you select just a country (USA) and add this location\nto a picture with existing location (e.g. City = New York)\nIn Update mode the City information will be preserved\nwhile in Replace mode City will be deleted"); $tree = $locw->Scrolled('Tree', -separator => '%', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 25, -height => 25, )->pack(-expand => 1, -fill =>'both', -padx => 1, -pady => 1); #$locw->{tree} = $tree; bindMouseWheel($tree->Subwidget("scrolled")); #$balloon->attach($tree, -msg => "Double click on a location to see pictures from there."); # get all location info from the database (IPTC tags: country, state, city and sublocation) $top->Busy; $userinfo = "getting locations from database ..."; $userInfoL->update; my %loc_hash = get_locations(); $userinfo = "ready!"; $userInfoL->update; $top->Unbusy; $tree->bind("", sub { my @locs = $tree->info('selection'); return unless checkSelection($locw, 1, 0, \@locs); my @loc = split(/%/, $locs[0]); my @list; my $nr_of_locations = @loc; if ($nr_of_locations == 1) { foreach my $state (sort keys %{$loc_hash{$loc[0]}}) { foreach my $city (sort keys %{$loc_hash{$loc[0]}{$state}}) { foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$state}{$city}}) { push @list, sort keys %{$loc_hash{$loc[0]}{$state}{$city}{$subloc}}; } } } } elsif ($nr_of_locations == 2) { foreach my $city (sort keys %{$loc_hash{$loc[0]}{$loc[1]}}) { foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}}) { push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$city}{$subloc}}; } } } elsif ($nr_of_locations == 3) { foreach my $subloc (sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}}) { push @list, sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$subloc}}; } } elsif ($nr_of_locations == 4) { @list = sort keys %{$loc_hash{$loc[0]}{$loc[1]}{$loc[2]}{$loc[3]}}; } else { warn "Wrong number of locations: $nr_of_locations"; return; } my $title = 'Location: '; $title .= "$_ " foreach (@loc); showThumbList(\@list, $title); }); #addTreeMenu($keytree, \@prekeys); # insert the hash in the tree foreach my $country (sort keys %loc_hash) { my $pics = 0; foreach my $state (sort keys %{$loc_hash{$country}}) { foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; } } } $tree->add($country, -text => "$country [$pics]"); foreach my $state (sort keys %{$loc_hash{$country}}) { my $pics = 0; foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; } } $tree->add("$country%$state", -text => "$state [$pics]"); foreach my $city (sort keys %{$loc_hash{$country}{$state}}) { my $pics = 0; foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { $pics += keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; } $tree->add("$country%$state%$city", -text => "$city [$pics]"); foreach my $subloc (sort keys %{$loc_hash{$country}{$state}{$city}}) { my $pics = keys %{$loc_hash{$country}{$state}{$city}{$subloc}}; $tree->add("$country%$state%$city%$subloc", -text => "$subloc [$pics]"); } } } } # add plus/minus buttons to colapse tree $tree->autosetmode; # close tree for the first 4 levels foreach ($tree->info('children')) { $tree->close($_); foreach ($tree->info('children', $_)) { $tree->close($_); foreach ($tree->info('children', $_)) { $tree->close($_); foreach ($tree->info('children', $_)) { $tree->close($_); } } } } $locw->bind('', sub { $locXBut->invoke; }); $locw->bind('', sub { $locXBut->invoke; }); # invoke $but when the window is closed by the window manager (x-button) $locw->protocol("WM_DELETE_WINDOW" => sub { $locXBut->invoke; }); $locw->Popup; checkGeometry(\$config{LocGeometry}); $locw->geometry($config{LocGeometry}); $locw->waitWindow; } ############################################################## # get_locations - get all locations from the searchDB as hash ############################################################## sub get_locations { my %location_hash; # build location hash # loop through all pictures in the DB foreach my $dpic (keys %searchDB) { my $country = '[empty]'; my $state = '[empty]'; my $city = '[empty]'; my $subloc = '[empty]'; if (defined $searchDB{$dpic}{IPTC}) { my $iptc = $searchDB{$dpic}{IPTC}; if ($iptc =~ m|Country\.: (.*)\n|) { $country = $1; } if ($iptc =~ m|Provinc\.: (.*)\n|) { $state = $1; } if ($iptc =~ m|City\s*: (.*)\n|) { $city = $1; } if ($iptc =~ m|SubLoca\.: (.*)\n|) { $subloc = $1; } } $location_hash{$country}{$state}{$city}{$subloc}{$dpic}++; } return %location_hash; } ############################################################## # check_locations - check if the given list of pictures has any location info # returns the number of pictures with locations ############################################################## sub check_locations { my $pic_list = shift; # list reference my $count = 0; # loop through all pictures of the list foreach my $dpic (@$pic_list) { if (defined $searchDB{$dpic}{IPTC}) { my $iptc = $searchDB{$dpic}{IPTC}; if (($iptc =~ m|Country\.:.*\n|) or ($iptc =~ m|Provinc\.:.*\n|) or ($iptc =~ m|City\s*:.*\n|) or ($iptc =~ m|SubLoca\.:.*\n|)) { $count++; } } } return $count; } ############################################################## # get_pics_with_keywords - returns a list of pictures with the # given keywords (source: searchDB) ############################################################## sub get_pics_with_keywords { my $search_keys = shift; # list reference my $exclude_keys = shift; # list reference for keywords which must not be contained my @pic_list; # build keyword/tag hash #stopWatchStart(); foreach my $dpic (keys %searchDB) { # skip if no keywords in picture next unless (defined $searchDB{$dpic}{KEYS}); if ($config{KeywordDate}) { next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} < $config{KeywordStart})); next if (defined $searchDB{$dpic}{TIME} and ($searchDB{$dpic}{TIME} > $config{KeywordEnd})); } if ($config{KeywordRating}) { next unless (defined $searchDB{$dpic}{URG}); # ignore pictures withour rating/urgency next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} < $config{KeywordRatingA})); next if (defined $searchDB{$dpic}{URG} and ($searchDB{$dpic}{URG} > $config{KeywordRatingB})); } # check if any items of the exclude_keys list are contained in this keyword string my $wrong = 0; foreach (@{$exclude_keys}) { $wrong++ if ($searchDB{$dpic}{KEYS} =~ m/$_/); last if ($wrong > 0); } next if ($wrong > 0); # check if all items of the search_keys list are contained in this keyword string $wrong = 0; foreach (@{$search_keys}) { $wrong++ unless ($searchDB{$dpic}{KEYS} =~ m/$_/); last if ($wrong > 0); } next if ($wrong > 0); # collect matching pics in a list push @pic_list, $dpic; } #stopWatchStop('collecting pics'); #print "done\nFound ".scalar @pic_list." pictures\n"; return @pic_list; } ############################################################## # editDatabase ############################################################## sub editDatabase { my $buttext = "Remove picture(s) from database"; my $text = "This list shows all pictures of the search database.\nYou may select any number of pictures and remove them with the \"$buttext\" button.\nThe pictures won't be deleted, only the entry in the database is removed.\nIt's recommended to call the function \"clean database\" first, because it will remove all invalid entries for you."; my $rc; # open window my $ew = $top->Toplevel(); $ew->title("Edit search database"); $ew->iconimage($mapiviicon) if $mapiviicon; my $height = ($text =~ tr/\n//); $height += 2; $height = 10 if ($height > 10); # not to big, we have scrollbars my $rotext = $ew->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 110, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-expand => "0", -padx => 3, -pady => 3,-anchor => 'w'); $rotext->insert('end', $text); my $size = getFileSize("$configdir/SearchDataBase", FORMAT); my $keys = keys %searchDB; my ($first, $last) = get_date_limits(); my $info = "$keys pictures in the database between the years $first and $last (file size: $size)"; my $listBoxY = $keys; $listBoxY = 25 if ($listBoxY > 25); # not higher than 30 entries my $listBox = $ew->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, #-width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3); bindMouseWheel($listBox); $listBox->insert('end', (sort keys %searchDB)); my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3); $labF->Label(-textvariable => \$info, -bg => $config{ColorBG})->pack(-side => "left"); $ew->Button(-text => $buttext, -command => sub { foreach (reverse $listBox->curselection()) { my $path = $listBox->get($_); delete $searchDB{$path}; # delete key from hash $listBox->delete($_); } $keys = keys %searchDB; # display the ne wnumber of database entries $info = "$keys entries in the database"; } )->pack(-anchor => 'w', -padx => 3, -pady => 3); my $filter; my $ef = $ew->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3); $ef->Label(-text => "Show only keys matching:", -anchor => 'w', -bg => $config{ColorBG}, )->pack(-side => "left", -padx => 3); my $entry = $ef->Entry(-textvariable => \$filter, -width => 20, )->pack(-fill => 'x', -padx => 3, -pady => 3); $entry->bind('', sub { return if (!defined $filter); $listBox->delete(0, 'end'); $keys = keys %searchDB; # display the ne wnumber of database entries if ($filter eq "") { $listBox->insert('end', (sort keys %searchDB)); $info = "$keys entries in the database (all visible)"; } else { my $count = 0; $filter = makePattern($filter); # create a windows like pattern foreach (sort keys %searchDB) { if ($_ =~ m!$filter!i) { $listBox->insert('end', $_); $count++; } } $info = "$keys entries in the database ($count visible)"; } } ); my $ButF = $ew->Frame()->pack(-fill =>'x'); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $rc = 'OK'; } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); $OKB->focus; $ew->Popup(-popover => 'cursor'); repositionWindow($ew); $ew->waitVariable(\$rc); $ew->withdraw; $ew->destroy; } ############################################################## # checkDatabase - check the comment and iptc fields of all # database entries for problematic (non-ASCII) chars # will e.g. complain about the copyright sign ############################################################## sub checkDatabase { my ($com, $iptc, $keys, $text); my $i = 0; foreach my $dpic (sort keys %searchDB) { $i++; $com = $searchDB{$dpic}{COM}; $iptc = $searchDB{$dpic}{IPTC}; $keys = $searchDB{$dpic}{KEYS}; if ((defined $com) and ($com =~ m/[^\x00-\x7f]/)) { $text .= "comment of $dpic\n"; } if ((defined $iptc) and ($iptc =~ m/[^\x00-\x7f]/)) { $text .= "IPTC of $dpic\n"; } if ((defined $keys) and ($keys =~ m/[^\x00-\x7f]/)) { $text .= "IPTC keyword of $dpic\n"; } } $text = "Check finished.\nFound these problematic (non-ASCII) chars in $i pictures:\n\n$text"; showText("Check database", $text, WAIT); } ############################################################## # searchDupName - search duplicate pics in the database by # same file name ############################################################## sub searchDupsName { my %pics; # hash of all file names key: file name or size value: directory+pic my $dpics = shift; # ref to hash of all file names key: file name value: list of dirs+pic containing this pic my $ignore_links = shift; my $filter = shift; my $ignore_filter = shift; undef %$dpics; #$userinfo = "searching duplicates by file name ..."; $userInfoL->update; # loop through all database entries foreach my $dpic (sort keys %searchDB) { next if (($filter ne '') and ($dpic !~ m!$filter!i)); next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i)); next if ($ignore_links and -l $dpic); my $pic = basename($dpic); # new entry if (!defined $pics{$pic}) { $pics{$pic} = $dpic; } # duplicate found else { # if not defined in the dups hash, add first dir (was saved before) if (!defined $$dpics{$pic}) { $$dpics{$pic} = [$pics{$pic}]; } # and add the actual dir and pic push @{$$dpics{$pic}}, $dpic; } } } ############################################################## # searchDupSize - search duplicate pics in the database by # same file size ############################################################## sub searchDupsSize { my %pics; # hash of all file names key: file name or size value: directory+pic my $dpics = shift; # ref to hash of all file names key: file size value: list of dirs+pic containing this pic my $ignore_links = shift; my $filter = shift; my $ignore_filter = shift; undef %$dpics; #$userinfo = "searching duplicates by file size ..."; $userInfoL->update; # loop through all database entries foreach my $dpic (sort keys %searchDB) { next if (($filter ne '') and ($dpic !~ m!$filter!i)); next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i)); next if ($ignore_links and -l $dpic); next if (!defined $searchDB{$dpic}{SIZE}); my $size = $searchDB{$dpic}{SIZE}; # size in Bytes # new entry if (!defined $pics{$size}) { $pics{$size} = $dpic; } # duplicate found else { # if not defined in the dups hash, add first dir (was saved before) if (!defined $$dpics{$size}) { $$dpics{$size} = [$pics{$size}]; } # and add the actual dir and pic push @{$$dpics{$size}}, $dpic; } } } ############################################################## # searchDupDate - search duplicate pics in the database by # same EXIF creation date ############################################################## sub searchDupsDate { my %pics; # hash of all file names key: file name or date value: directory+pic my $dpics = shift; # ref to hash of all file names key: file date value: list of dirs+pic containing this pic my $ignore_links = shift; my $filter = shift; my $ignore_filter = shift; undef %$dpics; #$userinfo = "searching duplicates by file size ..."; $userInfoL->update; # loop through all database entries foreach my $dpic (sort keys %searchDB) { next if (($filter ne '') and ($dpic !~ m!$filter!i)); next if (($ignore_filter ne '') and ($dpic =~ m!$ignore_filter!i)); next if ($ignore_links and -l $dpic); #next if (-l $dpic); unless (defined $searchDB{$dpic}{TIME}) { print "$dpic has no EXIF date/time!\n"; next; } my $date = $searchDB{$dpic}{TIME}; # EXIF creation date/time # new entry if (!defined $pics{$date}) { $pics{$date} = $dpic; } # duplicate found else { # if not defined in the dups hash, add first dir (was saved before) if (!defined $$dpics{$date}) { $$dpics{$date} = [$pics{$date}]; } # and add the actual dir and pic push @{$$dpics{$date}}, $dpic; } } } ############################################################## # findDups - find duplicate pics in the database ############################################################## sub findDups { if (Exists($dupw)) { $dupw->deiconify; $dupw->raise; $dupw->focus; return; } my %dup_thumbs; # hash to store all thumbnails displayed in the duplicate window my $pic; my $dir; my %dpics; # hash of all file names key: file name or size value: list of dirs+pic containing this pic my $searchForDups = "Name"; my $ignore_links = 0; my $filter = ''; my $ignore_filter = ''; # open window $dupw = $top->Toplevel(); $dupw->title("Duplicate pictures"); $dupw->iconimage($mapiviicon) if $mapiviicon; my $subF = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); my $subF2 = $dupw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); my $dbsize = getFileSize("$configdir/SearchDataBase", FORMAT); my $progress = 0; my $progBar = $subF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -length => 100, -padx => 0, -pady => 0, -variable => \$progress, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => 10, -anchor => 'w', -from => 0, -to => 100, )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 2, -pady => 0); my $stop = 0; my $stopB = $subF->Button(-text => "Stop", -command => sub { $stop = 1; } )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; $stopB->configure(-state => "disabled"); my $label = ""; $subF->Label(-textvariable => \$label, -justify => "left",-bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 2); my $filter_entry = labeledEntry($subF2, 'left', 7, "Include", \$filter, 15); $balloon->attach($filter_entry, -msg => "Enter a part of the file or path name to filter for.\nExample: If you enter \"photos/2008\" only duplicates\nfrom the folder ...photos/2008... will be shown."); my $ignore_filter_entry = labeledEntry($subF2, 'left', 6, "Ignore", \$ignore_filter, 15); $balloon->attach($ignore_filter_entry, -msg => "Enter a part of the file or path name to ignore.\nExample: If you enter \"photos/2008\" no duplicates\nfrom the folder ...photos/2008... will be shown."); my $duplb = makeThumbListbox($dupw); $subF->Button(-text => "Search", -command => sub { $stop = 0; # clean up $duplb->delete("all"); $label = 'cleaning up ...'; $duplb->update; # clean up memory - delete all found thumbnail photo objects delete_thumb_objects(\%dup_thumbs); $label = 'searching duplicates in database ...'; $duplb->update; my $filterP = makePattern($filter); # create a windows like pattern my $ignore_filterP = makePattern($ignore_filter); # create a windows like pattern if ($searchForDups eq 'Name') { searchDupsName(\%dpics, $ignore_links, $filterP, $ignore_filterP); } elsif ($searchForDups eq 'Size') { searchDupsSize(\%dpics, $ignore_links, $filterP, $ignore_filterP); } elsif ($searchForDups eq 'Date') { searchDupsDate(\%dpics, $ignore_links, $filterP, $ignore_filterP); } elsif ($searchForDups eq 'Cancel') { return; } else { warn "wrong searchForDups: $searchForDups\n"; return; } my $keys = keys %dpics; $label = " $keys duplicates are found in the database (file size: $dbsize)."; my $last_time; my $pcount = 0; # pic count = keys %dpics my $dcount = 0; # dir count (if each pic has one duplicate this number is $pcount * 2) my $style1 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray90'); my $style2 = $duplb->ItemStyle('text', -anchor=>'nw', -foreground=>'black', -background=>'gray80'); # save global styles to restore them later my $comS_save = $comS; my $exifS_save = $exifS; my $iptcS_save = $iptcS; my $fileS_save = $fileS; my $dirS_save = $dirS; $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); $stopB->configure(-state => 'normal'); # insert duplicates in hlist foreach my $item (sort keys %dpics) { last if $stop; $pcount++; foreach my $dpic (@{$dpics{$item}}) { last if $stop; #$dir =~ s!^([a-z]:)/!$1\\!i if $EvilOS; # replace E:/ with E:\ else Win will fire an error message that E: is not mounted insertPic($duplb, $dpic, \%dup_thumbs); $dcount++; # show progress and found pics every 0.3 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.3) { $progress = int($pcount/$keys*100); $label = " displaying duplicates $progress% ($pcount/$keys)"; $duplb->update(); $last_time = Tk::timeofday(); } } # toggle style of name col if ($fileS == $style2) { $_ = $style1 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); } else { $_ = $style2 foreach ($fileS, $exifS, $iptcS, $comS, $dirS); }; } # reset gloabal style $fileS = $fileS_save; $exifS = $exifS_save; $iptcS = $iptcS_save; $comS = $comS_save; $dirS = $dirS_save; $progress = 100 if ($pcount >= $keys); # sometimes there is a little gap $stopB->configure(-state => "disabled"); $label = " found $pcount duplicates in $dcount files."; $duplb->update(); })->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1); $subF->Label(-text => "duplicates by same ", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -fill => "both"); $subF->Optionmenu(-variable => \$searchForDups, -textvariable => \$searchForDups, -options => [ ['file name' => 'Name'], ['creation date' => 'Date'], ['file size' => 'Size'], ])->pack(-side => "left", -anchor => 'w', -fill => "both"); $subF->Checkbutton(-text => 'ignore links', -variable => \$ignore_links)->pack(-side => "left", -anchor => 'w', -fill => "both", -padx => 1,-pady => 1); my $Xbut = $subF->Button(-text => "Close", -command => sub { $dupw->withdraw(); $dupw->destroy(); # clean up memory - delete all found thumbnail photo objects delete_thumb_objects(\%dup_thumbs); } )->pack(-side => "left", -anchor => 'w', -fill => "both", -expand => 1, -padx => 1,-pady => 1); # the context menu my $menu = $dupw->Menu(-title => "Duplicate pictures menu"); ############# open pic $menu->command(-label => "open picture in new window", -accelerator => "Middle Mouse Button", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); my @sellist = $duplb->info('selection'); if (@sellist != 1) { $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!", -title => "Wrong selection", -type => 'OK'); return; } my $dpic = $sellist[0]; my $dir = dirname($dpic); if (!-d $dir) { $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => "folder not found", -type => 'OK'); return; } $dupw->Busy; showPicInOwnWin($dpic); $dupw->Unbusy; }); ############# open dir $menu->command(-label => "open folder and show picture", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); my @sellist = $duplb->info('selection'); if (@sellist != 1) { $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!", -title => "Wrong selection", -type => 'OK'); return; } my $dpic = $sellist[0]; my $dir = dirname($dpic); if (!-d $dir) { $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => "folder not found", -type => 'OK'); return; } $top->deiconify; $top->raise; $top->focus; openDirPost($dir) if ($dir ne $actdir); showPic($dpic); }); ############# ignore dir $menu->command(-label => "ignore folder ...", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); my @sellist = $duplb->info('selection'); if (@sellist != 1) { $dupw->messageBox(-icon => 'warning', -message => "Please select exactly one picture!", -title => "Wrong selection", -type => 'OK'); return; } my $ignoredir = dirname($sellist[0]); my $rc = myEntryDialog("Ignore folder", "Ignore all folders matching this pattern:", \$ignoredir); return if ($rc ne 'OK' or $ignoredir eq ""); my $count = 0; foreach my $i (@pics) { next unless ($duplb->info("exists", $i)); my $dir = dirname($i); if ($dir =~ m!$ignoredir!) { $count++; $label = "removing $dir ($count) ..."; #print "$dir remove $i $ignoredir\n"; $duplb->delete("entry", $i); } } $label = "removed $count folders."; }); ############# select all $menu->command(-label => "selected all", -command => sub { my @pics = $duplb->info('children'); return unless (@pics); $duplb->selectionSet($pics[0], $pics[-1]); # 'end' does not work with HList } ); $menu->separator; ############# delete to trash $menu->command(-label => "delete picture to trash", -command => sub { deletePics($duplb, TRASH); $label = "pictures deleted"; } ); ############# copy $menu->command(-label => "copy selected pictures ...", -command => sub { copyPicsDialog(COPY, $duplb); $label = "ready! (pictures copied)"; $dupw->update; } ); ############# move $menu->command(-label => "move selected pictures ...", -command => sub { movePicsDialog($duplb); $label = "ready! (pictures moved)"; $dupw->update; } ); # mouse and button bindings addCommonKeyBindings($duplb, $duplb); $duplb->bind('', sub { $menu->Popup(-popover => "cursor", -popanchor => "nw"); } ); $duplb->bind('', sub { return unless ($duplb->info('children')); my $dpic = getNearestItem($duplb); my $dir = dirname($dpic); if (!-d $dir) { $dupw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => "folder not found", -type => 'OK'); return; } $dupw->Busy; showPicInOwnWin($dpic); $dupw->Unbusy; } ); $dupw->bind('', sub { $Xbut->invoke; }); $dupw->bind('', sub { $Xbut->invoke; }); my $w = int(0.8 * $dupw->screenwidth); my $h = int(0.8 * $dupw->screenheight); $dupw->geometry("${w}x${h}+10+10"); $duplb->update(); $dupw->waitWindow; } ############################################################## # editHashDialog - let the user add or remove keys from a hash ############################################################## sub editHashDialog { my $title = shift; my $text = shift; my $hr = shift; # hash reference my $okB = shift; # Ok button text my $cancelB = shift; # Cancel button text ("" means no Cancel button) my $addB = shift; # bool - show a path entry and a Add Path button my $entry = ""; my $rc; # open window my $ew = $top->Toplevel(); $ew->title($title); $ew->iconimage($mapiviicon) if $mapiviicon; my $height = ($text =~ tr/\n//); $height += 2; $height = 10 if ($height > 10); # not to big, we have scrollbars my $rotext = $ew->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -tabs => '4', -width => 80, -height => $height, -relief => "flat", -bg => $config{ColorBG}, -bd => "0" )->pack(-expand => "0", -padx => 3, -pady => 3); $rotext->insert('end', $text); my $keys = keys %{$hr}; my $listBoxY = $keys; $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries my $listBox = $ew->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both', -padx => 3, -pady => 3); $listBox->insert('end', (sort keys %{$hr})); my $labF = $ew->Frame()->pack(-anchor => 'w', -padx => 3, -pady => 3); $labF->Label(-textvariable => \$keys, -bg => $config{ColorBG})->pack(-side => "left"); $labF->Label(-text => " entries", -bg => $config{ColorBG})->pack(-side => "left"); $ew->Button(-text => "Remove marked", -command => sub { foreach (reverse $listBox->curselection()) { my $path = $listBox->get($_); delete $$hr{$path}; # delete key from hash $listBox->delete($_); } # refresh listbox #$listBox->delete(0, 'end'); #$listBox->insert('end', (sort keys %{$hr})); $keys = keys %{$hr}; # display the ne wnumber of database entries } )->pack(-anchor => 'w', -padx => 3, -pady => 3); if ($addB) { my $entryF = $ew->Frame()->pack(-fill =>'x'); $entryF->Entry(-textvariable => \$entry, -width => 40)->pack(-side => "left", -fill => 'x', -padx => 3, -pady => 3); $entryF->Button(-text => "Add path", -command => sub { $$hr{"$entry"} = 1; $listBox->delete(0, 'end'); $listBox->insert('end', (sort keys %{$hr})); })->pack(-side => 'left', -padx => 3, -pady => 3); } my $ButF = $ew->Frame()->pack(-fill =>'x'); my $OKB = $ButF->Button(-text => $okB, -command => sub { $rc = 'OK', })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $OKB->bind('', sub { $OKB->invoke; } ); if ($cancelB ne "") { $ButF->Button(-text => $cancelB, -command => sub { $rc = 'Cancel'; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); } $OKB->focus; $ew->Popup(-popover => 'cursor'); repositionWindow($ew); $ew->waitVariable(\$rc); $ew->withdraw; $ew->destroy; return $rc; } ############################################################## # checkDateFormat - check if date string matches dd.mm.yyyy # and day is between 1..31 and month 1..12 ############################################################## sub checkDateFormat($) { my $date = shift; my $rc = 0; if ($date =~ /^(\d\d)\.(\d\d)\.(\d\d\d\d)$/) { # check format if ($1 >= 1 and $1 <= 31) { # check day range if ($2 >= 1 and $2 <= 12) { # check month range if ($3 >= 1901 and $3 <= 2038) { # check year range, 1901 and 2038 are save boundaries for 32 bit systems # check for valid dates (e.g. 31.02.2000 is invalid) eval { timelocal(0, 0, 0, $1, $2-1, $3-1900); }; $rc = 1 unless ($@); } } } } return $rc; } ############################################################## # checkNumberFormat - check if the argument is a number ############################################################## sub checkNumberFormat($) { my $nr = shift; my $rc = 0; if ($nr =~ /^\d+$/) { # check format if ($nr >= 0 and $nr <= 99999) { # check range $rc = 1; } } return $rc; } ############################################################## # buildUnixTime - dd.mm.yyyy to UNIX date/time ############################################################## sub buildUnixTime { my $date_str = shift; my $time; if ($date_str =~ m/(\d\d)\.(\d\d)\.(\d\d\d\d)/) { my $mon = $2; my $year = $3; $mon--; $year -= 1900; # check for valid dates (e.g. 31.02.2000 is invalid) eval { timelocal(0, 0, 0, $1, $mon, $year); }; if ($@) { warn "buildUnixTime: $date_str is invalid, date does not exists.\n"; $time = 0; } else { # valid $time = timelocal(0, 0, 0, $1, $mon, $year); } } else { warn "buildUnixTime: wrong string format $date_str, should be dd.mm.yyyy\n"; $time = 0; } return $time; } ############################################################## # buildDateTime - UNIX date/time to dd.mm.yyyy hh:mm:ss ############################################################## sub buildDateTime { my $ctime = shift; my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; $y += 1900; $mo++; # do some adjustments # build up the date time string, similar to the EXIF format return sprintf "%02d.%02d.%04d %02d:%02d:%02d", $d, $mo, $y, $h, $m, $s; } ############################################################## # buildEXIFDateTime - UNIX date/time to yyyy:mm:dd hh:mm:ss ############################################################## sub buildEXIFDateTime { my $ctime = shift; my ($s,$m,$h,$d,$mo,$y) = localtime $ctime; $y += 1900; $mo++; # do some adjustments # build up the date time string, similar to the EXIF format return sprintf "%04d:%02d:%02d %02d:%02d:%02d", $y, $mo, $d, $h, $m, $s; } ############################################################## # searchFileName ############################################################## sub searchFileName { my $lb = shift; my @sellist = $lb->info('selection'); return unless checkSelection($lb, 1, 1, \@sellist); my $fileName = basename($sellist[0]); #resetAllSearchOptions(); # todo: write this sub $config{SearchPattern} = $fileName; $config{SearchName} = 1; searchMetaInfo(); } ############################################################## # searchMetaInfo ############################################################## sub searchMetaInfo { use bytes; use locale; if (Exists($sw)) { $sw->deiconify; $sw->raise; $sw->focus; $sw->{entry}->focus; $sw->{entry}->selectionRange(0,'end'); # select all return; } my $start_dir = getRightDir(); my $pattern = $config{SearchPattern}; my $exclude = $config{SearchExPattern}; my $pat = ""; my $exl = ""; my $OKB; my $keys = keys %searchDB; my $size = getFileSize("$configdir/SearchDataBase", FORMAT); my $stop = 0; my $stopB; if (!$config{SaveDatabase}) { my $rc = $top->messageBox(-message => "The save database to file option is off. The search will only cover the folders visited during this session.\nShould I switch the save option on?\nYou can change this option also in the options dialog.", -icon => 'question', -title => "Switch save option", -type => 'OKCancel'); $config{SaveDatabase} = 1 if ($rc =~ m/Ok/i); } # open window $sw = $top->Toplevel(); $sw->withdraw; $sw->title("Search picture database"); $sw->iconimage($mapiviicon) if $mapiviicon; #$sw->Label(-text => "Search in the picture database for a pattern:", -justify => "left",-bg => $config{ColorBG})->pack(-anchor => 'w'); my $topF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); my $leftF = $topF->Frame()->pack(-fill => 'x', -side => 'left', -padx => 3, -pady => 3); my $pf1 = $leftF->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3); $pf1->Label(-text => "Search pattern", -width => 15, -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3); $sw->{entry} = $pf1->Entry(-textvariable => \$pattern, -width => 25)->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1); my $pf2 = $leftF->Frame()->pack(-fill => 'x', -padx => 3, -pady => 3); $pf2->Label(-text => "Exclude pattern", -width => 15, -anchor => 'w', -bg => $config{ColorBG})->pack(-side => "left", -padx => 3); my $exentry = $pf2->Entry(-textvariable => \$exclude, -width => 25)->pack(-side => "left", -fill => 'x', -expand => "1", -padx => 1); #$pf2->Button(-text => "clear", -command => sub {$exclude = "";})->pack(-side => "left", -padx => 3, -pady => 0); $balloon->attach($sw->{entry}, -msg => 'Use * for zero or more chars, ? for exactly one char. Use \* to search for the star sign (*) and \? to search for a questionmark (?) itself. To search for a backslash (\) use two backslashes (\\\). Examples: "I * home" will match e.g. "I go home", "I run home" but also "I do not go home" "Tr?ck" will match "Trick" or "Track" "who\?" will match "who?" "\*\* Party \*\*" will match "** Party **"'); $balloon->attach($exentry, -msg => 'Enter the patterns to exclude here. Separate them with one space. All patterns will be joined by or. Hint: Use an empty search pattern and the exlude pattern "?*" to search for pictures without comments, EXIF or IPTC infos.'); $sw->{entry}->bind('', sub { $OKB->invoke; } ); $exentry->bind('', sub { $OKB->invoke; } ); $sw->{entry}->focus; $sw->{entry}->selectionRange(0,'end'); # select all # what to search: keywords, IPTC, comments, ... my $f1 = $topF->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 5); # different search options my $f0 = $leftF->Frame()->pack(-anchor => 'w', -padx => 0,-pady => 0); # local search + more options my $locSF = $leftF->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 5); $locSF->Checkbutton(-variable => \$config{SearchOnlyInDir}, -text => "local search in")->pack(-side => 'left', -anchor => 'w', -padx => 4, -padx => 2); $locSF->Label(-textvariable => \$start_dir)->pack(-side => 'left', -anchor => 'w', -padx => 4, -padx => 2); setFileButton($locSF,'left','Set','Select folder to search in',\$start_dir, 1); $balloon->attach($locSF, -msg => 'When this option is enabled, the search will only take place in folders matching the displayed string. When the option is disabled a global search will take place.'); my ($addMF, $addF); $locSF->Checkbutton(-variable => \$config{SearchMore}, -text => 'more options', -command => sub { if ($config{SearchMore}) { $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF)); } else { $addF->packForget();# if (ismapped($addF)); } })->pack(-side => 'right', -padx => 5); my $ButF = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -expand => 1, -fill =>'both',-padx => 3,-pady => 0); $balloon->attach($f1, -msg => "Search in JPEG comments, EXIF info,\nIPTC info, IPTC keywords, file name and/or in folder name"); my $f2 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0); my $f3 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0); my $f4 = $f0->Frame(-relief => 'groove', -bd => $config{Borderwidth})->pack(-side => "left", -anchor => "n", -fill =>'both',-padx => 3,-pady => 0); $f1->Checkbutton(-variable => \$config{SearchKeys}, -text => "Keywords")->pack(-anchor => 'w'); $f1->Checkbutton(-variable => \$config{SearchIptc}, -text => "IPTC info")->pack(-anchor => 'w'); $f1->Checkbutton(-variable => \$config{SearchCom}, -text => "comments")->pack(-anchor => 'w'); $f1->Checkbutton(-variable => \$config{SearchExif}, -text => "EXIF info")->pack(-anchor => 'w'); $f1->Checkbutton(-variable => \$config{SearchName}, -text => "file name")->pack(-anchor => 'w'); $f1->Checkbutton(-variable => \$config{SearchDir}, -text => "folder name")->pack(-anchor => 'w'); my $sep = $f1->Checkbutton(-variable => \$config{SearchJoin}, -text => "join fields")->pack(-anchor => "nw"); $balloon->attach($sep, -msg => "If this option is selected all selected fields (keywords, IPTC, comments, ...) of a picture will be joined before the search starts, so it's e.g. possible to find a picture with keyword \"Tom\" and the comment \"at the beach\". If it is not selected, a all-search for \"Tom\" and \"Tim\" will only match, if all patterns are in one field (e.g. Tom and Tim are both in the keywords)."); my $sc1 = $f2->Checkbutton(-variable => \$config{SearchCase}, -text => "case sensitive")->pack(-anchor => "nw"); $balloon->attach($sc1, -msg => "Toggle between case sensitive/insensitive searching"); my $sw1 = $f2->Checkbutton(-variable => \$config{SearchWord}, -text => "complete word")->pack(-anchor => "nw"); $balloon->attach($sw1, -msg => "search only for complete words, not for parts"); my $stf = $f2->Frame()->pack(-anchor => 'w'); $stf->Label(-text => "match", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w'); my $st1 = $stf->Optionmenu(-variable => \$config{SearchType}, -textvariable => \$config{SearchType}, -options => [qw(exactly all any)] )->pack(-side => "left", -anchor => 'w'); $balloon->attach($st1, -msg => 'Match search pattern exactly, match all words or try to match any of the given words. e.g. "Tim Tom" with search type match exactly will find all pictures containing exactly this string (string-search) match all will find this but also "Tom Tim" or "Tim and Tom" (and-search) match any will find all pictures containing "Tim" or "Tom" or both (or-search)'); my $urgF = $f3->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0); $urgF->Checkbutton(-variable => \$config{SearchUrgencyOn}, -text => 'urgency')->pack(-side => 'left', -anchor => 'w'); $urgF->Optionmenu(-variable => \$config{SearchUrgencyRel}, -textvariable => \$config{SearchUrgencyRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w'); # 0 must be first, because it's the default my $dummy; $urgF->Optionmenu(-variable => \$config{SearchUrgency}, -options => [ ["0 None" => 0], ["1 High" => 1], 2,3,4,["5 Normal" => 5],6,7, ["8 Low" => 8], ], -textvariable => \$dummy)->pack(-side => 'left', -anchor => 'w'); # todo search for empty urgency tags: , [Empty => ""] $balloon->attach($urgF, -msg => "Search only for pictures with this IPTC urgency.\nYou can use the urgency flag to set the priority\nof the picture (1 = high to 8 = low)."); #$f3->Checkbutton(-variable => \$config{SearchUrgencyIg}, -text => "ignore pictures without urgency")->pack(-anchor => 'nw'); my $popF = $f3->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0); $popF->Checkbutton(-variable => \$config{SearchPopOn}, -text => 'viewed ')->pack(-side => 'left', -anchor => 'w'); $popF->Optionmenu(-variable => \$config{SearchPopRel}, -textvariable => \$config{SearchPopRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w'); my $popE = $popF->Entry(-textvariable => \$config{SearchPop}, -width => 10, -validate => 'focus', -validatecommand => sub { checkNumberFormat($_[0]); }, -invalidcommand => sub {$config{SearchPop} = 5; $sw->messageBox(-icon => 'warning', -message => 'Please enter a natural number (0,1,2,3,...) in the viewed field', -title => 'Wrong format', -type => 'OK');})->pack(-side => 'left', -fill => 'x', -expand => 1, -padx => 1); $balloon->attach($popF, -msg => "Search only for pictures with have been viewed\nthis numer of times."); my $justCount = 0; my $countOp = $f3->Checkbutton(-variable => \$justCount, -text => 'just count pictures')->pack(-anchor => 'nw'); $balloon->attach($countOp, -msg => "Just count the matching pictures, do not display them.\nWith this option the search is much faster."); $f4->Checkbutton(-variable => \$config{SearchDate}, -text => 'search by EXIF date', -width => 19, -anchor => 'w')->pack(-anchor => 'w'); my $datetext = 'Please use date format: dd.mm.yyyy and check if you entered a valid date. dd (day) is between 01 and 31 mm (month) is between 01 and 12 yyyy (year) is between 1901 and 2038 Example 25.02.2008'; my $fromF = $f4->Frame()->pack(-anchor => 'w'); $fromF->Button(-text => 'from', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => 'left', -anchor => 'w', -padx => 3); my $fromdate = $fromF->Entry( -textvariable => \$config{SearchDateStart}, -width => 11, -validate => 'focus', -validatecommand => sub { checkDateFormat($_[0]); }, -invalidcommand => sub { $config{SearchDateStart} = "01.01.2004"; $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK'); } )->pack(-side => 'left', -padx => 3); my $toF = $f4->Frame()->pack(-anchor => 'w'); $toF->Button(-text => 'to', -anchor => 'w', -width => 4, -command => sub { setFromTo(); } )->pack(-side => 'left', -anchor => 'w', -padx => 3); my $todate = $toF->Entry( -textvariable => \$config{SearchDateEnd}, -width => 11, -validate => 'focus', -validatecommand => sub { checkDateFormat($_[0]); }, -invalidcommand => sub { $config{SearchDateEnd} = "01.01.2009"; $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong date format', -type => 'OK'); } )->pack(-side => 'left', -padx => 3); $balloon->attach($fromdate, -msg => "Search only for pictures with a creation date\nwith or after this date.\nFormat: dd.mm.yyyy (example: 21.12.2001)"); $balloon->attach($todate, -msg => "Search only for pictures with a creation date\nbefore or with this date.\nFormat: dd.mm.yyyy (example: 31.01.2008)"); $addMF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 0, -padx => 3); # this empty frame is needed, else the frame won't shrink after removing the other content my $empty_frame = $addMF->Frame()->pack(); $addF = $addMF->Frame(); # pixel size my $pixF = $addF->Frame()->pack(-anchor=>'w', -padx => 0, -pady => 0); $pixF->Checkbutton(-variable => \$config{SearchPixelOn}, -text => 'pixel size')->pack(-side => 'left', -anchor => 'w'); $pixF->Optionmenu(-variable => \$config{SearchPixelRel}, -textvariable => \$config{SearchPixelRel}, -options => [ qw(= <= >=) ] )->pack(-side => 'left', -anchor => 'w'); $pixF->Entry(-width => 8,-textvariable => \$config{SearchPixel})->pack(-side => 'top', -anchor => 'w', -padx => 8); if ($config{SearchMore}) { $addF->pack(-in => $addMF, -side => 'left', -expand => 0);# if (!ismapped($addF)); } else { $addF->packForget();# if (ismapped($addF)); } my $label = "$keys pictures are stored in the database (size: $size)."; my $subF = $sw->Frame()->pack(-fill => 'x', -expand => 0, -pady => 1); my $progress = 0; my $progBar = my $progB = $subF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -length => 100, -padx => 0, -pady => 0, -variable => \$progress, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => 10, -anchor => 'w', -from => 0, -to => 100, )->pack(-side => 'left', -fill => 'both', -expand => 0, -padx => 8, -pady => 0); $balloon->attach($progB, -msg => 'Displays the search progress'); $subF->Label(-textvariable => \$label, -justify => 'left',-bg => $config{ColorBG})->pack(-side => 'left', -anchor => 'w', -padx => 8); my $findLB = makeThumbListbox($sw); $balloon->attach($findLB, -msg => "left click : select\nmiddle click: open picture in new window\nright click : open context menu"); addCommonKeyBindings($findLB, $findLB); $findLB->bind('', sub { my @sellist = getSelection($findLB); return unless checkSelection($sw, 1, 0, \@sellist); show_multiple_pics(\@sellist, 0); } ); $findLB->bind('', sub { deletePics($findLB, TRASH); } ); $findLB->bind('', sub { deletePics($findLB, REMOVE); } ); # the context menu my $menu = $sw->Menu(-title => 'Search menu'); ############# select all $menu->command(-label => 'selected all', -command => sub {selectAll($findLB);}, -accelerator => '' ); $menu->separator; ############# file operations addFileActionsMenu($menu, $findLB); $menu->separator; ############# remove pictures from searchDB $menu->command(-label => "remove pictures from search database", -command => sub { my @sellist = getSelection($findLB); return unless checkSelection($top, 1, 0, \@sellist); my $rc = $sw->messageBox(-icon => 'question', -message => "Please press OK to remove the ".scalar @sellist." selected picture(s) from the search data base.\nThe picture file(s) won't be deleted. They may be added to the search database again anytime.", -title => "Remove ".scalar @sellist." picture(s) from search database?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); foreach (@sellist) { delete $searchDB{$_}; } }); ############# open pic $menu->command(-label => 'show pictures in new window', -accelerator => '', -command => sub { my @sellist = getSelection($findLB); return unless checkSelection($sw, 1, 0, \@sellist); show_multiple_pics(\@sellist, 0); }); ############# open dir $menu->command(-label => "open picture in main window", -accelerator => '', -command => sub { my @pics = $findLB->info('children'); return unless (@pics); my @sellist = $findLB->info('selection'); return unless checkSelection($sw, 1, 1, \@sellist); my $dpic = $sellist[0]; my $dir = dirname($dpic); my $pic = basename($dpic); if (!-d $dir) { $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK'); return; } $top->deiconify; $top->raise; $top->focus; openDirPost($dir) if ($dir ne $actdir); showPic($dpic); }); # key-desc,m,show picture in main window (from search window) $findLB->bind('', sub { my @sellist = $findLB->info('selection'); return unless checkSelection($sw, 1, 1, \@sellist); my $dpic = $sellist[0]; my $dir = dirname($dpic); my $pic = basename($dpic); if (!-d $dir) { $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.", -title => 'folder not found', -type => 'OK'); return; } $top->deiconify; $top->raise; $top->focus; openDirPost($dir) if ($dir ne $actdir); showPic($dpic); }); ############# open in external viewer $menu->command(-label => 'open pictures in external viewer', -command => sub { openPicInViewer($findLB); }, -accelerator => ''); $menu->separator; ############# display IPTC $menu->command(-label => 'show IPTC', -command => sub { displayIPTCData($findLB); }, -accelerator => ''); ############# edit IPTC $menu->command(-label => 'edit IPTC ...', -command => sub { editIPTC($findLB); }, -accelerator => ''); addRatingMenu($menu, $findLB); $menu->command(-label => 'add/remove keywords ...', -command => sub { editIPTCKeywords($findLB); }, -accelerator => ''); $menu->command(-label => 'add/remove categories ...', -command => sub { editIPTCCategories($findLB); } , -accelerator => ''); $menu->separator; ############# add comment $menu->command(-label => 'add comment ...', -command => sub { addComment($findLB); }, -accelerator => '
'); ############# edit comment $menu->command(-label => 'edit comment ...', -command => sub { editComment($findLB); }, -accelerator => ''); ############# search/replace comment $menu->command(-label => 'search/replace comment ...', -command => sub { replaceComment($findLB); }, ); $menu->separator; ############# sort my $sort_menu = $menu->cascade(-label => 'sort by ...'); $menu->separator; $menu->command(-label => 'add to light table', -command => sub {light_table_add_from_lb($findLB);}, -accelerator => ''); $sort_menu->command(-label => 'file name', -command => sub { my @pics = $findLB->info('children'); $findLB->delete('all'); delete_thumb_objects(\%searchthumbs); sortPics('name', 0, \@pics); foreach (@pics) { insertPic($findLB, $_, \%searchthumbs); } }, ); $sort_menu->command(-label => 'urgency', -command => sub { my @pics = $findLB->info('children'); $findLB->delete('all'); delete_thumb_objects(\%searchthumbs); sortPics('urgency', 0, \@pics); foreach (@pics) { insertPic($findLB, $_, \%searchthumbs); } }, ); $sort_menu->command(-label => 'file date', -command => sub { my @pics = $findLB->info('children'); $findLB->delete('all'); delete_thumb_objects(\%searchthumbs); sortPics('date', 0, \@pics); foreach (@pics) { insertPic($findLB, $_, \%searchthumbs); } }, ); $sort_menu->command(-label => 'EXIF date', -command => sub { my @pics = $findLB->info('children'); $findLB->delete('all'); delete_thumb_objects(\%searchthumbs); sortPics('exifdate', 0, \@pics); foreach (@pics) { insertPic($findLB, $_, \%searchthumbs); } }, ); # mouse and button bindings $findLB->bind('', sub { $menu->Popup(-popover => 'cursor', -popanchor => 'nw'); } ); $findLB->bind('', sub { return unless ($findLB->info('children')); my $dpic = getNearestItem($findLB); my $dir = dirname($dpic); if (!-d $dir) { $sw->messageBox(-icon => 'warning', -message => "Sorry, but the folder\n$dir\nis not availabale at the moment.\nMaybe you should clean your database\nor insert a removable media.",-title => 'folder not found', -type => 'OK'); return; } $sw->Busy; showPicInOwnWin($dpic); $sw->Unbusy; } ); my $SButF = $ButF->Frame(-bd => 0)->pack(-side => 'top', -anchor => 'n', -expand => 1, -fill =>'both',-padx => 0,-pady => 0); $OKB = $SButF->Button(-text => 'Search', -command => sub { my $searchStart = Tk::timeofday(); my $count = 0; my ($thumb, $thumbP, $last_time, $start_time, $end_time); if (($config{SearchCom} == 0 and $config{SearchName} == 0 and $config{SearchDir} == 0 and $config{SearchExif} == 0 and $config{SearchKeys} == 0 and $config{SearchIptc} == 0)) { $sw->messageBox(-icon => 'warning', -message => 'Please select at least on field (keywords, comments, ...) to search in.', -title => 'No search field selected', -type => 'OK'); return; } unless (checkNumberFormat($config{SearchPop})) { $config{SearchPop} = 5; $sw->messageBox(-icon => 'warning', -message => 'Please enter a natural number (0,1,2,3,...) in the viewed field', -title => 'Wrong format', -type => 'OK'); return; } # store the patterns before we process them $config{SearchPattern} = $pattern; $config{SearchExPattern} = $exclude; # replace (german) umlaute by corresponding letters $pattern =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $exclude =~ s/([$umlaute])/$umlaute{$1}/g if ($config{ConvertUmlaut}); $label = "searching pattern in $keys pictures."; $sw->update; $pat = makePattern($pattern);# support windows like search patterns $exl = makePattern($exclude);# support windows like search patterns if ($config{SearchWord}) { $pat = "\\b$pat"; $pat =~ s/\s+/\\b \\b/g; # replace one or more whitespaces with \b \b the word boundary $pat .= '\\b'; } if ($config{SearchType} eq 'any') { # or-function "Tim Tom" -> "Tim|Tom" $pat =~ s/\s+/|/g; # replace one or more whitespaces with | } elsif ($config{SearchType} eq 'all') { $pat = '(?=.*'.$pat; # and-function with look-ahead $pat =~ s/\s+/)(?=.*/g; # replace one or more whitespaces with )(?=.* $pat .= ')'; # "Tom Tim" is now: "(?=.*Tom)(?=.*Tim)" } else { # do nothing (normal string search) } #my $qrpat; # todo, but seems not to work with and searches #if ($config{SearchCase}) { $qrpat = qr/'$pat'2/io; } else { $qrpat = qr/'$pat'/o; } #print "pat = $pat qrpat = $qrpat\n"; # the exclude patterns are always combined with or $exl =~ s/ /|/g; # or-function "Tim Tom" -> "Tim|Tom" print "searchMetaInfo: pattern: $pattern -> -$pat-\n" if $verbose; print "searchMetaInfo: exclude pattern: $exclude -> -$exl-\n" if $verbose; if ($config{SearchDate}) { if (!checkDateFormat($config{SearchDateStart})) { $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong from-date', -type => 'OK'); return; } if (!checkDateFormat($config{SearchDateEnd})) { $sw->messageBox(-icon => 'warning', -message => $datetext, -title => 'Wrong to-date', -type => 'OK'); return; } $start_time = buildUnixTime($config{SearchDateStart}); $end_time = buildUnixTime($config{SearchDateEnd}); #print "$start_time .. $end_time\n"; if ($end_time < $start_time) { $sw->messageBox(-icon => 'warning', -message => 'Search from date must be before search to date', -title => 'Wrong search date', -type => 'OK'); return; } } $findLB->delete('all'); # clear listbox $sw->Busy; my $case = 'i'; $case = '' if $config{SearchCase}; $stopB->configure(-state => 'normal'); $stopB->update(); my $i = 0; #################################################### # loop through all database entries foreach my $dpic (sort keys %searchDB) { last if $stop; $i++; # show progress and found pics every 0.5 seconds - idea from Slaven if (!defined $last_time || Tk::timeofday()-$last_time > 0.5) { $progress = int($i/$keys*100); $sw->update; $last_time = Tk::timeofday(); } if ($config{SearchOnlyInDir}) { # search only in subdirs of actual/selected dir next unless ($dpic =~ m/^$start_dir/); } if ($config{SearchUrgencyOn}) { # ignore pics without a urgency setting next unless (defined($searchDB{$dpic}{URG})); } # fill in the POP key if it's missing (will cost about 6 Bytes per picture in the searchDB $searchDB{$dpic}{POP} = 0 unless (defined $searchDB{$dpic}{POP}); my $urg = $searchDB{$dpic}{URG}; my $time = $searchDB{$dpic}{TIME}; # skip if wrong urgency if ($config{SearchUrgencyOn} and (defined $urg)) { if ($config{SearchUrgencyRel} eq '=') { # equal next if ($urg != $config{SearchUrgency}); } else { # handle bigger and lower $urg = 9 if ($urg == 0); # urgency 0 means none, which is less than 8 (low) if ($config{SearchUrgencyRel} eq '>=') { # bigger next if ($urg < $config{SearchUrgency}); } if ($config{SearchUrgencyRel} eq '<=') { # lower next if ($urg > $config{SearchUrgency}); } } } # skip if wrong pixel sum size if ($config{SearchPixelOn}) { next unless (defined $searchDB{$dpic}{PIXX}); next unless (defined $searchDB{$dpic}{PIXY}); my $pixy = $searchDB{$dpic}{PIXX} * $searchDB{$dpic}{PIXY}; if ($config{SearchPixelRel} eq '=') { # equal next if ($pixy != $config{SearchPixel}); } else { # handle bigger and lower if ($config{SearchPixelRel} eq '>=') { # bigger next if ($pixy < $config{SearchPixel}); } if ($config{SearchPixelRel} eq '<=') { # lower next if ($pixy > $config{SearchPixel}); } } } # skip if wrong numer of views (popularity) if ($config{SearchPopOn}) { if ($config{SearchPopRel} eq '=') { # equal next if ($searchDB{$dpic}{POP} != $config{SearchPop}); } else { # handle bigger and lower if ($config{SearchPopRel} eq '>=') { # bigger next if ($searchDB{$dpic}{POP} < $config{SearchPop}); } if ($config{SearchPopRel} eq '<=') { # lower next if ($searchDB{$dpic}{POP} > $config{SearchPop}); } } } # skip if wrong date if ($config{SearchDate} and defined($time)) { next if ($time < $start_time); next if ($time > $end_time); } my $com = $searchDB{$dpic}{COM}; my $exif = $searchDB{$dpic}{EXIF}; my $iptc = $searchDB{$dpic}{IPTC}; my $keys = $searchDB{$dpic}{KEYS}; # replace newlines with space $com =~ s/\n/ /g if (defined $com); $exif =~ s/\n/ /g if (defined $exif); $iptc =~ s/\n/ /g if (defined $iptc); my $allMeta = ''; if ($config{SearchJoin}) { # join all selected meta info with a space $allMeta = $com if ($config{SearchCom} and $com); $allMeta .= ' '.$exif if ($config{SearchExif} and $exif); $allMeta .= ' '.$iptc if ($config{SearchIptc} and $iptc); $allMeta .= ' '.$keys if ($config{SearchKeys} and $keys); $allMeta .= ' '.basename($dpic) if ($config{SearchName}); $allMeta .= ' '.dirname($dpic) if ($config{SearchDir}); $allMeta =~ s/\n/ /g; # replace newlines with space } if ((($config{SearchJoin} and ($allMeta ne '') and ($allMeta =~ m/(?$case).*$pat.*/) ) ) or (($config{SearchCom} and (defined $com) and ($com =~ m/(?$case).*$pat.*/)) or ($config{SearchExif} and (defined $exif) and ($exif =~ m/(?$case).*$pat.*/)) or ($config{SearchIptc} and (defined $iptc) and ($iptc =~ m/(?$case).*$pat.*/)) or ($config{SearchKeys} and (defined $keys) and ($keys =~ m/(?$case).*$pat.*/)) or ($config{SearchKeys} and (!defined $keys) and ($pat eq '')) or # empty keywords ($config{SearchName} and (basename($dpic) =~ m/(?$case).*$pat.*/)) or ($config{SearchDir} and (dirname($dpic) =~ m/(?$case).*$pat.*/)))) { # skip if exclude pattern matches if ((defined $exl) and ($exl ne '')) { next if ((($config{SearchJoin} and ($allMeta ne "") and ($allMeta =~ m/(?$case).*$exl.*/ )) ) or (($config{SearchCom} and (defined $com) and ($com =~ m/(?$case).*$exl.*/)) or ($config{SearchExif} and (defined $exif) and ($exif =~ m/(?$case).*$exl.*/)) or ($config{SearchIptc} and (defined $iptc) and ($iptc =~ m/(?$case).*$exl.*/)) or ($config{SearchKeys} and (defined $keys) and ($keys =~ m/(?$case).*$exl.*/)) or ($config{SearchName} and (basename($dpic) =~ m/(?$case).*$exl.*/)) or ($config{SearchDir} and (dirname($dpic) =~ m/(?$case).*$exl.*/)))); } unless ($justCount) { insertPic($findLB, $dpic, \%searchthumbs); } $count++; $label = "found pattern in $count pictures."; } } # foreach #################################################### $stopB->configure(-state => "disabled"); $progress = 100; $findLB->update; my $searchDuration = sprintf "%.2f", (Tk::timeofday() - $searchStart); if ($count == 0) { my $msg = "Found no pictures containing \"$pattern\""; $msg .= " with urgency ".$config{SearchUrgencyRel}." ".$config{SearchUrgency} if ($config{SearchUrgencyOn}); $msg .= " with pixel size ".$config{SearchPixelRel}." ".$config{SearchPixel} if ($config{SearchPixelOn}); $msg .= " with views ".$config{SearchPopRel}." ".$config{SearchPop} if ($config{SearchPopOn}); $msg .= " dated between ".$config{"SearchDateStart"}." and ".$config{"SearchDateEnd"} if ($config{"SearchDate"} != 0); $msg .= " in folders matching $start_dir" if ($config{"SearchOnlyInDir"} != 0); $msg .= " in the database."; $sw->messageBox(-icon => 'warning', -message => $msg, -title => "Pattern not found", -type => 'OK'); $label = "pattern not found (duration: $searchDuration sec)."; $sw->Unbusy; $stop = 0; return; } $sw->Unbusy; $label = "Search finished: found $count pictures (duration: $searchDuration sec)."; $stop = 0; })->pack(-side => 'left', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1); $stopB = $SButF->Button(-text => "Stop", -command => sub { $stop = 1; } )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; $stopB->configure(-state => "disabled"); # would be usefull here, but needs to much space #$ButF->Button(-text => "Clean database ...", # -command => sub {cleanDatabase();})->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1); my $Xbut = $ButF->Button(-text => "Close", -command => sub { $stop = 1; $config{SearchGeometry} = $sw->geometry; $sw->withdraw; delete_thumb_objects(\%searchthumbs); $sw->destroy; } )->pack(-side => 'top', -anchor => 'w', -expand => 1,-fill => 'x',-padx => 1,-pady => 1); $sw->bind('', sub { $Xbut->invoke; }); $sw->bind('', sub { $Xbut->invoke; }); $sw->bind('', sub { showHistogram($findLB); }); $sw->Popup; checkGeometry(\$config{SearchGeometry}); $sw->geometry($config{SearchGeometry}); $sw->waitWindow; } ############################################################## # delete_thumb_objects ############################################################## sub delete_thumb_objects { my $thumbs = shift; # hash ref to store the thumbnails # clean up memory - delete all found thumbnail photo objects foreach (keys %searchthumbs) { print "searchMetaInfo: deleting thumb $_\n" if $verbose; $$thumbs{$_}->delete if (defined $$thumbs{$_}); delete $$thumbs{$_}; } } ############################################################## # insertPic ############################################################## sub insertPic($$$) { my $lb = shift; my $dpic = shift; my $thumbs = shift; # hash ref to store the thumbnails my $thumb = getThumbFileName($dpic); # create new row $lb->add($dpic); my $pic = basename($dpic); if (-f $thumb) { $$thumbs{$thumb} = $lb->Photo(-file => $thumb, -gamma => $config{Gamma}); if (defined $$thumbs{$thumb}) { $lb->itemCreate($dpic, $lb->{thumbcol}, -image => $$thumbs{$thumb}, -itemtype => "imagetext", -text => getThumbCaption($dpic), -style => $thumbS); } } else { $lb->itemCreate($dpic, $lb->{thumbcol}, -itemtype => "imagetext", -text => $pic, -style => $thumbS); print "insertPic: no thumb for $dpic ($thumb)\n" if $verbose; } my $dir = dirname($dpic); my $iptc; $iptc = displayIPTC($dpic); my $com = formatString($searchDB{$dpic}{COM}, 30, $config{LineLimit}); # format the comment for the list my $exif = formatString($searchDB{$dpic}{EXIF}, 30, $config{LineLimit}); # format the EXIF info for the list $iptc = formatString($iptc, 30, $config{LineLimit}); # format the IPTC info for the list my $size = basename($dpic)."\n\n"; $size .= int($searchDB{$dpic}{SIZE}/1024)."kB\n" if (defined $searchDB{$dpic}{SIZE}); $size .= $searchDB{$dpic}{PIXX}.'x'.$searchDB{$dpic}{PIXY}."\n" if (defined $searchDB{$dpic}{PIXX}); $size .= buildDateTime($searchDB{$dpic}{MOD}) if (defined $searchDB{$dpic}{MOD}); $size .= "\nviewed ".$searchDB{$dpic}{POP}." times" if (defined $searchDB{$dpic}{POP}); $lb->itemCreate($dpic, $lb->{filecol}, -text => $size, -style => $fileS); $lb->itemCreate($dpic, $lb->{iptccol}, -text => $iptc, -style => $iptcS); $lb->itemCreate($dpic, $lb->{comcol}, -text => $com, -style => $comS); $lb->itemCreate($dpic, $lb->{exifcol}, -text => $exif, -style => $exifS); $lb->itemCreate($dpic, $lb->{dircol}, -text => $dir, -style => $dirS); } ############################################################## # makePattern - create a regex from windows like search patterns # * for zero or more chars # ? for exactly one char # \* to search for the star sign (*) # \? to search for a questionmark (?) # . for a point (.) ############################################################## sub makePattern { my $pattern = shift; $pattern =~ s/\(/\\(/g; # replace ( with \( $pattern =~ s/\)/\\)/g; # replace ) with \) $pattern =~ s/\[/\\[/g; # replace ( with \( $pattern =~ s/\]/\\]/g; # replace ) with \) $pattern =~ s/\{/\\{/g; # replace ( with \( $pattern =~ s/\}/\\}/g; # replace ) with \) $pattern =~ s/\./\\./g; # replace . with \. (a point) $pattern =~ s/\\\*/\377/g; # replace \* with \377 (\377 is an unlikly char) $pattern =~ s/\*/.*/g; # replace * with .* (zero or more chars) $pattern =~ s/\377/\\*/g; # replace \377 with \* (the star iteself) $pattern =~ s/\\\?/\377/g; # replace \? with \377 $pattern =~ s/\?/.{1}/g; # replace ? with .{1} (one char) must be after { -> \{ $pattern =~ s/\377/\\?/g; # replace \377 with \? (the questionmark iteself) $pattern =~ s/\+/\\+/g; # replace + with \+ $pattern =~ s/\^/\\^/g; # replace ^ with \^ $pattern =~ s/\$/\\\$/g; # replace $ with \$ $pattern =~ s/\|/\\|/g; # replace | with \| #print "makePattern: $pattern\n"; return $pattern; } ############################################################## # getMemoryUsage - get the actual memory usage of mapivi in Bytes ############################################################## sub getMemoryUsage { my $size = 0; my $t = new Proc::ProcessTable; foreach my $p (@{$t->table}) { #if ($p->{pid} == $$) { # todo this would be the better way, but $p->{pid} is 0 on solaris if ($p->{fname} eq "mapivi") { $size = $p->{size}; last; } } return $size; } ############################################################## # xmp_show - show XMP info using Image::ExifTool ############################################################## sub xmp_show { unless ($exiftoolAvail) { $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", -title => "Image::ExifTool not available", -type => 'OK'); return; } my $lb = shift; my @sellist = getSelection($lb); return unless checkSelection($lb, 1, 0, \@sellist); my $selected = scalar @sellist; $userinfo = "extracting XMP information of $selected pictures"; $userInfoL->update; my $exifTool = new Image::ExifTool; my $i = 0; my $pw = progressWinInit($lb, "Extracting XMP information"); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Extracting XMP ($i/$selected) ...", $i, $selected); my $xmp = ''; my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); foreach (sort keys %$info) { my $val = $$info{$_}; if (ref $val eq 'ARRAY') { $val = join(', ', @$val); } elsif (ref $val eq 'SCALAR') { $val = '(Binary data)'; } $xmp .= sprintf("%-24s : %s\n", $_, $val); } $xmp = 'No XMP data found.' if ($xmp eq ''); showText("XMP data of $dpic", $xmp, NO_WAIT); } progressWinEnd($pw); $userinfo = "ready! ($i of $selected)"; $userInfoL->update; } ############################################################## # xmp_add_keyword - add XMP keyword using Image::ExifTool ############################################################## sub xmp_add_keyword { unless ($exiftoolAvail) { $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", -title => "Image::ExifTool not available", -type => 'OK'); return; } my $lb = shift; my @sellist = getSelection($lb); return unless checkSelection($lb, 1, 0, \@sellist); my $selected = scalar @sellist; my $keyword = ''; my $rc = myEntryDialog('Add XMP keyword', "Please enter a new keyword to add to the $selected pictures", \$keyword); return if (($rc ne 'OK') or ($keyword eq '')); $userinfo = "adding XMP keyword to $selected pictures"; $userInfoL->update; my $exifTool = new Image::ExifTool; my $i = 0; my $error = ''; my $pw = progressWinInit($lb, 'Adding XMP keyword'); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Adding XMP keyword ($i/$selected) ...", $i, $selected); my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); # get exsisting keywords my @keywords = $exifTool->GetValue('Subject'); # add new keyword to list push @keywords, $keyword; # remove double entries and sort alphabetical uniqueArray(\@keywords); # add XMP keywords $exifTool->SetNewValue('XMP-dc:Subject' => \@keywords); #$exifTool->SetNewValue('XMP-dc:Title' => 'Mapivi can write XMP!'); #$exifTool->SetNewValue('XMP:Urgency' => 3); my $rc = $exifTool->WriteInfo($dpic); if ($rc != 1) { if ($rc == 2) { $error .= "$dpic written, but no changes made\n"; } else { $error .= "Error writing $dpic: $rc\n"; # retrieve error and warning messages $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); } } } progressWinEnd($pw); $userinfo = "ready! ($i of $selected)"; $userInfoL->update; showText("Errors while adding XMP keywords", $error, NO_WAIT) if ($error ne ''); } ############################################################## # xmp_add_title - add XMP title using Image::ExifTool ############################################################## sub xmp_add_title { unless ($exiftoolAvail) { $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", -title => "Image::ExifTool not available", -type => 'OK'); return; } my $lb = shift; my @sellist = getSelection($lb); return unless checkSelection($lb, 1, 0, \@sellist); my $selected = scalar @sellist; my $item = ''; my $rc = myEntryDialog('Add XMP title', "Please enter a new title to add to the $selected picture(s)", \$item); return if ($rc ne 'OK'); $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update; my $exifTool = new Image::ExifTool; my $i = 0; my $error = ''; my $pw = progressWinInit($lb, 'Adding XMP title'); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "Adding XMP title ($i/$selected) ...", $i, $selected); my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); # add XMP title $exifTool->SetNewValue('XMP-dc:Title' => $item); my $rc = $exifTool->WriteInfo($dpic); if ($rc != 1) { if ($rc == 2) { $error .= "$dpic written, but no changes made\n"; } else { $error .= "Error writing $dpic: $rc\n"; # retrieve error and warning messages $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); } } } progressWinEnd($pw); $userinfo = "ready! ($i of $selected)"; $userInfoL->update; showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne ''); } ############################################################## # xmp_edit_title - edit XMP title using Image::ExifTool ############################################################## sub xmp_edit_title { unless ($exiftoolAvail) { $top->messageBox(-icon => 'info', -message => "Sorry, but the Perl module Image::ExifTool is not available.\nPlease install it and restart Mapivi.", -title => "Image::ExifTool not available", -type => 'OK'); return; } my $lb = shift; my @sellist = getSelection($lb); return unless checkSelection($lb, 1, 0, \@sellist); my $selected = scalar @sellist; $userinfo = "adding XMP title to $selected picture(s)"; $userInfoL->update; my $exifTool = new Image::ExifTool; my $i = 0; my $error = ''; my $pw = progressWinInit($lb, 'Adding XMP title'); foreach my $dpic (@sellist) { last if progressWinCheck($pw); $i++; my $item = ''; my $info = $exifTool->ImageInfo($dpic, 'XMP:*'); $item = $$info{Title} unless (ref $$info{Title} eq 'SCALAR'); my $rc = myEntryDialog('Edit XMP title', "Please edit title of $dpic", \$item); next if ($rc ne 'OK'); progressWinUpdate($pw, "Edit XMP title ($i/$selected) ...", $i, $selected); # add XMP title $exifTool->SetNewValue('XMP-dc:Title' => $item); $rc = $exifTool->WriteInfo($dpic); if ($rc != 1) { if ($rc == 2) { $error .= "$dpic written, but no changes made\n"; } else { $error .= "Error writing $dpic: $rc\n"; # retrieve error and warning messages $error .= sprintf "error: %s\n", $exifTool->GetValue('Error') if $exifTool->GetValue('Error'); $error .= sprintf "warning: %s\n", $exifTool->GetValue('Warning') if $exifTool->GetValue('Warning'); } } } progressWinEnd($pw); $userinfo = "ready! ($i of $selected)"; $userInfoL->update; showText("Errors while adding XMP title", $error, NO_WAIT) if ($error ne ''); } ############################################################## # checkTrash ############################################################## sub checkTrash { my @files = getFiles($trashdir); my $sum = 0; foreach (@files) { $sum += getFileSize("$trashdir/$_", NO_FORMAT); # get size in Bytes } my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB return if ($msum < $config{MaxTrashSize}); my $dialog = $top->Dialog(-title => "Trash full!", -text => "The trash contains $msum MB in ".scalar @files." files!", -buttons => ["Do nothing", "Show trash in main window", "Empty trash ..."]); my $rc = $dialog->Show(); if ($rc eq "Do nothing") { $top->focusForce; return; } elsif ($rc eq "Show trash in main window") { openDirPost($trashdir); $top->focusForce; return; } elsif ($rc eq "Empty trash ...") { emptyTrash(); } else { warn "this should never be reached!"; } $top->focusForce; } ############################################################## # emptyTrash - remove all files from the trash ############################################################## sub emptyTrash { my @files = getFiles($trashdir); # open window my $win = $top->Toplevel(); $win->title('Empty trash?'); $win->iconimage($mapiviicon) if $mapiviicon; my $w = int($top->screenwidth * 0.5); my $h = int($top->screenheight * 0.90); $win->geometry("${w}x${h}+0+0"); my $text = "loading ..."; $win->Label(-textvariable => \$text)->pack(-expand => 0, -fill => 'x'); my $tlb = $win->Scrolled("HList", -header => 1, -separator => ';', # todo here we hope that ; will never be in a folder or file name -pady => 0, -columns => 4, -scrollbars => 'osoe', -selectmode => 'extended', -background => $config{ColorBG}, #8fa8bf -width => 80, -height => 30, )->pack(-expand => 1, -fill => "both"); bindMouseWheel($tlb); $tlb->header('create', 0, -text => 'Thumbnail', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 1, -text => 'Name', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 2, -text => 'Size', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); $tlb->header('create', 3, -text => 'Original folder', -headerbackground => $config{ColorEntry}, -borderwidth => $config{Borderwidth}); my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $butF->Button(-text => 'Empty trash', -command => sub { my @sellist = $tlb->info('selection'); print "sel: $_\n" foreach (@sellist); foreach (@files) { removeFile("$trashdir/$_"); } updateThumbsPlus() if ($actdir eq $trashdir); $win->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $butF->Button(-text => 'Remove selected', -command => sub { my @sellist = $tlb->info('selection'); foreach (@sellist) { removeFile($_); $tlb->delete('entry', $_); } #updateThumbsPlus() if ($actdir eq $trashdir); #$win->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $butF->Button(-text => 'Restore selected', -command => sub { my @sellist = $tlb->info('selection'); my $error = ''; foreach my $dpic (@sellist) { # if original dir (odir) is defined and not unknown and the folder exists, we move the picture back if ($searchDB{$dpic}{odir} and ($searchDB{$dpic}{odir} ne 'unknown') and ( -d $searchDB{$dpic}{odir})) { my @list; # we need a dummy list here with one element push @list, $dpic; #print "moving $dpic to $searchDB{$dpic}{odir}\n"; movePics($searchDB{$dpic}{odir}, $tlb, @list); #$tlb->delete('entry', $dpic) unless (-f $dpic); } else { $error .= "Could not restore $dpic (no folder information available)\n"; } } if ($error ne '') { $error = "Errors while restoring selected pictures:\n$error"; showText("Errors", $error, NO_WAIT); } #updateThumbsPlus() if ($actdir eq $trashdir); #$win->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $butF->Button(-text => 'Close', -command => sub { $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { selectAll($tlb); } ); $win->bind('', sub { return if (!$tlb->info('children')); my $dpic = getNearestItem($tlb); showPicInOwnWin($dpic); }); $win->Popup(-popover => 'cursor'); repositionWindow($win); my $sum = 0; my %thumbs; foreach my $pic (sort { uc($a) cmp uc($b); } @files) { my $dpic = "$trashdir/$pic"; $sum += getFileSize($dpic, NO_FORMAT); # get size in Bytes my $size = getFileSize($dpic, FORMAT); my $thumb = getThumbFileName($dpic); my $odir = 'unknown'; $odir = $searchDB{$dpic}{odir} if ($searchDB{$dpic}{odir}); $tlb->add($dpic); if (-f $thumb) { $thumbs{$thumb} = $top->Photo(-file => $thumb, -gamma => $config{Gamma}); if (defined $thumbs{$thumb}) { $tlb->itemCreate($dpic, 0, -image => $thumbs{$thumb}, -itemtype => 'imagetext', -style => $thumbS); } } $tlb->itemCreate($dpic, 1, -text => $pic, -style => $comS); $tlb->itemCreate($dpic, 2, -text => $size, -style => $iptcS); $tlb->itemCreate($dpic, 3, -text => $odir, -style => $comS); } my $msum = sprintf "%.1f", $sum/(1024*1024); # size in MB $text = "Please press \"Empty trash\" to delete all files ($msum MB in ".scalar @files." files) from the trash.\nThere is no undelete!\n\n(Trash folder: $trashdir)"; $win->waitWindow; foreach (keys %thumbs) { $thumbs{$_}->delete if (defined $thumbs{$_}); } # free memory } ############################################################## # setFromTo - dialog to set search from and search to date ############################################################## sub setFromTo { # open window my $win = $top->Toplevel(); $win->title('Set from/to search dates'); $win->iconimage($mapiviicon) if $mapiviicon; my @fdate = split /\./, $config{SearchDateStart}; my $from_day = $fdate[0]; my $from_month = $fdate[1]; my $from_year = $fdate[2]; my @tdate = split /\./, $config{SearchDateEnd}; my $to_day = $tdate[0]; my $to_month = $tdate[1]; my $to_year = $tdate[2]; # ranges my (@day, @month, @year); push @day, sprintf "%02d",$_ for ( 1 .. 31); push @month, sprintf "%02d",$_ for ( 1 .. 12); push @year, sprintf "%4d", $_ for ( 1990 .. 2020); # it is still possible to add other year numbers in the search window itself! my $f1 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $f1->Label(-text => 'from', -width => 4)->pack(-side => "left", -anchor => 'w'); $f1->Optionmenu(-variable => \$from_day, -textvariable => \$from_day, -options => \@day)->pack(-side => "left", -anchor => 'w'); $f1->Optionmenu(-variable => \$from_month, -textvariable => \$from_month, -options => \@month)->pack(-side => "left", -anchor => 'w'); $f1->Optionmenu(-variable => \$from_year, -textvariable => \$from_year, -options => \@year)->pack(-side => "left", -anchor => 'w'); $f1->Button(-text => 'today', -command => sub { my (undef,undef,undef,$d,$M,$y,undef,undef,undef,undef) = localtime(time()); $y += 1900; $M++; $from_day = sprintf "%02d", $d; $from_month = sprintf "%02d", $M; $from_year = sprintf "%4d", $y;})->pack(-side => "left", -anchor => 'w'); my $f2 = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $f2->Label(-text => 'to', -width => 4)->pack(-side => "left", -anchor => 'w'); $f2->Optionmenu(-variable => \$to_day, -textvariable => \$to_day, -options => \@day)->pack(-side => "left", -anchor => 'w'); $f2->Optionmenu(-variable => \$to_month, -textvariable => \$to_month, -options => \@month)->pack(-side => "left", -anchor => 'w'); $f2->Optionmenu(-variable => \$to_year, -textvariable => \$to_year, -options => \@year)->pack(-side => "left", -anchor => 'w'); $f2->Button(-text => 'today', -command => sub { my (undef,undef,undef,$d,$M,$y,undef,undef,undef,undef) = localtime(time()); $y += 1900; $M++; $to_day = sprintf "%02d", $d; $to_month = sprintf "%02d", $M; $to_year = sprintf "%4d", $y;})->pack(-side => "left", -anchor => 'w'); my $butF = $win->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $butF->Button(-text => 'OK', -command => sub { $config{SearchDateStart} = "$from_day.$from_month.$from_year"; $config{SearchDateEnd} = "$to_day.$to_month.$to_year"; $win->destroy; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $butF->Button(-text => 'Cancel', -command => sub { $win->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $Xbut->invoke; }); $win->bind('', sub { $OKB->invoke; }); $win->Popup(-popover => 'cursor'); repositionWindow($win); $win->waitWindow; } ############################################################## # showFile ############################################################## sub showFile { my $file = shift; return if (!-f $file); my $fileH; if (!open($fileH, "<$file")) { warn "Sorry, I couldn't open the file $file: $!"; return; } my $buffer; read $fileH, $buffer, 32768; close($fileH); $buffer =~ s/\r//g; showText(basename($file), $buffer, WAIT) if ($buffer ne ""); } ############################################################## # showText ############################################################## sub showText { my $title = shift; my $text = shift; my $wait = shift; # WAIT = wait for the window to close or NO_WAIT my $thumbnail = shift; # optional my $icon; $text = " " if ((!defined $text) or ($text eq "")); # open window my $win = $top->Toplevel(); $win->withdraw; $win->title($title); $win->iconname($title); $win->iconimage($mapiviicon) if $mapiviicon; my $xBut = $win->Button(-text => "Close", -command => sub { $icon->delete if $icon; $win->withdraw(); $win->destroy(); }, )->pack(-fill => 'x'); # 50 ways to leave your window ;) $win->bind('' , sub {$xBut->invoke;}); $win->bind('' , sub {$xBut->invoke;}); $win->protocol("WM_DELETE_WINDOW" => sub {$xBut->invoke;} ); my $f = $win->Frame()->pack(-fill => 'both', -expand => "1"); my $fl = $f->Frame()->pack(-anchor => "n", -side => "left"); my $fr = $f->Frame()->pack(-anchor => "n", -side => "left", -fill => 'both', -expand => "1"); if ((defined $thumbnail) and (-f $thumbnail)) { $icon = $win->Photo(-file => $thumbnail, -gamma => $config{Gamma}); if ($icon) { $fl->Label(-image => $icon, -bg => $config{ColorBG}, -relief => "sunken", )->pack(-padx => 1, -pady => 2); } } # determine the height of the textbox by counting the number of lines my $height = ($text =~ tr/\n//); $height += 3; $height = 50 if ($height > 50); # not to big, we have scrollbars my $rotext = $fr->Scrolled("ROText", -scrollbars => 'oe', -wrap => 'word', -tabs => '4', -width => 90, -height => $height, )->pack(-fill => 'both', -expand => "1"); $rotext->insert('end', $text); bindMouseWheel($rotext); $xBut->focus; $win->Popup; repositionWindow($win); $win->waitWindow if ($wait == WAIT); } ############################################################## # exportFilelist ############################################################## sub exportFilelist { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my ($pic, $dpic); my $addPath = 0; my $useQuotes = 0; # open window my $myDiag = $top->Toplevel(); $myDiag->title("Export file list"); $myDiag->iconimage($mapiviicon) if $mapiviicon; $myDiag->Label(-text => "Write a filelist containing the ".scalar @sellist." selected pictures", -bg => $config{ColorBG} )->pack(-fill => 'x', -padx => 3, -pady => 3); labeledEntryButton($myDiag,'top',37,"path/name of file list",'Set',\$config{PicListFile}); $myDiag->Checkbutton(-variable => \$addPath, -text => "add the complete path to every file")->pack(-anchor=>'w'); $myDiag->Checkbutton(-variable => \$useQuotes, -text => "add quotes around each file")->pack(-anchor=>'w'); my $ButF = $myDiag->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { if (-f $config{PicListFile}) { my $rc = $myDiag->messageBox(-icon => 'warning', -message => "file $config{'PicListFile'} exist. Ok to overwrite?", -title => "Export file list", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } my $exfile; if (!open($exfile, ">$config{'PicListFile'}")) { warn "exportFilelist: Couldn't open $config{'PicListFile'}: $!"; return; } foreach $dpic (@sellist) { $pic = basename($dpic); print $exfile "\"" if $useQuotes; print $exfile "$actdir/" if $addPath; print $exfile "$pic"; print $exfile "\"" if $useQuotes; print $exfile ", "; } close $exfile; $myDiag->withdraw(); $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); #$balloon->attach($OKB, -msg => "You can press Control-x to close the dialog"); $ButF->Button(-text => 'Cancel', -command => sub { $myDiag->withdraw(); $myDiag->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $myDiag->Popup(-popover => 'cursor'); repositionWindow($myDiag); $myDiag->waitWindow; $userinfo = "ready!"; $userInfoL->update; } ############################################################## # GIMPedit ############################################################## sub GIMPedit { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); return unless askSelection(\@sellist, 10, "GIMP"); my ($pic, $dpic, $i, $exifthumb); if ($EvilOS) { return if (!checkExternProgs("GIMPedit", "gimp-win-remote")); } else { if (!checkExternProgs("GIMPedit", "gimp-remote")){ $dpic = $sellist[0]; $pic = basename($dpic); my $rc = $top->messageBox(-icon => "question", -message => "Should Mapivi start a new GIMP with the first selected picture ($pic)?\nEXIF info will not be saved!\nUse Edit->EXIF info->save first!", -title => "Open picture with GIMP", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); my $command = "gimp \"$dpic\" 2>&1 1>/dev/null &"; (system "$command") == 0 or warn "$command failed: $!"; return; } } EXIFsave() if $config{saveEXIFforEdit}; $i = 0; foreach $dpic (@sellist) { $i++; $userinfo = "opening picture in GIMP ($i/".scalar @sellist.")"; $userInfoL->update; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $command = "gimp-remote -n \"$dpic\" "; #$command = "gimp-win-remote \"$dpic\" " if $EvilOS; # GIMP <= 2.0 $command = "gimp-win-remote gimp-2.2.exe \"$dpic\" " if $EvilOS; # GIMP > 2.0 $command .= "2>&1 1>/dev/null &" if (!$EvilOS); (system "$command") == 0 or warn "$command failed: $!"; #execute($command); # does not work for Windows } $top->after(800, sub { $userinfo = "ready!"; $userInfoL->update; }); } ############################################################## # getSelection - get the selected items from a Canvas or a HList ############################################################## sub getSelection { my $widget = shift; my @sellist; if (ref($widget) eq 'Tk::Canvas') { my @sel = $widget->find('withtag', 'THUMBSELECT_MH'); foreach my $id (@sel) { push @sellist, get_path_from_id($id); } } else { @sellist = $widget->info('selection'); } return @sellist; } ############################################################## # openPicInViewer ############################################################## sub openPicInViewer { my $lb = shift; # the reference to the active listbox widget my @sellist = getSelection($lb); return unless checkSelection($top, 1, 0, \@sellist); my $maxnr = 20; if (!$config{ExtViewerMulti} and (@sellist > $maxnr)) { my $rc = $lb->messageBox(-icon => "question", -message => "You have selected more than $maxnr pictures.\nPlease confirm to start ".scalar @sellist." pictures viewer processes.\nPlease press Ok to continue.", -title => "Start a lot of viewers?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } my ($dpic, $i, $exifthumb, $piclist); $i = 0; foreach $dpic (@sellist) { $i++; $userinfo = "opening picture in viewer ($i/".scalar @sellist.")"; $userInfoL->update; increasePicPopularity($dpic); updateOneRow($dpic, $lb) if (($config{trackPopularity}) and (ref($lb) ne 'Tk::Canvas')); $dpic =~ s/\//\\/g if $EvilOS; # windows needs backslashes if ($config{ExtViewerMulti}) { $piclist .= "\"$dpic\" "; } else { my $command = $config{ExtViewer}." \"$dpic\" "; # instead of the & for UNIX windows needs a "start" in front of the application to run in the background if ($EvilOS) { $command = "start $command"; } else { $command .= "2>&1 1>/dev/null &"; } (system "$command") == 0 or warn "$command failed: $!"; #execute($command); this is no good choice, because it waits for the viewer to finish } } if ($config{ExtViewerMulti}) { my $command = $config{ExtViewer}." $piclist"; # instead of the & for UNIX windows needs a "start" in front of the application to run in the background if ($EvilOS) { $command = "start $command"; } else { $command .= "2>&1 1>/dev/null &"; } (system "$command") == 0 or warn "$command failed: $!"; } $top->after(800, sub { $userinfo = "ready!"; $userInfoL->update; }); } ############################################################## # setBackground - set the current picture as desktop background ############################################################## sub setBackground { my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "set desktop background", -type => 'OK'); return; } my $dpic = $sellist[0]; my $pic = basename($dpic); $userinfo = "setting $pic as desktop background ..."; $userInfoL->update; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $command = $config{ExtBGApp}." \"$dpic\" "; execute($command); $userinfo = "ready!"; $userInfoL->update; } ############################################################## # identifyPic - display the output of identify ############################################################## sub identifyPic { return if (!checkExternProgs("identifyPic", "identify")); my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Show picture infos", -type => 'OK'); return; } my $dpic = $sellist[0]; my $pic = basename($dpic); my $thumb = getThumbFileName($dpic); $userinfo = "getting infos about $pic ..."; $userInfoL->update; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $command = "identify -verbose \"$dpic\" "; my $buffer = `$command`; showText("Information about $pic", $buffer, NO_WAIT, $thumb); $userinfo = "ready!"; $userInfoL->update; } ############################################################## # showSegments ############################################################## sub showSegments { my @sellist = $picLB->info('selection'); if (@sellist != 1) { $top->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Show segments", -type => 'OK'); return; } my $dpic = $sellist[0]; my $pic = basename($dpic); my $thumb = getThumbFileName($dpic); # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $meta = getMetaData($dpic); # get all segments return unless ($meta); my $segments = $meta->{segments}; my $win = $top->Toplevel(); $win->withdraw; $win->title("JPEG segments of $pic"); $win->iconimage($mapiviicon) if $mapiviicon; my $xBut = $win->Button(-text => "Close", -command => sub { $win->destroy(); })->pack(-fill => 'x'); foreach (@$segments) { my $segInfo = $_->get_description(); my $segname = $_->{name}; my $title = sprintf "%-16s %8s Bytes",$segname,$_->size(); $win->Button(-text => $title, -anchor => "nw", -command => sub { showText("Segment $segname of $pic", $segInfo, NO_WAIT); })->pack(-fill => 'x'); } $xBut->focus; $win->Popup; } ############################################################## # showHistogram - display the histogram of a picture ############################################################## sub showHistogram($) { return if (!checkExternProgs("showHistogram", "convert")); my $lb = shift; my @sellist = $lb->info('selection'); if (@sellist != 1) { $lb->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Show picture histogram", -type => 'OK'); return; } my $dpic = $sellist[0]; my $pic = basename($dpic); my $thumb = getThumbFileName($dpic); $userinfo = "building histogram of $pic ..."; $userInfoL->update; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); my $hist = getHistogram($lb, $dpic); if (($hist eq "") or (!-f $hist)) { $userinfo = "Error building histogram of $pic!"; $userInfoL->update; return; } $userinfo = "ready!"; $userInfoL->update; my $but = "Save histogram"; my $rc = myPicDialog("Histogram", "Histogram of $pic", $but, $thumb, $hist); if ($rc eq $but) { my $file = $lb->FileSelect(-title => "Save histogram of $pic (GIF format)", -directory => $actdir, -initialfile => basename($hist), -create => 1, -width => 30, -height => 30)->Show; if ((defined $file) and ($file ne "")) { if (mycopy($hist, $file, ASK_OVERWRITE)) { # ask before overwrite $userinfo = "histogram saved!"; } else { $userinfo = "error while saving histogram"; } } } removeFile($hist); } ############################################################## # getHistogram - generate a histogram of the given picture # returns the path and file to the histogram # file or "" if no success ############################################################## sub getHistogram($$) { my $widget = shift; my $dpic = shift; my $rc = ""; return $rc unless (-f $dpic); my $pic = basename($dpic); # temp PNM or GIF file in the trash directory my $hist = "$trashdir/histogram.pnm"; # exchange pnm with gif if needed if (-f $hist) { my $urc = $top->messageBox(-icon => 'question', -message => "Histgram file $hist exists already.\nShould I overwrite it?", -title => "Overwrite?", -type => 'OKCancel'); return $rc if ($urc !~ m/Ok/i); } # with the -comment "" option the file size of the histogram shrinks from ~1MB to ~5kB # because convert saves the complete color table in the comment (at least when GIF format is used) my $command = "convert \"$dpic\" HISTOGRAM:- | convert -comment \"\" - \"$hist\" "; $widget->Busy; execute($command); $widget->Unbusy; $rc = $hist if (-f $hist); return $rc; } ############################################################## # showHistogram2 - display the histogram of a picture with builtin histogram function ############################################################## sub showHistogram2($) { return if (!checkExternProgs("showHistogram", "convert")); my $lb = shift; my @sellist = $lb->info('selection'); if (@sellist != 1) { $lb->messageBox(-icon => 'warning', -message => "Please select exactly one picture.", -title => "Show picture histogram", -type => 'OK'); return; } my $dpic = $sellist[0]; my $pic = basename($dpic); my $thumb = getThumbFileName($dpic); $userinfo = "building histogram of $pic ..."; $userInfoL->update; # check if file is a link and get the real target next if (!getRealFile(\$dpic)); buildHistogram($dpic); } ############################################################## # buildHistogram ############################################################## sub buildHistogram { my $dpic = shift; my $photo = $top->Photo(-file => $dpic); # no gamma correction here! my (@red, @green, @blue); foreach (0 .. 255) { $red[$_] = 0; } foreach (0 .. 255) { $green[$_] = 0; } foreach (0 .. 255) { $blue[$_] = 0; } my $w = $photo->width; my $h = $photo->height; # if the picture is to big, it will take very long, so we shrink them first. # some color information may be lost this way! my $subsample = int($w*$h/500000); print "$dpic: subsample: $subsample\n" if $verbose; if ($subsample > 1) { my $zoomed = $top->Photo; $zoomed->blank; $zoomed->copy($photo, -zoom => 1); $photo->delete; $photo = undef; $photo = $top->Photo; $photo->copy($zoomed, -subsample => $subsample); $zoomed->delete; $zoomed = undef; $w = $photo->width; $h = $photo->height; print "$dpic new size: $w x $h\n" if $verbose; } if ($w <= 0 or $h <= 0) { warn "buildHistogram: wrong size: $w $h\n"; return; } #stopWatchStart(); my $pw = progressWinInit($top, "Calculating histogram of ".$w*$h." pixels"); # get and add rgb values of each pixel foreach my $x (0 .. $w-1) { last if progressWinCheck($pw); progressWinUpdate($pw, "calculating column ($x/$w) ...", $x, $w); foreach my $y (0 .. $h-1) { my @rgb = $photo->get($x,$y); $red[$rgb[0]]++; $green[$rgb[1]]++; $blue[$rgb[2]]++; } } progressWinEnd($pw); # find the maximal value my $max = 0; foreach (0 .. 255) { $max = $red[$_] if ($red[$_] > $max); $max = $green[$_] if ($green[$_] > $max); $max = $blue[$_] if ($blue[$_] > $max); }; # open window my $win = $top->Toplevel(); $win->title("Histogram of $dpic"); $win->iconimage($mapiviicon) if $mapiviicon; $h = 255; # height is now the height of the canvas my $canvas = $win->Canvas(-width => 256, -height => $h+1, -background => 'black', -relief => 'sunken', -bd => $config{Borderwidth})->pack(-side => 'top', -padx => 3, -pady => 3); # draw a line for red, green and blue foreach my $x (0 .. 255) { $canvas->createLine( $x, $h, $x, $h-int($h*$red[$x]/$max), -fill => 'red'); $canvas->createLine( $x, $h, $x, $h-int($h*$green[$x]/$max), -fill => 'green', -stipple => 'transp2'); $canvas->createLine( $x, $h, $x, $h-int($h*$blue[$x]/$max), -fill => 'blue', -stipple => 'transp3'); } $win->Button(-text => "Close", -command => sub { $win->destroy(); } )->pack(-side => 'top',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $win->bind('', sub { $win->destroy; } ); $win->Popup; #stopWatchStop("Histogram of $dpic"); } ############################################################## # checkSelection ############################################################## sub checkSelection { my $win = shift; my $min = shift; my $max = shift; # use 0 for any number my $listref = shift; my $itemkind = shift; # optional string, e.g. "picture" or "keyword", ... $itemkind = '' unless defined $itemkind; my $plural = ''; $plural = 's' if ($min > 1); if (($min == $max) and (@$listref != $min)) { $win->messageBox(-icon => 'warning', -message => "Please select exactly $min $itemkind item$plural!", -title => "Wrong selection", -type => 'OK'); return 0; } if (@$listref < $min) { $win->messageBox(-icon => 'warning', -message => "Please select at least $min $itemkind item$plural!", -title => "Wrong selection", -type => 'OK'); return 0; } if (($max != 0) and (@$listref > $max)) { $win->messageBox(-icon => 'warning', -message => "Please select not more than $max $itemkind items!", -title => "Wrong selection", -type => 'OK'); return 0; } return 1; } ############################################################## # askSelection ############################################################## sub askSelection { my $listRef = shift; my $max = shift; my $text = shift; # ask only for more than $max pictures return 1 if (@{$listRef} < $max); my $rc = $top->messageBox(-icon => "question", -message => "You have selected ".scalar @{$listRef}." pictures. This function will open an $text window for each selected picture.\nPlease press Ok to continue.", -title => "Show $text of ".scalar @{$listRef}." pictures", -type => 'OKCancel'); if ($rc =~ m/Ok/i) { return 1; } return 0; } ############################################################## # indexPrint - generate indexPrints/montages of the selected # pictures ############################################################## my $indexW; # index dialog window my $indexPicsT; my $indexNrT; my $sizeT; sub indexPrint { return if (!checkExternProgs("indexPrint", "montage")); if (Exists($indexW)) { $indexW->deiconify; $indexW->raise; return; } my $pic_list_ref = shift; #foreach (@$pic_list_ref) { print "list::: $_\n"; } my @sellist = @$pic_list_ref; return unless checkSelection($top, 1, 0, \@sellist); my $index = $sellist[0]; $index = dirname($sellist[0]).'/'.findNewName($index); if (-f $index) { # just for safety, we don't want to overwrite something warn "$index exists: aborting - this should never happen!!!\n"; return; } # get size of first pic my ($pic0x, $pic0y) = getSize($sellist[0]); # open window $indexW = $top->Toplevel(); #$indexW->grab(); $indexW->title("montage/index prints of ".scalar @sellist." pictures"); $indexW->iconimage($mapiviicon) if $mapiviicon; my $w = 26; labeledEntry($indexW, 'top', $w, "file name of index print", \$index); labeledEntry2($indexW, 'top', 20, 4, "Columns (x)",\$config{indexCols}, "Rows (y)",\$config{indexRows}); labeledEntry2($indexW, 'top', 20, 4, "x distance", \$config{indexDisX}, "y distance", \$config{indexDisY}); my $sizeF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3); labeledEntry2($sizeF, 'top', 20, 4, "Picture width", \$config{indexPicX}, "Picture height", \$config{indexPicY}); $sizeF->Button(-text => "insert picture size (${pic0x}x$pic0y)", -command => sub { $config{indexPicX} = $pic0x; $config{indexPicY} = $pic0y; })->pack(-anchor => 'e', -padx => 3, -pady => 3); labeledEntryColor($indexW,'top',$w,"Background color",'Set',\$config{indexBG}); my $lF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $lF->Checkbutton(-variable => \$config{indexLabel}, -text => "add a label to each picture")->pack(-anchor=>'w'); my $labstr = labeledEntry($lF, 'top', $w, "label string", \$config{indexLabelStr}); $balloon->attach($labstr, -msg => "%b file size\n%c comment\n%d folder\n%e filename extention\n%f filename\n%h height\n%i input filename\n%l label\n%m magick\n%n number of scenes\n%o output filename\n%p page number\n%q quantum depth\n%s scene number\n%t top of filename\n%u unique temporary filename\n%w width\n%x x resolution\n%y y resolution"); my $fss = labeledScale($lF, 'top', $w, "label font size", \$config{indexFontSize}, 0, 50, 1); $balloon->attach($fss, -msg => "The font size of the labels.\nIf you set this to 0, montage will\ntry to choose a appropriate size."); my $ibF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ibF->Checkbutton(-variable => \$config{indexInnerBorder}, -text => "add a border around each picture")->pack(-anchor=>'w'); labeledScale($ibF, 'top', $w, "Border width", \$config{indexInnerBorderWidth}, 1, 1000, 1); labeledEntryColor($ibF, 'top', $w, "Border color",'Set',\$config{indexInnerBorderColor}); my $obF = $indexW->Frame(-relief => "raised")->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $obF->Checkbutton(-variable => \$config{indexBorder}, -text => "add a border around the index print")->pack(-anchor=>'w'); labeledScale($obF, 'top', $w, "Border width", \$config{indexBorderWidth}, 1, 1000, 1); labeledEntryColor($obF, 'top', $w, "Border color",'Set',\$config{indexBorderColor}); my $qS = labeledScale($indexW, 'top', $w, "Quality of index picture", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); buttonComment($indexW, 'top'); calcIndexInfo( scalar @sellist ); my $f = $indexW->Frame(-bd => $config{Borderwidth}, -relief => 'groove',)->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $f->Label(-textvar => \$indexPicsT, -bg => $config{ColorBG})->pack(-anchor => 'w'); $f->Label(-textvar => \$indexNrT, -bg => $config{ColorBG})->pack(-anchor => 'w'); $f->Label(-textvar => \$sizeT, -bg => $config{ColorBG})->pack(-anchor => 'w'); $f->Button(-text => "update info", -command => sub { calcIndexInfo(scalar @sellist); } )->pack(); my $ButF = $indexW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB; $OKB = $ButF->Button(-text => 'OK', -command => sub { my $nr = calcIndexInfo( scalar @sellist ); # we need the nr of index prints here if ($nr == 1) { # just one index print, we leave the name if (-f $index) { my $rc = $indexW->messageBox(-icon => 'warning', -message => "file $index exist. Please press Ok to overwrite.", -title => "File exists!", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } } else { # there is more than one index print, montage will name them xxx01.jpg ... $index =~ /(.*)(\.jp(g|eg))/i; # split (we need base name and suffix) $index = "$1-%02d$2"; for (1 .. $nr) { my $name = sprintf "%s-%02d%s", $1, $_, $2; if (-f $name) { my $rc = $indexW->messageBox(-icon => 'warning', -message => "file $name exist. Please press Ok to overwrite.", -title => "File exists!", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } } } $indexW->destroy(); # close index window $userinfo = "building index prints of ".scalar @sellist." pictures ..."; $userInfoL->update; my $command = "montage "; if ($config{indexInnerBorder}) { $command .= "-bordercolor \"".$config{indexInnerBorderColor}."\" "; $command .= "-border ".$config{indexInnerBorderWidth}.'x'.$config{indexInnerBorderWidth}." "; } $command .= "-label \"$config{'indexLabelStr'}\" " if $config{indexLabel}; $command .= "-font \"-*-courier-medium-r-*-*-".$config{indexFontSize}."-*-*-*-*-*-iso8859-*\" " if ($config{indexLabel} and ($config{indexFontSize} > 0)); #$command .= "-pointsize ".$config{indexFontSize}." " if $config{indexLabel}; $command .= "-background \"$config{'indexBG'}\" -tile $config{'indexCols'}x$config{'indexRows'} -filter Lanczos -geometry $config{'indexPicX'}x$config{'indexPicY'}+$config{'indexDisX'}+$config{'indexDisY'} "; my $pic; # add the selected pictures to $command foreach my $dpic (@sellist) { $command .= "\"$dpic\" "; } # if there is a second process step (border) we use the lossless MIFF format my $tmpfile = "$trashdir/indexTmpFile.miff"; if (-f $tmpfile) { warn "tmp file $tmpfile exists! Mapivi tries to remove it"; return unless removeFile($tmpfile); } if ($config{indexBorder}) { $command .= "\"$tmpfile\""; } else { $command .= "-quality ".$config{PicQuality}." "; $command .= "\"$index\""; } print "$command\n" if $verbose; $top->Busy; if ($EvilOS) { (system $command) == 0 or warn "execute: $command failed: $!"; } else { execute($command); } # for win32 we need to wait for this process to finish if ($config{indexBorder}) { $command = "convert -bordercolor \"".$config{indexBorderColor}."\" "; $command .= "-border ".$config{indexBorderWidth}.'x'.$config{indexBorderWidth}." "; $command .= "-quality ".$config{PicQuality}." "; $command .= "\"$tmpfile\" "; $command .= "\"$index\""; print "$command\n" if $verbose; if ($EvilOS) { # do not use bgrun for windows (system $command) == 0 or warn "execute: $command failed: $!"; } else { execute($command); } } $top->Unbusy; removeFile($tmpfile) if (-f $tmpfile); if ($config{AddMapiviComment}) { addCommentToPic("Picture made with Mapivi ($mapiviURL)", $index, NO_TOUCH); } $userinfo = "ready!"; $userInfoL->update; if ($nr == 1) { # for one index we insert it in the listbox generateOneThumb($index); # insert index in listbox addOneRow($picLB, $index, 1, $sellist[0]); } else { # for several index we need a (slower) update updateThumbs(); } showPic($index); })->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $ButF->Button(-text => 'Cancel', -command => sub { $indexW->destroy(); } )->pack(-side => 'left',-expand => 1,-fill => 'x',-padx => 3,-pady => 3); $indexW->bind('', sub {$indexW->destroy;}); $indexW->Popup; $indexW->waitWindow; } ############################################################## # calcIndexInfo ############################################################## sub calcIndexInfo { my $nrOfSel = shift; my $indexPics = $config{indexRows} * $config{indexCols}; $indexPicsT = "One index print holds $indexPics pictures."; my $indexNr = int($nrOfSel/$indexPics); $indexNr++ if (($nrOfSel % $indexPics) != 0); $indexNrT = "With $nrOfSel pictures this results in $indexNr index pictures."; my $sizex = $config{indexCols} * ($config{indexPicX} + (2*$config{indexDisX})); my $sizey = $config{indexRows} * ($config{indexPicY} + (2*$config{indexDisY})); if ($config{indexBorder}) { $sizex = $sizex + 2 * $config{indexBorderWidth}; $sizey = $sizey + 2 * $config{indexBorderWidth}; } if ($config{indexInnerBorder}) { $sizex = $sizex + $config{indexCols} * 2 * $config{indexInnerBorderWidth}; $sizey = $sizey + $config{indexRows} * 2 * $config{indexInnerBorderWidth}; } $sizeT = "One index will be ca. ${sizex}x${sizey} pixels."; return ($indexNr); } ############################################################## # fisher_yates_shuffle - shuffle an array randomly ############################################################## sub fisher_yates_shuffle { my $deck = shift; # $deck is a reference to an array my $i = @$deck; while ($i--) { my $j = int rand ($i+1); @$deck[$i,$j] = @$deck[$j,$i]; } } ############################################################## # reloadPic ############################################################## sub reloadPic { deleteCachedPics($actpic); # we need to reread the picture, so we should remove it from the cachedPics list first showPic($actpic); # display the picture } ############################################################## # zoom100 - zoom the actual pic to 100% ############################################################## sub zoom100 { return if (!$actpic); $userinfo = "loading ".basename($actpic)." ..."; $userInfoL->update; deleteCachedPics($actpic); # we need to reread the picture, so we should clear the cachedPics list first my $t = $config{AutoZoom}; # save auto zoom value $config{AutoZoom} = 0; # stop auto zoom showPic($actpic); # display the picture without auto zoom $config{AutoZoom} = $t; # reset autozoom to the saved value } ############################################################## # fitPicture - (re)zoom the actual picture to fit into the canvas ############################################################## sub fitPicture { return unless (-f $actpic); deleteCachedPics($actpic); my $autoZoomSave = $config{AutoZoom}; # save actual autoZoom value $config{AutoZoom} = 1; # enable auto zoom showPic($actpic); $config{AutoZoom} = $autoZoomSave; # restore old autoZoom value } ############################################################## # slideshow - start/stop slideshow ############################################################## sub slideshow { my $last_time; if ($slideshow) { $userinfo = "slideshow started"; $userInfoL->update; $top->after(500); # just a litte delay to show the message above until ($slideshow == 0) { if (!defined $last_time || Tk::timeofday()-$last_time > $config{SlideShowTime}) { my @savedselection = $picLB->info('selection'); showPic(nextSelectedPic($actpic)); $userinfo = basename($actpic)." (slideshow: ".$config{SlideShowTime}."sec)"; $userInfoL->update; $last_time = Tk::timeofday(); $picLB->selectionClear(); reselect($picLB, @savedselection); } DoOneEvent(); # stay responsive last if (!$slideshow); } } $userinfo = "slideshow stopped"; $userInfoL->update; } ############################################################## # getWindows - get a list of toplevel children of the given widget ############################################################## sub getWindows { my $w = shift; my @winlist; # get all childs of $w my @childs = $w->children; # search for toplevels and build list foreach my $widget (@childs) { if (ref($widget) eq "Tk::Toplevel") { push @winlist, $widget; } } return @winlist; } ############################################################## # clearAndInsert - clear the given listbox and insert the list ############################################################## sub clearAndInsert { my $listBox = shift; return if (!Exists($listBox)); my @list = @_; # clear listbox $listBox->delete(0, 'end'); foreach (@list) { $listBox->insert('end', $_->cget(-title)); } } my $winW; ############################################################## # showWindowList ############################################################## sub showWindowList { if (Exists($winW)) { $winW->deiconify; $winW->raise; return; } my @winlist = getWindows($top); if (@winlist <= 0) { $top->messageBox(-icon => 'info', -message => "There are no open windows in the moment!", -title => "No windows", -type => 'OK'); return; } # open window $winW = $top->Toplevel(); $winW->title("MaPiVi window list"); $winW->iconimage($mapiviicon) if $mapiviicon; $winW->Label(-text => "Sub windows of MaPiVi", -relief => "sunken" )->pack(-fill => 'x', -padx => 3, -pady => 3); my $listBoxY = @winlist + 1; $listBoxY = 30 if ($listBoxY > 30); # not higher than 30 entries my $listBox = $winW->Scrolled('Listbox', -scrollbars => 'osoe', -selectmode => 'extended', -exportselection => 0, -width => 80, -height => $listBoxY, )->pack(-expand => 1, -fill =>'both'); bindMouseWheel($listBox); $listBox->bind('', sub { my @sellist = $listBox->curselection(); foreach (@sellist) { $winlist[$_]->deiconify; $winlist[$_]->raise; $winlist[$_]->update; } @winlist = getWindows($top); clearAndInsert($listBox, @winlist); } ); clearAndInsert($listBox, @winlist); my $ButF = $winW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Update", -command => sub { @winlist = getWindows($top); clearAndInsert($listBox, @winlist); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Iconify", -command => sub { my @sellist = $listBox->curselection(); foreach (@sellist) { $winlist[$_]->iconify; } @winlist = getWindows($top); clearAndInsert($listBox, @winlist); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Close", -command => sub { my @sellist = $listBox->curselection(); foreach (@sellist) { $winlist[$_]->destroy() if (Exists($winlist[$_])); } return if (!Exists($winW)); # own win closed - finished @winlist = getWindows($top); clearAndInsert($listBox, @winlist); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Show", -command => sub { my @sellist = $listBox->curselection(); foreach (@sellist) { $winlist[$_]->deiconify; $winlist[$_]->raise; $winlist[$_]->update; } @winlist = getWindows($top); clearAndInsert($listBox, @winlist); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'Cancel', -command => sub { $winW->destroy(); } )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $winW->bind('', sub {$winW->destroy;}); $winW->bind('' , sub {$winW->destroy;}); $winW->Popup; $winW->waitWindow; } ############################################################## # toggle - toggle the value of a boolean variable reference ############################################################## sub toggle { my $varRef = shift; if ($$varRef == 1) { $$varRef = 0; } elsif ($$varRef == 0) { $$varRef = 1; } else { warn "toggle: Reference has unexpected value: $$varRef\n"; } } ############################################################## # execute ############################################################## sub execute { my $string = shift; # command to execute my $actexe; # file handle to Tk::IO object (background process) print "execute: $string\n" if $verbose; if (!$EvilOS) { # running on a "good" OS like Linux we can use background processes :) # init a background process $actexe = Tk::IO->new(-linecommand => sub { nop(); }, -childcommand => sub { print "execute: child com\n" if $verbose; } ); # start the background process $actexe->exec($string); # the busy call made some problems with jhead and the autorot option # while it was enabled the $actexe->wait call sometimes never returned #$top->Busy; # waiting for current process to finish $actexe->wait(); #$top->Unbusy; } # we run on a evil OS like windows - no threading :( # Tk::IO is supposed to run under windows, but it does not with mine else { #$top->Busy; #(system "$string") == 0 or warn "execute: $string failed: $!"; #$top->Unbusy; bgRun($string); } } ############################################################## # findApp - find Windows-App-Name for Win32::Process # from Uwe Steffen ############################################################## sub findApp { my ($cmd)=@_; $cmd =~ /^\s*(\w+)/; my $cmdName=$1.".exe"; #print "cmdName:",$cmdName,"\n"; if (defined($winapps{$cmdName})) { return $winapps{$cmdName}; } my @path=split (/;/,$ENV{PATH}); foreach my $dir (@path) { my $test=$dir."/$cmdName"; #print "Test: $test \n"; if ( -x $test ) { $winapps{$cmdName}=$test; return $test; } } } ############################################################## # bgRun - run a process in background # from Uwe Steffen ############################################################## sub bgRun { my ($cmd) = @_; if (!$EvilOS) { warn "bgRun should not be called for non Windows systems!"; return 0; } if (Win32ProcAvail) { my ($dir,$pid,$proc); my ($bInherit) = 0; my ($flags) = Win32::Process::CREATE_NO_WINDOW() | Win32::Process::IDLE_PRIORITY_CLASS() | Win32::Process::DETACHED_PROCESS(); if ( $cmd =~ /^(\w+:[\w\\.]+)/) { print "Process with full path: ",$cmd," APP:", $1,"\n" if $verbose; $pid = Win32::Process::Create($proc, $1, $cmd, $bInherit, $flags, "." ); } else { print "Process without full path: ",$cmd," APP:", findApp($cmd),"\n" if $verbose; $pid = Win32::Process::Create($proc, findApp($cmd), $cmd, $bInherit, $flags, "." ); } if ($pid) { $proc->Wait(15000); print "bgRun: timeout\n"; return 1; } else { warn "Could not start $cmd.\n"; warn "Error: " . Win32::FormatMessage(Win32::GetLastError()); return 0; } } else { # Win32::Process module not available $top->Busy; (system "$cmd") == 0 or warn "bgRun: $cmd failed: $!"; $top->Unbusy; } } ############################################################## # cleanThumbDB - remove all old thumbnails in the thumbDB ############################################################## sub cleanThumbDB { # todo create dialog window and make e.g. the $days an adjustable option my $days = 30; my $thumbDB = "$configdir/thumbDB"; my $thumbDB_quote = $thumbDB; $thumbDB_quote =~ s|\\|\\\\|g; # replace backslash with double backslashe \ -> \\ (quoting) my @thumbs; my $rc = $top->messageBox(-icon => "question", -message => "This function will display all stored thumbnails in the thumbnail data base which have no corresponding picture and are older than $days days. You may then select which of then to delete. Please press Ok to proceed.", -title => "Clean thumbnail database", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); $userinfo = "searching outdated thumbnails ..."; $userInfoL->update; find(sub { #print "dir: $File::Find::name\n"; if (-f and (-M >= $days)) { my $orig = $File::Find::name; # cut off the first path part (the path to the thumbdb) the rest is the real part. $orig =~ s|^$thumbDB_quote||; unless (-f $orig) { print "file: $File::Find::name -> $orig\n" if $verbose; push @thumbs, $File::Find::name; } } }, $thumbDB); # todo: ignore /mnt/cdrom (%ignorePaths) ... $userinfo = "found ".@thumbs." outdated thumbnails ..."; $userInfoL->update; if (@thumbs > 0) { my @sel_list; # user may select which to delete if (mySelListBoxDialog("Really delete?", "Please select which of these ".scalar @thumbs." thumbnails to delete.", MULTIPLE, 'OK', \@sel_list, @thumbs)) { foreach (@sel_list) { print "removing $thumbs[$_]\n" if $verbose; removeFile($thumbs[$_]); } } $userinfo = "ready!"; $userInfoL->update; } else { $top->messageBox(-icon => "info", -message => "Found no outdated thumbnails in $thumbDB. Seems like your thumbnails are up to date.", -title => "Thumbnail database is up to date", -type => 'OK'); } return; # todo: remove empty dirs in $thumbDB ... } ############################################################## # cleanDir - remove all dirs and files added by mapivi from # the given dir ############################################################## sub cleanDir { my $dir = shift; print "dir = $dir actdir = $actdir\n" if $verbose; return unless ((defined $dir) or (-d $dir)); my $rc; if (($cleanDirLevel == 0) or (!$cleanDirNoAsk)) { my $dia = $top->DialogBox(-title => "Clean folder ".basename($dir)."?", -buttons => ['OK', 'Cancel']); $dia->add("Label", -text => "Remove all sub folders and files from\n$dir\nwhich were created from MaPiVi\nContinue?", -bg => $config{ColorBG}, -justify => "left")->pack; $dia->add("Checkbutton", -text => "Continue without asking again", -variable => \$cleanDirNoAsk)->pack; $rc = $dia->Show(); return if ($rc ne 'OK'); } my ($subdir, @fileDirList); my @subdirs = ("$dir/$thumbdirname", "$dir/$exifdirname"); foreach $subdir (@subdirs) { if (-d $subdir) { @fileDirList = readDir($subdir); unless ($cleanDirNoAsk) { $rc = $top->messageBox(-icon => 'question', -message => "There are ".scalar @fileDirList." files in the sub folder\n".basename($subdir)."\nRemove?", -title => "Remove sub folder?", -type => 'OKCancel'); next if ($rc !~ m/Ok/i); } $userinfo = "cleaning $subdir ..."; $userInfoL->update; foreach (@fileDirList) { if (-f "$subdir/$_") { removeFile("$subdir/$_") } else { $top->messageBox(-icon => 'warning', -message => "There is a non file in $subdir: $_!", -title => 'Warning', -type => 'OK') if ($_ ne ".."); } } if (! rmdir($subdir)) { $top->messageBox(-icon => 'warning', -message => "Could not remove $subdir: $_!", -title => 'Error', -type => 'OK'); } } } my @dirs = getDirs($dir); return if (@dirs == 0); my %dirh; # copy the list into a hash foreach (@dirs) { $dirh{$_} = 1; } # sort some special dirs out foreach ($thumbdirname, $exifdirname, ".xvpics") { if (defined $dirh{$_}) { delete $dirh{$_}; } } # are there some other dirs? my $nr = keys %dirh; if (($nr > 0) and (!$cleanDirNoAsk)) { $rc = $top->messageBox(-icon => 'question', -message => "There are $nr sub folders in\n$dir\n, should I clean them too?", -title => "Clean sub folders?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } # recursive call of cleanDir() foreach (sort keys %dirh) { $cleanDirLevel++; cleanDir ("$dir/$_"); $cleanDirLevel--; } if ($cleanDirLevel == 0) { $userinfo = "ready"; $userInfoL->update; } } ############################################################## # isInList - check if a string is element of a list reference ############################################################## sub isInList { my $e = shift; my $listRef = shift; my $found = 0; foreach (@$listRef) { if ($e eq $_) { $found = 1; last; } } return $found; } ############################################################## # screenshot ############################################################## sub screenshot { if (Exists($scsw)) { $scsw->deiconify; $scsw->raise; return; } return if (!checkExternProgs("screenshot", "xwd")); return if (!checkExternProgs("screenshot", "convert")); # open window $scsw = $top->Toplevel(); $scsw->title("Make screenshot"); $scsw->iconimage($mapiviicon) if $mapiviicon; my $root = ""; my $frame = "-frame"; my $tmpfile = "$trashdir/screenshot.jpg"; $tmpfile = "$trashdir/".findNewName($tmpfile); my $file = "$actdir/screenshot.jpg"; $file = "$actdir/".findNewName($file); my $hideMapivi = 0; my $showPic = 1; my $ifB; my $f1 = $scsw->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x',-padx => 3,-pady => 3); $f1->Radiobutton(-text => "single window (select window with mouse click after pressing OK)", -variable => \$root, -value => "", -command => sub { $ifB->configure(-state => 'normal');} )->pack(-anchor => 'w'); $f1->Radiobutton(-text => "complete desktop", -variable => \$root, -value => "-root", -command => sub { $frame = ""; $ifB->configure(-state => "disabled");} )->pack(-anchor => 'w'); my $f2 = $scsw->Frame(-bd => $config{Borderwidth}, -relief => 'groove')->pack(-fill => 'x',-padx => 3,-pady => 3); $ifB = $f2->Checkbutton(-variable => \$frame, -onvalue => "-frame", -offvalue => "", -anchor => 'w', -text => "include window border" )->pack(-anchor => 'w'); $f2->Checkbutton(-variable => \$hideMapivi, -anchor => 'w', -text => "hide Mapivi window" )->pack(-anchor => 'w'); $f2->Checkbutton(-variable => \$showPic, -anchor => 'w', -text => "show screenshot in Mapivi when finished" )->pack(-anchor => 'w'); buttonComment($f2, 'top'); labeledEntryButton($scsw,'top',23,"file name",'Set',\$file); my $qS = labeledScale($scsw, 'top', 23, "Quality of picture (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); my $ButF = $scsw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { if (-f $file) { my $rc = $scsw->messageBox(-icon => 'warning', -message => "file\n\"$file\"\nexist.\nOk to overwrite?", -title => "Screenshot", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } if (-f $tmpfile) { my $rc = $scsw->messageBox(-icon => 'warning', -message => "file $tmpfile exist. Ok to overwrite?", -title => "Screenshot", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); } $top->iconify() if $hideMapivi; $scsw->withdraw(); $scsw->destroy(); $top->update if (!$hideMapivi); # call external command jpegtran and rotate to the temp file my $command = "xwd $frame $root -out \"$tmpfile\" "; #(system "$command") == 0 or warn "screenshot: $! ($command)"; execute($command); $top->deiconify if $hideMapivi; if (!-f $tmpfile) { warn "nothing to convert!"; return; } $command = "convert -quality ".$config{PicQuality}." \"$tmpfile\" \"$file\""; $userinfo = "converting to JPEG format ..."; $userInfoL->update; $top->Busy; #(system "$command") == 0 or warn "convert: $! ($command)"; execute($command); $top->Unbusy; removeFile($tmpfile); if ($config{AddMapiviComment}) { addCommentToPic("Screenshot made with Mapivi ($mapiviURL)", $file, NO_TOUCH); } $userinfo = "ready!"; $userInfoL->update; if ($showPic) { my $dir = dirname($file); if ($actdir ne $dir) { openDirPost($dir); } else { updateThumbs(); } showPic($file); } })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $balloon->attach($OKB, -msg => 'In "single window" mode the mouse cursor will turn into a cross after pressing OK. Just make a left mouse click on the desired window. In "desktop" mode the screenshot will be taken immediatelly after pressing the OK button. There may be two beeps in both modes if sound is enabled.'); $ButF->Button(-text => 'Cancel', -command => sub { $scsw->withdraw(); $scsw->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $scsw->Popup; $scsw->waitWindow; } ############################################################## # dragFromPicLB - drag pictures from the thumb table ############################################################## sub dragFromPicLB { my($token) = @_; my $w = $token->parent; # $w is the $picLB hlist my $e = $w->XEvent; $w->update; my @sellist = $w->info('selection'); return if (@sellist < 1); if ($EvilOS) { $userinfo = "copy or move "; } else { $userinfo = "copy, link, or move "; } # only one picture selected if (@sellist == 1) { #my $tokentext = $w->itemCget($sellist[0], 1, -text); my $tokentext = $sellist[0]; # Configure the dnd token to show the listbox entry if (!$w->info("exists", $sellist[0])) { print "dragFromPicLB: item not available\n"; return; } if ($dragAndDropIcon1) { $token->configure(-image => $dragAndDropIcon1); } else { $token->configure(-text => " $tokentext"); } $userinfo .= $tokentext; $userInfoL->update; } # more than one pictures selected else { if ($dragAndDropIcon2) { $token->configure(-image => $dragAndDropIcon2); } else { $token->configure(-text => " ".scalar @sellist." pictures"); } $userinfo .= scalar @sellist." pictures"; $userInfoL->update; } # Show the token my($X, $Y) = ($e->X, $e->Y); $token->MoveToplevelWindow($X, $Y); $token->raise; $token->deiconify; $token->FindSite($X, $Y, $e); Tk->break; # stop default binding of this event } ############################################################## # dropToDirTree - drop pictures on the dirtree (copy or move) ############################################################## sub dropToDirTree { $token->withdraw; $userinfo = ""; $userInfoL->update; my @sellist = $picLB->info('selection'); my $targetdir = getNearestItem($dirtree); my $details; return if (@sellist < 1); my $dirtreeNoScroll = $dirtree->Subwidget("scrolled"); return unless ($top->containing($top->pointerxy) eq $dirtreeNoScroll); $targetdir =~ s/\/\//\//g; # replace all // with / foreach my $dpic (@sellist) { warn "$dpic n.a." unless ($picLB->info("exists", $dpic)); my $pic = basename($dpic); my $size = getFileSize($dpic, FORMAT); $details .= sprintf "%-30s %20s\n", $pic, $size; } my $text = "Should I "; if ($EvilOS) { $text .= "copy or move "; } else { $text .= "copy, link, or move "; } if (@sellist == 1) { $text .= "this picture"; } else { $text .= "these ".scalar @sellist." pictures"; } $text .= " to $targetdir?\n\n$details"; my $rc = 'Cancel'; if ($EvilOS) { $rc = myButtonDialog("Copy/Move", $text, undef, "Copy", "Move", 'Cancel'); } else { $rc = myButtonDialog("Copy/Link/Move", $text, undef, "Copy", "Link", "Move", 'Cancel'); } if ($rc eq 'Cancel') { return; } elsif ($rc eq "Copy") { dirSave($targetdir); copyPics($targetdir, COPY, $picLB, @sellist); } elsif ($rc eq "Link") { dirSave($targetdir); linkPics($targetdir, @sellist); } elsif ($rc eq "Move") { dirSave($targetdir); movePics($targetdir, $picLB, @sellist); } else { warn "unexpected rc: $rc"; return; } } ############################################################## #dragAndDropExtern - todo ############################################################## sub dragAndDropExtern { my($widget, $selection) = @_; my $filename; eval { if ($^O eq 'MSWin32') { $filename = $widget->SelectionGet(-selection => $selection, 'STRING'); } else { $filename = $widget->SelectionGet(-selection => $selection, 'FILE_NAME'); } }; return if (!defined $filename); #print "drop extern received: $filename\n"; $top->messageBox(-icon => 'warning', -message => "drop extern received: $filename", -title => "Drag and drop", -type => 'OK'); unless (-f $filename or -d $filename) { print "$filename is no dir and no file\n"; return; } my $dir = $filename; if (-f $filename) { return if ($filename !~ /(.*)(\.jp(g|eg))/i); $dir = dirname($filename); } print "drag: dir = $dir\n"; return unless (-d $dir); openDirPost($dir); if (-f $filename) { showPic($filename); } } ############################################################## # checkWriteable ############################################################## sub checkWriteable($) { my $dpic = shift; my $pic = basename($dpic); my $dir = dirname($dpic); my $thumb = getThumbFileName($dpic); return 0 if (! -f $dpic); # no file return 1 if (-w $dpic); # OK, file is writable if (!-w $dpic) { my $message = "The picture $pic is write proteced!\nShould I try to overwrite the write protection?"; my $rc = myButtonDialog("$pic is write protected", $message, $thumb, 'OK', 'Cancel'); if ($rc eq 'OK') { my $mode = (lstat $dpic)[2]; # get the actual access mode $mode = $mode | 0200; # set user write (+uw) return (chmod($mode, $dpic)); # try to change the mode } else { return 0; # file is left write protected } } } ############################################################## # checkWriteableMulti ############################################################## sub checkWriteableMulti { my @dpics = @_; my @protected = (); foreach (@dpics) { if ((-f $_) and (!-w $_)) { push @protected, $_; } } return "" unless (@protected); # nothing to do my $text = "The following pictures are write protected:\n\n"; foreach (@protected) { $text .= "$_\n"; } $text .= "\nShould I try to overwrite the write protection?"; my $rc = myButtonDialog(scalar @protected." pictures are write protected", $text, undef, 'OK', 'Cancel', 'Cancel All'); if ($rc eq 'OK') { foreach (@protected) { my $mode = (lstat $_)[2]; # get the actual access mode $mode = $mode | 0200; # set user write (+uw) chmod($mode, $_); # try to change the mode } } return $rc; } ############################################################## # bindMouseWheel - this won't be needed with Tk >= 804.025 ############################################################## sub bindMouseWheel { return if ($Tk::VERSION >= 804); print "activating mouse wheel\n" if $verbose; my($w) = @_; if ($^O eq 'MSWin32') { $w->bind('' => [ sub { $_[0]->yview('scroll', -($_[1] / 120) * 3, 'units') }, Ev('D') ]); } else { # Support for mousewheels on Linux commonly comes through # mapping the wheel to buttons 4 and 5. If you have a # mousewheel ensure that the mouse protocol is set to # "IMPS/2" in your /etc/X11/XF86Config (or XF86Config-4) # file: # # Section "InputDevice" # Identifier "Mouse0" # Driver "mouse" # Option "Device" "/dev/mouse" # Option "Protocol" "IMPS/2" # Option "Emulate3Buttons" "off" # Option "ZAxisMapping" "4 5" # EndSection $w->bind('<4>' => sub { $_[0]->yview('scroll', -3, 'units') unless $Tk::strictMotif; }); $w->bind('<5>' => sub { $_[0]->yview('scroll', +3, 'units') unless $Tk::strictMotif; }); } } # end BindMouseWheel ############################################################## # diffPics - create a new picture containing the difference # between two pictures ############################################################## sub diffPics { return if (!checkExternProgs("diffPics", "composite")); my @sellist = $picLB->info('selection'); return unless checkSelection($top, 2, 2, \@sellist); my $dpicA = $sellist[0]; my $dpicB = $sellist[1]; my $dpicDiff = $dpicA; $dpicDiff =~ s/(.*)(\.jp(g|eg))/$1-diff$2/i; # pic.jpg -> pic-diff.jpg $dpicDiff = dirname($dpicA).'/'.findNewName($dpicDiff); # pic-diff.jpg -> pic-diff-03.jpg $userinfo = "creating difference picture ..."; $userInfoL->update; #my $command = "composite -compose difference \"$dpicA\" \"$dpicB\" \"$dpicDiff\""; my $command = "convert \"$dpicA\" \"$dpicB\" -compose difference -composite -normalize \"$dpicDiff\""; print "diffPics: $command\n" if $verbose; $top->Busy; execute($command); $top->Unbusy; $userinfo = "ready! (difference picture created)"; $userInfoL->update; generateOneThumb($dpicDiff); # insert diff pic in listbox addOneRow($picLB, $dpicDiff, 1, $dpicA); #updateThumbs(); showPic($dpicDiff); } ############################################################## # interpolatePics ############################################################## sub interpolatePics { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($pic, $dpic, $dirtpic, $i); return if (!interpolateDialog(scalar @sellist)); return if (!checkExternProgs("interpolatePics", "jpegpixi")); $userinfo = "interpolating $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Interpolate pictures"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "interpolating ($i/$selected) ...", $i, $selected); $pic = basename($dpic); $dirtpic = "$dpic"."-cjpg"; # temporary file next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); # check if temp file exists next if (!checkTempFile($dirtpic)); # call external command jpegpixi my $command = "jpegpixi -m ".$config{DeadPixelMethod}." \"$dpic\" \"$dirtpic\" ".$config{DeadPixelStr}; execute($command); # now overwrite the original pic with the temp file and delete the temp file next if (!overwrite("$dpic", "$dirtpic")); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); reselect($picLB, @sellist); $userinfo = "ready! ($i of $selected interpolated)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # interpolateDialog ############################################################## sub interpolateDialog { if (Exists($interpW)) { $interpW->deiconify; $interpW->raise; return; } my $pics = shift; if (!defined($pics)) { $pics = ""; } else { $pics = "$pics "; } my $rc = 0; my $deadpixels = $config{DeadPixelStr}; my $method = $config{DeadPixelMethod}; # open window $interpW = $top->Toplevel(); $interpW->title("Interploate pictures"); $interpW->iconimage($mapiviicon) if $mapiviicon; $interpW->Label(-text => "Remove dead pixels from ${pics}pictures with Jpegpixi", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3, -pady => 3); $interpW->Label(-text => "This function should be called as first step when processing pictures\n(e.g. it must be called before rotating the pictures).", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3); my $infotext = "Some Infos about Jpegpixi from the author (see: http://www.zero-based.org/software/jpegpixi/): \"Jpegpixi is short for JPEG Pixel Interpolator. The intent of the program is to interpolate pixels (single pixels, dots, stripes) in JPEG images. This is useful to correct images from a digital camera with CCD defects. For example, if one pixel is always bright green, this pixel can be interpolated with jpegpixi. Jpegpixi is unique in that it tries to preserve the quality of the JPEG image as much as possible. Usual graphics programs decode JPEG images when they are loaded, and re-encode them when they are saved, which results in an overall loss of quality. Jpegpixi, on the other hand, only decodes the DCT blocks (typically 88, 168, or 1616 pixel areas) which contain pixels to be interpolated, and when it re-encodes them, it uses exactly the same parameters with which the image has originally been encoded. These blocks are therefore only minimally disturbed, and other blocks remain pixel-by-pixel identical to the original image. Usage: jpegpixi [OPTION]... SOURCE DEST [[D:]X,Y[,S]|[,SX,SY]]... Pixel block specification: D can be `V' or `v' (vertical 1D interpolation), `H' or `h' (horizontal 1D interpolation), `2' (2D interpolation) [default]; X,Y specifies the top left corner of the pixel block to be interpolated; S specifies the size of the block [default: 1]; SX,SY specifies separate sizes for the X and Y direction.\" The part: [OPTION] and [[D:]X,Y[,S]|[,SX,SY]]... may be changed in this dialog, the rest (jpegpixi ... SOURCE DEST) will be done by MaPiVi. Example: If there are two dead pixels at the coordinates x=832 y=344 and x=1024 y=872 in your pictures, each of them 2 pixels wide and high, you should enter this string: \"832,344,2 1024,872,2\". "; my $metF = $interpW->Frame()->pack(-fill =>'x', -padx => 0, -pady => 0); $metF->Label(-text => "Interpolation method", -bg => $config{ColorBG})->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); my $methB = $metF->Optionmenu(-textvariable => \$method, -options => [qw(average linear quadratic cubic)] )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 0); $interpW->Label(-text => "Pixel block specification", -bg => $config{ColorBG})->pack(-anchor => 'w', -padx => 3, -pady => 3); my $entry = $interpW->Entry(-textvariable => \$deadpixels, -width => 70, )->pack(-fill => 'x', -expand => "1", -padx => 3, -pady => 3); $entry->xview('end'); $entry->icursor('end'); buttonBackup($interpW, 'top'); buttonComment($interpW, 'top'); my $ButF = $interpW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $interpW->withdraw(); $interpW->destroy(); $config{DeadPixelMethod} = $method; $config{DeadPixelStr} = $deadpixels; $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => "Help", -command => sub { showText("Infos about Jpegpixi", $infotext, NO_WAIT); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $interpW->withdraw(); $interpW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $interpW->bind('', sub { $Xbut->invoke; }); $interpW->bind('', sub { $Xbut->invoke; }); $interpW->Popup; $interpW->waitWindow; return $rc; } ############################################################## # fuzzyBorder - add a fuzzy border to the selected pics ############################################################## sub fuzzyBorder { my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($dpic, $i); return if (!fuzzyBorderDialog()); my $bw = $config{FuzzyBorderWidth}; my $frame = "$trashdir/framePic.miff"; # we need MIFF or PNG because of the alpha channel removeFile($frame); return if (!checkExternProgs("fuzzyBorder", "convert", "composite")); $userinfo = "adding fuzzy border to $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Adding fuzzy border"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); progressWinUpdate($pw, "creating border ($i/$selected) ...", $i, $selected); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); # get size of pic my ($x, $y) = getSize($dpic); # create an empty picture with a fuzzy frame my $command = "convert -size ${x}x${y} xc:none -fill ".$config{FuzzyBorderColor}." "; #$command .= "-draw \'rectangle 0,0 $x,$bw\' "; # upper #$command .= "-draw \'rectangle 0,".($y-$bw)." $x,$y\' "; # lower #$command .= "-draw \'rectangle 0,0 $bw,$y\' "; # left #$command .= "-draw \'rectangle ".($x-$bw).",0 $x,$y\' "; # right border # windows needs " instead of ' $command .= "-draw \"rectangle 0,0 $x,$bw\" "; # upper $command .= "-draw \"rectangle 0,".($y-$bw)." $x,$y\" "; # lower $command .= "-draw \"rectangle 0,0 $bw,$y\" "; # left $command .= "-draw \"rectangle ".($x-$bw).",0 $x,$y\" "; # right border $command .= "-blur 0x".$config{FuzzyBorderBlur}." \"$frame\" "; if (!$EvilOS) { execute($command); } else { # else we run in a timeout (system "$command") == 0 or warn "fuzzy frame: $command failed: $!"; } unless (-f $frame) { warn "fuzzyBorder: could not create fuzzy border, skipping $dpic!\n"; next; } progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); # compose the frame on top of the picture $command = "composite -quality ".$config{PicQuality}." -compose Atop \"$frame\" \"$dpic\" \"$dpic\" "; if (!$EvilOS) { execute($command); } else { # else we run in a timeout (system "$command") == 0 or warn "fuzzy frame: $command failed: $!"; } $i++; progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); removeFile($frame); reselect($picLB, @sellist); $userinfo = "ready! (added fuzzy border to $i of $selected)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # fuzzyBorderDialog ############################################################## sub fuzzyBorderDialog { if (Exists($fuzzybw)) { $fuzzybw->deiconify; $fuzzybw->raise; return; } my $rc = 0; # open window $fuzzybw = $top->Toplevel(); $fuzzybw->title("Fuzzy border"); $fuzzybw->iconimage($mapiviicon) if $mapiviicon; my $bS = labeledScale($fuzzybw, 'top', 23, "Border width (pixel)", \$config{FuzzyBorderWidth}, 1, 200, 1); my $fS = labeledScale($fuzzybw, 'top', 23, "Blur radius (pixel)", \$config{FuzzyBorderBlur}, 1, 200, 1); my $cB = labeledEntryColor($fuzzybw,'top',23,"Border color",'Set',\$config{FuzzyBorderColor}); my $qS = labeledScale($fuzzybw, 'top', 23, "Quality of picture (%)", \$config{PicQuality}, 10, 100, 1); qualityBalloon($qS); buttonBackup($fuzzybw, 'top'); buttonComment($fuzzybw, 'top'); my $ButF = $fuzzybw->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $fuzzybw->withdraw(); $fuzzybw->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $fuzzybw->withdraw(); $fuzzybw->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $fuzzybw->bind('', sub { $Xbut->invoke; }); $fuzzybw->bind('', sub { $Xbut->invoke; }); $fuzzybw->Popup; $fuzzybw->waitWindow; return $rc; } ############################################################## # losslessBorder - add a frame to the selected pics without # recompressing the picture ############################################################## sub losslessBorder { my $mode = shift; # PIXEL, ASPECT_RATIO, RELATIVE (%) # check if jpegtran supports lossless dropping my $usage = `jpegtran -? 2>&1`; if ($usage !~ m/.*-drop.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.", -title => "Wrong jpegtran version", -type => 'OK'); return; } return if (!checkExternProgs("losslessBorder", "convert")); my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($dpic, $i); my $aspectdelta = 1 + ($config{AspectSloppyFactor} / 100); # delta factor for aspect ratio my $info = ''; my $bix = 0; # inner width X my $biy = 0; # inner width Y my $bwx = 0; # complete width X my $bwy = 0; # complete width Y if ($mode == PIXEL) { my ($w, $h) = getSize($sellist[0]); # get size of first picture return if (!losslessBorderDialogPixel($w, $h)); $bix = $config{llBorderWidthIX}; # inner width X $biy = $config{llBorderWidthIY}; # inner width Y $bwx = $config{llBorderWidthX}; # complete width X $bwy = $config{llBorderWidthY}; # complete width Y # no frame width-> nothing to do. return if ($bwx == 0 and $bwy == 0); } elsif ($mode == ASPECT_RATIO) { return if (!losslessBorderDialogAspect()); } elsif ($mode == RELATIVE) { return if (!losslessBorderDialogRelative()); } else { warn "Sorry mode $mode is not supported!"; return; } my $frame = "$trashdir/framePic.jpg"; if (-f $frame) { warn "file $frame exists! Please delete it first!"; return; } $userinfo = "adding lossless border to $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $pw = progressWinInit($top, "Adding lossless border"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); $i++; progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); if ($mode == ASPECT_RATIO) { # get size of dpic my ($w, $h) = getSize($dpic); my $n = $config{AspectBorderN}; my $m = $config{AspectBorderM}; # skip pictures which have (nearly) the right aspect ratio (either n/m or m/n) # and be a little bit sloppy about this (aspectdelta) if (((($w/$h) <= ($n/$m)*$aspectdelta) and (($w/$h) >= ($n/$m)/$aspectdelta)) or ((($w/$h) <= ($m/$n)*$aspectdelta) and (($w/$h) >= ($m/$n)/$aspectdelta))) { $info .= "$dpic has correct aspect ratio - skipping\n"; next; } if ($w > $h) { # landscape picture if ($w > $h*$n/$m) { # panorama picture (too wide) $bwx = 0; $bwy = int(($w*$m/$n -$h)/2); } elsif ($w < $h*$n/$m) { # too narrow $bwx = int(($h*$n/$m -$w)/2); $bwy = 0; } else { # already right aspect ratio next; } } else { # portrait and square picture if ($w > $h*$m/$n) { # panorama picture (too small) $bwx = 0; $bwy = int(($w*$n/$m -$h)/2); } elsif ($w < $h*$m/$n){ # too tall $bwx = int(($h*$m/$n -$w)/2); $bwy = 0; } else { # already right aspect ratio $info .= "$dpic has correct aspect ratio - skipping\n"; next; } } # we need 16 pixel steps for the complete border width $bwx = sprintf("%.0f", $bwx / 16) * 16; # int() does not round! $bwy = sprintf("%.0f", $bwy / 16) * 16; } # add a border relative to the picture size if ($mode == RELATIVE) { # get size of dpic my ($w, $h) = getSize($dpic); # we need 16 pixel steps for the complete border width $bwx = sprintf("%.0f",($config{RelativeBorderX} * $w / (100 * 16))) * 16; # int() does not round! $bwy = sprintf("%.0f",($config{RelativeBorderY} * $h / (100 * 16))) * 16; if (($bwx == 0) and ($bwy == 0)) { $info .= "$dpic border would be 0 pixel - skipping\n"; next; } $bix = sprintf("%.0f",($config{RelativeBorderIX} * $w / 100)); $biy = sprintf("%.0f",($config{RelativeBorderIY} * $h / 100)); # correction: add at least one pixel #$bwx = 1 if ($config{RelativeBorderX} > 0 and $bwx == 0); #$bwy = 1 if ($config{RelativeBorderY} > 0 and $bwy == 0); $bix = 1 if ($config{RelativeBorderIX} > 0 and ($bix == 0)); $biy = 1 if ($config{RelativeBorderIY} > 0 and ($biy == 0)); if ($config{RelativeBorderEqual}) { $bix = $biy if ($biy > $bix); $biy = $bix; $bwx = $bwy if ($bwy > $bwx); $bwy = $bwx; } } next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); # approach 1: # create an empty picture with a frame # this is the better approach as a new background is generated, but something with the color resolution(?) is wrong # because when the other picture is dropped on this one jpegtran changes the whole picture to grayscale #my $command = "convert -size ${cx}x${cy} xc:\"".$config{llBorderColor}."\" -fill \"".$config{llBorderColorI}."\" "; #$command .= "-draw \'rectangle $r1,$r1 $rx2,$ry2\' -quality 95 \"$frame\" "; # approach 2: # add a lossy frame to the original picture # not the fastes way, but it works my $box = $bwx - $bix; # outer border width my $boy = $bwy - $biy; # outer border width #print "losslessBorder: bwx $bwx bwy $bwy box $box boy $boy bix $bix biy $biy\n"; my $command = "convert "; $command .= "-bordercolor \"".$config{llBorderColorI}."\" -border ${bix}x${biy} " if (($bix > 0) or ($biy > 0)); $command .= "-bordercolor \"".$config{llBorderColor}."\" -border ${box}x${boy} -quality 95 \"$dpic\" \"$frame\" "; execute($command); unless (-f $frame) { $info .= "$dpic: could not create lossless border - skipping\n"; next; } progressWinUpdate($pw, "adding border ($i/$selected) ...", $i, $selected); # drop the picture lossless! on top of the frame # no recompression of the picture! $command = "jpegtran -copy all -drop +${bwx}+${bwy} \"$dpic\" -outfile \"$dpic\" \"$frame\" "; execute($command); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); removeFile($frame); reselect($picLB, @sellist); $userinfo = "ready! (added lossless border to $i of $selected)"; $userInfoL->update; if ($info ne '') { showText('Add Border Information', $info, NO_WAIT); } generateThumbs(ASK, SHOW); } ############################################################## # losslessBorderDialogPixel ############################################################## sub losslessBorderDialogPixel { my $w = shift; # pixel size of first selcted picture for preview my $h = shift; if (Exists($ll_b_w)) { $ll_b_w->deiconify; $ll_b_w->raise; return; } my $rc = 0; # open window $ll_b_w = $top->Toplevel(); $ll_b_w->title("Add lossless border"); $ll_b_w->iconimage($mapiviicon) if $mapiviicon; my $fb = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes."); my $fbi = $ll_b_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border."); labeledScale($fb, 'top', 35, "Complete border width x-direction", \$config{llBorderWidthX}, 0, 1000, 16); labeledScale($fb, 'top', 35, "Complete border width y-direction", \$config{llBorderWidthY}, 0, 1000, 16); labeledEntryColor($fb,'top',35,"Border color",'Set',\$config{llBorderColor}); labeledScale($fbi, 'top', 35, "Inner border width x-direction", \$config{llBorderWidthIX}, 0, 1000, 1); labeledScale($fbi, 'top', 35, "Inner border width y-direction", \$config{llBorderWidthIY}, 0, 1000, 1); labeledEntryColor($fbi,'top',35,"Inner border color",'Set',\$config{llBorderColorI}); buttonBackup($ll_b_w, 'top'); buttonComment($ll_b_w, 'top'); my $preF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); $preF->Label(-text => 'Preset ')->pack(-side => 'left'); $preF->Button(-text => '1 B/W', -command => sub {$config{llBorderWidthX} = 100; $config{llBorderWidthY} = 100; $config{llBorderColor} = 'black'; $config{llBorderWidthIX} = 2; $config{llBorderWidthIY} = 2; $config{llBorderColorI} = 'white'; })->pack(-side => 'left'); $preF->Button(-text => '2 W/B', -command => sub {$config{llBorderWidthX} = 100; $config{llBorderWidthY} = 100; $config{llBorderColor} = 'white'; $config{llBorderWidthIX} = 2; $config{llBorderWidthIY} = 2; $config{llBorderColorI} = 'black'; })->pack(-side => 'left'); $preF->Button(-text => '3 P W/B', -command => sub {$config{llBorderWidthX} = 0; $config{llBorderWidthY} = 100; $config{llBorderColor} = 'white'; $config{llBorderWidthIX} = 0; $config{llBorderWidthIY} = 2; $config{llBorderColorI} = 'black'; })->pack(-side => 'left'); $preF->Button(-text => '4 P B/W', -command => sub {$config{llBorderWidthX} = 0; $config{llBorderWidthY} = 100; $config{llBorderColor} = 'black'; $config{llBorderWidthIX} = 0; $config{llBorderWidthIY} = 2; $config{llBorderColorI} = 'white'; })->pack(-side => 'left'); my $ButF = $ll_b_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { # some checks if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or ($config{llBorderWidthIY} > $config{llBorderWidthY})) { $ll_b_w->messageBox(-icon => 'warning', -message => 'The inner border must be smaller than the complete border.', -title => 'Lossess border - Error', -type => 'OK'); return; } $ll_b_w->withdraw(); $ll_b_w->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'Preview', -command => sub { # some checks if (($config{llBorderWidthIX} > $config{llBorderWidthX}) or ($config{llBorderWidthIY} > $config{llBorderWidthY})) { $ll_b_w->messageBox(-icon => 'warning', -message => 'The inner border must be smaller than the complete border.', -title => 'Lossess border - Error', -type => 'OK'); return; } border_preview($w, $h, $config{llBorderWidthX}, $config{llBorderWidthY}, $config{llBorderColor}, $config{llBorderWidthIX}, $config{llBorderWidthIY}, $config{llBorderColorI}); })->pack(-side => 'left', -padx => 3, -pady => 3); $ButF->Button(-text => 'Help', -command => sub { showText('Help for lossless border', "This function can be used to add a border to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", NO_WAIT); })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $ll_b_w->withdraw(); $ll_b_w->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ll_b_w->bind('', sub { $Xbut->invoke; }); $ll_b_w->bind('', sub { $Xbut->invoke; }); $ll_b_w->Popup; $ll_b_w->waitWindow; return $rc; } ############################################################## # border_preview - quick preview in correct proportions, but # without rescaling the real picture (would # take too much time). ############################################################## sub border_preview { my $w = shift; # picture size my $h = shift; my $bx = shift; # complete border size my $by = shift; my $bc = shift; # border color my $bix = shift; # inner border size my $biy = shift; my $bic = shift; # inner border color my $c; # Canvas unless (Exists($bpw)) { # open window $bpw = $top->Toplevel(); $bpw->title('Border Preview'); $bpw->iconimage($mapiviicon) if $mapiviicon; my $fa = $bpw->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $bpw->{c} = $fa->Canvas(-width => 100, -height => 100, -background => 'gray', -relief => 'sunken', )->pack(-padx => 3, -pady => 3); my $Xbut = $bpw->Button(-text => 'Close', -command => sub { $bpw->withdraw(); $bpw->destroy(); })->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); } $bpw->deiconify; $bpw->raise; my $wc = $w + 2 * $bx; # complete width my $hc = $h + 2 * $by; # complete height # clear canvas $bpw->{c}->delete('all'); my $per = 0.8; # preview canvas should be 80% of the min screen size my $preview_size = int($per * $top->screenwidth); $preview_size = int($per * $top->screenheight) if ($top->screenheight < $top->screenwidth); my $max_side = $wc; $max_side = $hc if ($hc > $wc); # longest side if ($max_side == 0) { warn "border_preview: Error max_side = $max_side"; return; } my $scale = $preview_size / $max_side; $scale = 1 if ($scale > 1); # we don't want to magnify small pictures $bpw->{c}->configure(-width => sprintf("%.0f",($wc*$scale)), -height => sprintf("%.0f",($hc*$scale)),); # outer border $bpw->{c}->createRectangle( 0, 0, sprintf("%.0f",($wc*$scale)), sprintf("%.0f",($hc*$scale)), -fill => $bc, -width => 0, ); # inner border if (($bix > 0) or ($biy > 0)) { $bpw->{c}->createRectangle( sprintf("%.0f",(($bx-$bix)*$scale)), sprintf("%.0f",(($by-$biy)*$scale)), sprintf("%.0f",(($bx+$w+$bix)*$scale)), sprintf("%.0f",(($by+$h+$biy)*$scale)), -fill => $bic, -width => 0, ); } # picture $bpw->{c}->createRectangle( sprintf("%.0f",($bx*$scale)), sprintf("%.0f",($by*$scale)), sprintf("%.0f",(($bx+$w)*$scale)), sprintf("%.0f",(($by+$h)*$scale)), -fill => 'gray50', -width => 0, ); my $font = $top->Font(-family => $config{FontFamily}, -size => 40, -weight => 'bold'); $bpw->{c}->createText(int(($bx+$w/2)*$scale), int(($by+$h/2)*$scale), -text => 'Picture', -fill => 'black', -font => $font, -anchor => 'c'); } ############################################################## # losslessBorderDialogRelative ############################################################## sub losslessBorderDialogRelative { if (Exists($ll_r_w)) { $ll_r_w->deiconify; $ll_r_w->raise; return; } my $rc = 0; # open window $ll_r_w = $top->Toplevel(); $ll_r_w->title("Add relative border (lossless)"); $ll_r_w->iconimage($mapiviicon) if $mapiviicon; my $fb = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes."); my $fbi = $ll_r_w->Frame(-relief => 'groove')->pack(-fill => 'x', -padx => 3, -pady => 3); $balloon->attach($fbi, -msg => "This is the width of the inner border in x- and y-direction.\nSet to 0 for no inner border."); labeledScale($fb, 'top', 37, "Complete border width x-direction (%)", \$config{RelativeBorderX}, 0, 100, 0.1); labeledScale($fb, 'top', 37, "Complete border width y-direction (%)", \$config{RelativeBorderY}, 0, 100, 0.1); labeledEntryColor($fb,'top',37,"Border color",'Set',\$config{llBorderColor}); labeledScale($fbi, 'top', 37, "Inner border width x-direction (%)", \$config{RelativeBorderIX}, 0, 100, 0.01); labeledScale($fbi, 'top', 37, "Inner border width y-direction (%)", \$config{RelativeBorderIY}, 0, 100, 0.01); labeledEntryColor($fbi,'top',37,"Inner border color",'Set',\$config{llBorderColorI}); $ll_r_w->Checkbutton(-text => 'Symmetric border (biggest wins)', -variable => \$config{RelativeBorderEqual})->pack(-anchor => 'w', -padx => 5, -pady => 5); buttonBackup($ll_r_w, 'top'); buttonComment($ll_r_w, 'top'); my $ButF = $ll_r_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { # some checks if (($config{RelativeBorderIX} > $config{RelativeBorderX}) or ($config{RelativeBorderIY} > $config{RelativeBorderY})) { $ll_r_w->messageBox(-icon => 'warning', -message => 'The inner border must be smaller than the complete border.', -title => 'Lossess border - Error', -type => 'OK'); return; } $ll_r_w->withdraw(); $ll_r_w->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'Help', -command => sub { showText('Help for relative border (lossless)', "This function can be used to add a border to a JPEG without losing quality due to recompressing.\nThe actual border width in pixel will be calculated depending on the picture size. As JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps.\nThe inner border may be have any width, set it to 0 to have just one frame. If the inner border is bigger than 0, then it will be at least one pixel.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", NO_WAIT); })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $ll_r_w->withdraw(); $ll_r_w->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ll_r_w->bind('', sub { $Xbut->invoke; }); $ll_r_w->bind('', sub { $Xbut->invoke; }); $ll_r_w->Popup; $ll_r_w->waitWindow; return $rc; } ############################################################## # losslessBorderDialogAspect ############################################################## sub losslessBorderDialogAspect { if (Exists($ll_a_w)) { $ll_a_w->deiconify; $ll_a_w->raise; return; } my $rc = 0; # open window $ll_a_w = $top->Toplevel(); $ll_a_w->title("Add border to aspect ratio (lossless)"); $ll_a_w->iconimage($mapiviicon) if $mapiviicon; my $oF = $ll_a_w->Frame(-relief => 'groove')->pack(-expand => 1, -fill => 'x', -padx => 3, -pady => 3); $oF->Label(-text => 'Aspect ratio ')->pack(-side => 'left', -padx => 3, -pady => 3); $oF->Entry(-textvariable => \$config{AspectBorderN}, -width => 5, -justify => 'right')->pack(-side => 'left', -padx => 3, -pady => 3); $oF->Label(-text => ':')->pack(-side => 'left', -padx => 3, -pady => 3); $oF->Entry(-textvariable => \$config{AspectBorderM}, -width => 5)->pack(-side => 'left', -padx => 3, -pady => 3); #labeledEntry($oF,'left',17,': Aspect ratio M',\$config{AspectBorderM}); my $aF = $ll_a_w->Frame(-relief => 'groove')->pack(-padx => 3, -pady => 3); $aF->Label(-text => 'Presets')->pack(); $aF->Button(-text => "3:2 (e.g. 10x15)", -anchor => 'w', -command => sub { $config{AspectBorderN} = 3; $config{AspectBorderM} = 2; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); $aF->Button(-text => "4:3", -anchor => 'w', -command => sub { $config{AspectBorderN} = 4; $config{AspectBorderM} = 3; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); $aF->Button(-text => "5:4 (PAL)", -anchor => 'w', -command => sub { $config{AspectBorderN} = 5; $config{AspectBorderM} = 4; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); $aF->Button(-text => "7:5 (e.g. 13x18)", -anchor => 'w', -command => sub { $config{AspectBorderN} = 7; $config{AspectBorderM} = 5; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); $aF->Button(-text => "16:9", -anchor => 'w', -command => sub { $config{AspectBorderN} = 16; $config{AspectBorderM} = 9; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); $aF->Button(-text => "1:1", -anchor => 'w', -command => sub { $config{AspectBorderN} = 1; $config{AspectBorderM} = 1; } )->pack(-anchor => 'w', -fill => 'x', -padx => 3, -pady => 3); labeledEntryColor($ll_a_w,'top',12,'Border color','Set',\$config{llBorderColor}); buttonBackup($ll_a_w, 'top'); buttonComment($ll_a_w, 'top'); my $ButF = $ll_a_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { # some checks if (($config{AspectBorderM} !~ m|^\d+$|) or # must be an integer ($config{AspectBorderN} !~ m|^\d+$|)) { $ll_a_w->messageBox(-icon => 'warning', -message => 'Aspect ratio must be a natural number', -title => 'Aspect ratio border - Error', -type => 'OK'); return; } if (($config{AspectBorderM} <= 0) or ($config{AspectBorderN} <= 0)) { $ll_a_w->messageBox(-icon => 'warning', -message => 'Aspect ratio must be positive and bigger than 0', -title => 'Aspect ratio border - Error', -type => 'OK'); return; } $ll_a_w->withdraw(); $ll_a_w->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ButF->Button(-text => 'Help', -command => sub { showText('Help for lossless aspect ratio border', "This function can be used to add a border to a JPEG to fit the selected aspect ratio without losing quality due to recompressing.\nAs JPEGs are organized in 8 or 16 pixel blocks the complete border width will be in 16 pixel-steps. Thus the resulting picture will not always match the selected aspect ratio.\n\nHow it works:\nIt will first create a background with the border and then drop the original picture on top of it. The picture is not recompressed and thus every pixel stays exactly the same. The tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a border to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you crop the border away and compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black no pixel was changed.\nYou may check this again with a lossy border to see the differences.", NO_WAIT); })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $ll_a_w->withdraw(); $ll_a_w->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ll_a_w->bind('', sub { $Xbut->invoke; }); $ll_a_w->bind('', sub { $Xbut->invoke; }); $ll_a_w->Popup; $ll_a_w->waitWindow; return $rc; } ############################################################## # losslessWatermark - add a watermark to the selected pics # without recompressing the whole picture ############################################################## sub losslessWatermark { # check if jpegtran supports lossless dropping my $usage = `jpegtran -? 2>&1`; if ($usage !~ m/.*-drop.*/) { $top->messageBox(-icon => 'warning', -message => "Sorry, but your version of jpegtran does not support lossless dropping!\nTry to get jpegtran with the lossless drop patch from http://jpegclub.org.", -title => "Wrong jpegtran version", -type => 'OK'); return; } # todo: # 1. Select a part of the picture with e.g. the crop dialog # 2. Select a font and size and enter a text # 3. crop the selected part out of the picture # 4. add the text to the crop: # convert crop.jpg -pointsize 120 -fill white -gravity center # -annotate 0 'Mapivi' -quality 95 crop2.jpg # 5. lossless drop the crop at the same position # benefit: as color sampling is from original picture there should # be no problem with lossless drop my @sellist = $picLB->info('selection'); return unless checkSelection($top, 1, 0, \@sellist); my $selected = @sellist; my ($dpic, $i); return if (!losslessWatermarkDialog()); my $wmx = $config{llWatermarkX}; # X position my $wmy = $config{llWatermarkY}; # Y position my $file = $config{llWatermarkFile}; # the picture to add # get size of watermark pic my ($wmw, $wmh) = getSize($file); $userinfo = "adding lossless watermark to $selected pictures"; $userInfoL->update; # check if some files are links return if (!checkLinks($picLB, @sellist)); my $error = ''; my $pw = progressWinInit($top, "Adding lossless watermark"); $i = 0; foreach $dpic (@sellist) { last if progressWinCheck($pw); progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected); next if (!checkWriteable($dpic)); next if (!makeBackup($dpic)); # todo: either just drop a existing pic or # 1. crop a part of the picture -> cropPic($dpic,$w,$h,$x,$y,95); # 2. write a text on this crop -> convert crop.jpg -pointsize 50 -gravity south -stroke '#000C' -strokewidth 2 -annotate 0 'Martin' -stroke none -fill white -annotate 0 'Martin' crop-text.jpg # 3. drop it back on the same position # get size of pic my ($w, $h) = getSize($dpic); if (($wmx + $wmw > $w) or ($wmy + $wmh > $h)) { $error .= "$dpic: watermark out of picture - skipped\n"; next; } # drop the watermark lossless! on top of the picture # no recompression of the picture! my $position = ''; if ($wmx >= 0) { $position = "+"; } $position .= $wmx; if ($wmy >= 0) { $position .= "+"; } $position .= $wmy; # todo: still unclear what the -trim and -perfect switch does #my $command = "jpegtran -copy all -trim -perfect -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" "; my $command = "jpegtran -copy all -drop $position \"$file\" -outfile \"$dpic\" \"$dpic\" "; execute($command); $i++; progressWinUpdate($pw, "adding watermark ($i/$selected) ...", $i, $selected); if ($config{AddMapiviComment}) { $command =~ s/\"//g; $command = "Picture processed by Mapivi ($mapiviURL):\n".$command; addCommentToPic($command, $dpic, NO_TOUCH); } updateOneRow($dpic, $picLB); deleteCachedPics($dpic); showPic($dpic) if ($dpic eq $actpic); # redisplay the picture if it is the actual one } progressWinEnd($pw); if ($error ne '') { $error = "Some pictures caused errors:\n\n".$error; showText('Watermark errors', $error, NO_WAIT); } reselect($picLB, @sellist); $userinfo = "ready! (added lossless watermark to $i of $selected)"; $userInfoL->update; generateThumbs(ASK, SHOW); } ############################################################## # losslessWatermarkDialog ############################################################## sub losslessWatermarkDialog { if (Exists($ll_w_w)) { $ll_w_w->deiconify; $ll_w_w->raise; return; } my $rc = 0; # open window $ll_w_w = $top->Toplevel(); $ll_w_w->title("Add lossless watermark"); $ll_w_w->iconimage($mapiviicon) if $mapiviicon; #$balloon->attach($fb, -msg => "This is the overall width of the border in x- and y-direction.\nAs JPEGs are organized in 8 or 16 pixel blocks only 16 pixel-steps are allowed.\nUse the add-border function if you need other sizes."); labeledEntry($ll_w_w,'top',35,"x-position",\$config{llWatermarkX}); labeledEntry($ll_w_w,'top',35,"y-position",\$config{llWatermarkY}); labeledEntryButton($ll_w_w,'top',35,"Watermark picture (JPEG)",'Set', \$config{llWatermarkFile}); buttonBackup($ll_w_w, 'top'); buttonComment($ll_w_w, 'top'); my $ButF = $ll_w_w->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { # some checks unless (-f $config{llWatermarkFile}) { $ll_w_w->messageBox(-icon => 'warning', -message => 'The watermark picture could not be found.', -title => 'File not found', -type => 'OK'); return; } unless (is_a_JPEG($config{llWatermarkFile})) { $ll_w_w->messageBox(-icon => 'warning', -message => 'The watermark picture is no JPEG.', -title => 'File not found', -type => 'OK'); return; } $ll_w_w->withdraw(); $ll_w_w->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); # todo $ButF->Button(-text => 'Help', -command => sub { showText('Help for lossless watermark', "This function can be used to add a watermark (small graphic) to a JPEG without losing quality due to recompressing.\n\nHow it works:\nIt will drop the rectangular small watermark picture on top of the original picture. The picture is not recompressed and thus every pixel stays exactly the same. Both pictures must have the same JPEG sampling factors!\nThe tool jpegtran with the lossless drop patch is used for this task. See http://jpegclub.org.\n\nYou can check this by adding a watermark to a picture (don't forget to save the original picture by selecting \"Create Backup\") then you compare the original and the processed picture using the Mapivi function \"build difference picture\". If the resulting difference picture is complety black (except where the watermark was added) no pixel was changed.", NO_WAIT); })->pack(-side => 'left', -expand => 0, -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $ll_w_w->withdraw(); $ll_w_w->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $ll_w_w->bind('', sub { $Xbut->invoke; }); $ll_w_w->bind('', sub { $Xbut->invoke; }); $ll_w_w->Popup; $ll_w_w->waitWindow; return $rc; } ############################################################## # importWizard ############################################################## sub importWizard { if (Exists($wizW)) { $wizW->deiconify; $wizW->raise; return; } my $pics = shift; my $rc = 0; # open window $wizW = $top->Toplevel(); $wizW->title("Import pictures wizard"); $wizW->iconimage($mapiviicon) if $mapiviicon; my $i_text = $wizW->Scrolled("ROText", -scrollbars => 'osoe', -wrap => 'word', -width => 70, -height => 5, -relief => "flat", -bd => 0 )->pack(-fill => 'both', -expand => "0", -padx => 3, -pady => 3); $i_text->insert('end', "Import pictures from a removable device like e.g. a camera or a card reader connected via e.g. USB.\nThe selected actions will take place in the displayed order.\nMapivi is rather paranoid when importing pictures to be on the safe side.\nIf there are any errors during import (like a mismatch in the number of files or file size) you will be asked how to proceed."); my ($s,$m,$ho,$d,$mo,$y) = localtime(time()); # do some adjustments $y += 1900; $mo++; # build up the date string for the dir structure (e.g. "2007/10/29") my $date = sprintf "%04d/%02d/%02d", $y, $mo, $d; my $w = 32; my $w2 = $w - 3; labeledEntryButton($wizW,'top',$w,"Source folder",'Set',\$config{ImportSource}, 1); $wizW->Checkbutton(-variable => \$config{ImportSubdirs}, -anchor => 'w', -text => "Import from all sub folders, too" )->pack(-side => 'top', -anchor => 'w', -padx => 3, -pady => 3); labeledEntryButton($wizW,'top',$w,"Target folder (fix part)",'Set',\$config{ImportTargetFix}, 1); my $varF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); labeledEntry($varF,"left",$w,"Target folder (variable part)",\$config{ImportTargetVar}); $varF->Button(-text => 'Set' , -command => sub {$config{ImportTargetVar} = $date;})->pack(-side => "right", -padx => 3, -pady => 3); $varF->Label(-text => "actual date:", -anchor => "e", -bg => $config{ColorBG})->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); my $moreF = $wizW->Frame(-relief => 'groove'); my $more_button; $more_button = $wizW->Checkbutton(-variable => \$config{ImportMore}, -anchor => 'w', -text => 'more options', -command => sub { if ($config{ImportMore}) { $moreF->pack(-after => $more_button, -fill => 'x', -expand => 0, -padx => 4, -pady => 3); } else { $moreF->packForget(); } })->pack(-padx => 3, -anchor => 'w'); if ($config{ImportMore}) { $moreF->pack(-after => $more_button, -expand => 0, -fill => 'x', -padx => 4, -pady => 3); } else { $moreF->packForget(); } my $dpF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); my $dpC = $dpF->Checkbutton(-variable => \$config{ImportDeadPixel}, -anchor => 'w', -text => "Interpolate dead pixels" )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); my $dpB = $dpF->Button(-text => 'Set', -command => sub { interpolateDialog(); $wizW->raise; })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); if (missingProgs("Interpolate dead pixels", "jpegpixi")) { $config{ImportDeadPixel} = 0; # disabled if jpegpixi is not available $dpC->configure(-state => "disabled"); $dpB->configure(-state => "disabled"); $dpC->configure(-disabledforeground => 'gray30'); $dpB->configure(-disabledforeground => 'gray30'); $balloon->attach($dpF, -msg => explainMissingProg("Interpolate dead pixels", "jpegpixi")); } my $rot = $wizW->Checkbutton(-variable => \$config{ImportRotate}, -anchor => 'w', -text => "Automatic rotation (lossless)" )->pack(-anchor => 'w', -padx => 3, -pady => 3); if (missingProgs("Automatic rotation", "jhead") > 0) { $config{ImportRotate} = 0; # disabled if jhead is not available $rot->configure(-state => "disabled"); $rot->configure(-disabledforeground => 'gray30'); $balloon->attach($rot, -msg => explainMissingProg("Automatic rotation", "jhead")); } my $comF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); $comF->Checkbutton(-variable => \$config{NameComment}, -anchor => 'w', -text => "Add original file name to comment (" )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); $comF->Checkbutton(-variable => \$config{NameComRmSuffix}, -anchor => 'w', -text => "remove file suffix )" )->pack(-side => "left", -anchor => 'w', -padx => 0, -pady => 3); my $acomF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); $acomF->Checkbutton(-variable => \$config{ImportAddCom}, -anchor => 'w', -text => '', )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); labeledEntry($acomF,"left",$w,"Add this comment to each picture",\$config{ImportAddComment}); my $iptcF = $moreF->Frame()->pack(-anchor => 'w', -fill => 'x'); $iptcF->Checkbutton(-variable => \$config{ImportAddIPTC}, -anchor => 'w', -text => '', )->pack(-side => 'left', -anchor => 'w', -padx => 3, -pady => 3); labeledEntryButton($iptcF,'top',$w,"Add IPTC info to each picture",'Set',\$config{ImportIPTCTempl}); my $lockB = $moreF->Checkbutton(-variable => \$config{ImportMarkLocked}, -anchor => 'w', -text => "Add high rating to locked pictures" )->pack(-anchor => 'w', -padx => 3, -pady => 3); $balloon->attach($lockB, -msg => "Some digital cameras allow to lock pictures.\nThis feature can be used to mark important pictures already in the camera.\nIf this function is enabled Mapivi will add a high rating to all locked pictures\n(files with write protection)."); $moreF->Checkbutton(-variable => \$config{ImportDeleteCameraJunk}, -anchor => 'w', -text => "Delete camera junk files in target folder after copy (e.g. *.CTG)" )->pack(-anchor => 'w', -padx => 3, -pady => 3); my $renF = $wizW->Frame()->pack(-anchor => 'w', -fill => 'x'); $renF->Checkbutton(-variable => \$config{ImportRename}, -anchor => 'w', -text => "Smart Rename with this pattern:" )->pack(-side => "left", -anchor => 'w', -padx => 2, -pady => 3); $renF->Label(-textvariable => \$config{FileNameFormat}, -bg => $config{ColorBG}, -anchor => 'w', #-width => ($w2-2), )->pack(-side => "left", -anchor => 'w', -padx => 3, -pady => 3); $renF->Button(-text => 'Set', -command => sub { getRenameFormat(); })->pack(-side => "right", -anchor => 'w', -padx => 3, -pady => 3); $wizW->Checkbutton(-variable => \$config{ImportDelete}, -anchor => 'w', -text => "Delete files in source folder after copy" )->pack(-anchor => 'w', -padx => 3, -pady => 3); $wizW->Checkbutton(-variable => \$config{ImportShowPics}, -anchor => 'w', -text => "Show pictures when import finished" )->pack(-anchor => 'w', -padx => 3, -pady => 3); my $ButF = $wizW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $wizW->withdraw(); $wizW->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $wizW->withdraw(); $wizW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $wizW->bind('', sub { $Xbut->invoke; }); $wizW->Popup; $wizW->waitWindow; return if ($rc != 1); $rc = importPictures(); openDirPost($config{ImportTargetFix}."/".$config{ImportTargetVar}) if $config{ImportShowPics}; if ($rc) { $userinfo = "import finished successfully!"; } else { $userinfo = "import finished with errors!"; } $userInfoL->update; } my $printW; ############################################################## # copyToPrint - copy pics to print folders # (e.g. 2_times_5x7/ or 1_times_13x18/) ############################################################## sub copyToPrint { my $lb = shift; # the reference to the active listbox widget my @sellist = getSelection($lb); return unless checkSelection($top, 1, 0, \@sellist); if (Exists($printW)) { $printW->deiconify; $printW->raise; return; } my $pics = shift; my $rc = 0; # open window $printW = $lb->Toplevel(); $printW->title("copy pictures to print folder"); $printW->iconimage($mapiviicon) if $mapiviicon; $printW->Label(-text => "Copy ".scalar @sellist." pictures to a according print folder.", -bg => $config{ColorBG}, -justify => "left")->pack(-anchor => 'w', -padx => 3, -pady => 3); my $w = 32; my $w2 = $w - 3; my $times = 1; my $timesStr = "times"; my $size = "10x15"; labeledEntryButton($printW,'top',$w,"Print base folder",'Set',\$config{PrintBaseDir}, 1); my $sf = $printW->Frame()->pack(); $sf->Label(-text => "numer, string and size", -width => $w, -bg => $config{ColorBG}, -justify => "left")->pack(-side => "left"); $sf->Optionmenu(-textvariable => \$config{PrintTimes}, -options => [qw(1 2 3 4 5 6 7 8 9 10)], -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; }, )->pack(-side => "left", -anchor => 'w'); $sf->Optionmenu(-textvariable => \$config{PrintTimesStr}, -options => [qw(times mal - x _x_ _times_ _mal_ _prints_in_ _Abzuege_in_)], -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; }, )->pack(-side => "left", -anchor => 'w'); $sf->Optionmenu(-textvariable => \$config{PrintSize}, -options => [qw(4x6 5x7 8x10 11x14 9x13 10x15 13x18 18x27 30x40 50x70)], -command => sub { $config{PrintVarDir} = $config{PrintTimes}.$config{PrintTimesStr}.$config{PrintSize}; }, )->pack(-side => "left", -anchor => 'w'); labeledEntry($printW,'top',$w,"folder",\$config{PrintVarDir}); my $ButF = $printW->Frame()->pack(-fill =>'x', -padx => 3, -pady => 3); my $OKB = $ButF->Button(-text => 'OK', -command => sub { $printW->withdraw(); $printW->destroy(); $rc = 1; })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); my $Xbut = $ButF->Button(-text => 'Cancel', -command => sub { $rc = 0; $printW->withdraw(); $printW->destroy(); })->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 3, -pady => 3); $printW->bind('', sub { $Xbut->invoke; }); $printW->Popup; $printW->waitWindow; return if ($rc != 1); if (!-d $config{PrintBaseDir}) { my $rc = $top->messageBox(-icon => 'question', -message => $config{PrintBaseDir}." does not exist. Should I create it?", -title => "Create print base folder?", -type => 'OKCancel'); return if ($rc !~ m/Ok/i); eval { mkpath($config{PrintBaseDir}, 0, 0755) }; # 0 = no output, 0755 = access rights if ($@) { warn "Couldn't create ",$config{PrintBaseDir},": $@"; return; } } my $printdir = $config{PrintBaseDir}."/".$config{PrintVarDir}; print "copy pics to $printdir\n" if $verbose; makeDir($printdir, NO_ASK); # do not ask my $pw = progressWinInit($top, "Copy to print"); my $i = 0; foreach my $spic (@sellist) { last if progressWinCheck($pw); $i++; my $pic = basename($spic); my $tpic = "$printdir/$pic"; progressWinUpdate($pw, "copy ($i/".scalar @sellist.") ...", $i, scalar @sellist); if (!mycopy($spic, $tpic, ASK_OVERWRITE)) { # ask before overwrite warn "error in copy $pic!\n"; } } progressWinEnd($pw); $userinfo = "copy finished! ($i/".scalar @sellist.")"; $userInfoL->update; } ############################################################## # importPictures ############################################################## sub importPictures { my $source = $config{ImportSource}; ##### check source dir $userinfo = "checking folders ..."; $userInfoL->update; if (!-d $source) { $top->messageBox(-icon => 'warning', -message => "Sorry, but the source folder\n$source\ndoes not exists!\nPlease check, if the device is mounted.", -title => "Import pictures - Error", -type => 'OK'); return 0; } my @sdirs; # all dirs to process # add the sub dirs if ($config{ImportSubdirs}) { push @sdirs, getDirsRecursive($source); } push @sdirs, $source unless isInList($source, \@sdirs); # the source dir is the minimum # the target dir my $tdir = $config{ImportTargetFix}."/".$config{ImportTargetVar}; ##### check if target is available, create it if not makeDir($tdir, ASK) if (!-d $tdir); ##### check if target is now available if (!-d $tdir) { warn "$tdir not created!!!"; return 0; } #### get the IPTC template only once, before starting loop my $iptc; if ($config{ImportAddIPTC}) { if (defined $config{ImportIPTCTempl} and -f $config{ImportIPTCTempl}) { $iptc = retrieve($config{ImportIPTCTempl}); unless (defined $iptc) { $top->messageBox(-icon => 'warning', -message => "Sorry, but Mapivi could not retrieve IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.", -title => "Import pictures - Error", -type => 'OK'); return 0; } } else { $top->messageBox(-icon => 'warning', -message => "Sorry, but Mapivi could not find the IPTC template $config{ImportIPTCTempl}!\nPlease check, if the file is available.", -title => "Import pictures - Error", -type => 'OK'); return 0; } } # open log window if (Exists($impW)) { $impW->deiconify; $impW->raise; return 0; } # open window $impW = $top->Toplevel(); $impW->title("Import pictures log"); $impW->iconimage($mapiviicon) if $mapiviicon; my ($s,$m,$ho,$d,$mo,$y) = localtime(time()); my $time = sprintf "%02d:%02d:%02d", $ho, $m, $s; my $butF = $impW->Frame()->pack(-expand => 1, -fill =>'x'); $butF->Button(-text => "Close", -command => sub { $impW->withdraw(); $impW->destroy(); }, )->pack(-expand => 1, -side => "left", -fill => 'x'); my $stop = 0; my $stopB = $butF->Button(-text => "Stop", -command => sub { $stop = 1; } )->pack(-side => 'left', -anchor => 'w', -expand => 0,-padx => 1,-pady => 1); my $stopImg = $top->Photo(-file => "$configdir/StopPic.gif") if (-f "$configdir/StopPic.gif"); $stopB->configure(-image => $stopImg, -borderwidth => 0) if $stopImg; $stopB->configure(-state => "disabled"); my $dcount = 0; # progress of dirs my $pcount = 0; # progress of pics my $rating_count = 0; # counter for locked pictures with successfull added rating my $progF = $impW->Frame()->pack(-expand => 1, -fill =>'x'); $progF->Label(-text => "progress folders ", -bg => $config{ColorBG})->pack(-side => "left"); $progF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -length => 100, -padx => 0, -pady => 0, -variable => \$dcount, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => scalar @sdirs, -anchor => 'w', -from => 0, -to => scalar @sdirs, )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 2, -pady => 3); $progF->Label(-text => " pictures ", -bg => $config{ColorBG})->pack(-side => "left"); my $picProg = $progF->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', -length => 100, -padx => 0, -pady => 0, -variable => \$pcount, -colors => [0 => $config{ColorProgress}], -resolution => 1, -anchor => 'w', -from => 0, -to => 100, )->pack(-side => "left", -fill => 'x', -expand => 1, -padx => 2, -pady => 3); my $rotext = $impW->Scrolled("ROText", -scrollbars => 'oe', -wrap => 'word', -tabs => '4', -width => 90, -height => 30, )->pack(-fill => "both", -expand => 1, -padx => 1, -pady => 1); $rotext->tagConfigure("R",-foreground => "brown4"); $rotext->tagConfigure("G",-foreground => "DeepSkyBlue4"); $rotext->tagConfigure("B",-foreground => "blue4"); $impW->Popup; $rotext->insert('end', "$time starting import ...\n", "B"); $impW->update; $stopB->configure(-state => 'normal'); foreach $source (@sdirs) { last if $stop; $dcount++; $rotext->insert('end', "in folder ($dcount/".scalar @sdirs.") $source ...\n", "G"); $impW->update; ##### get and check files to import my @importfiles = getFiles($source); print "In dir $source are ".@importfiles." files\n" if $verbose; if (@importfiles <= 0) { $rotext->insert('end', " no pictures in this folder - skipping\n", "R"); $rotext->see('end'); next; } $picProg->configure(-to => scalar @importfiles, -blocks => scalar @importfiles); ##### copy all files from source to target $pcount = 0; my $sum = 0; # the sum of all files copied in MegaBytes my $startTime = Tk::timeofday(); foreach my $file (@importfiles) { last if $stop; $pcount++; my $size = getFileSize("$source/$file", NO_FORMAT)/(1024*1024); # get size in MegaBytes my $sizeF = sprintf "%.2f", $size; $rotext->insert('end', " ($pcount/".scalar @importfiles.") copy $file ($sizeF MB)\n"); $rotext->see('end'); $impW->update; mycopy("$source/$file", "$tdir/$file", ASK_OVERWRITE); if ($config{ImportMarkLocked}) { # if source file is write protected if (!-w "$source/$file") { # add rating 1 to target file my $meta = getMetaData("$tdir/$file", 'APP13'); my $iptc = $meta->get_app13_data('TEXTUAL', 'IPTC'); if ($iptc->{error}) { warn "IPTC segment of $file has errors!"; $rotext->insert('end', " locked picture, but IPTC segment has errors!\n"); } else { $iptc->{Urgency} = 1; $meta->set_app13_data($iptc, 'REPLACE', 'IPTC'); if (!$meta->save()) { $rotext->insert('end', " locked picture, but writing of rating failed!\n"); } else { $rotext->insert('end', " locked picture, setting rating to 1!\n"); $rating_count++; } } $rotext->see('end'); } } $sum += $size if (-f "$tdir/$file"); } my $duration = Tk::timeofday() - $startTime; # in seconds my $rate = $sum/$duration if ($duration > 0); # MegaBytes/second my $string = sprintf "The transfer of %.2f MB took %.2f seconds; transferrate %.2f MB/s\n", $sum, $duration, $rate; $rotext->insert('end', $string); $rotext->see('end'); ##### check if the copy was successfull my $filediff = 0; my $sizediff = 0; # check if every source file is in the target dir and if the file size is the same foreach (@importfiles) { $filediff++ if (!-f "$tdir/$_"); $sizediff++ if (getFileSize("$tdir/$_", NO_FORMAT) != getFileSize("$source/$_", NO_FORMAT)); } if (($filediff > 0) or ($sizediff > 0)) { my $rating_info = ""; $rating_info = "$rating_count locked pictures found and rating added. This will increase the file size and may explain the difference.\n"; my $rc = $top->messageBox(-icon => 'question', -message => "Not all files in the source and target folder are eqal.\n$filediff files are missing and $sizediff files have another size.\n${rating_info}Should I continue?", -title => "Continue importing pictures?", -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } ##### get the imported JPEG pictures (from the source dir!!!) # no questions about NON-JPEGS while importing please! my $tmp = $config{CheckForNonJPEGs}; $config{CheckForNonJPEGs} = 0; my @piclist = getPics($source, JUST_FILE); # no sort needed $config{CheckForNonJPEGs} = $tmp; ##### process JPEGS if ($config{ImportDeadPixel} or $config{ImportRotate} or $config{ImportRename} or $config{NameComment} or $config{ImportAddCom} or $config{ImportAddIPTC}) { my $command = ""; my @renamed; $pcount = 0; foreach (@piclist) { last if $stop; $pcount++; my $pic = $_; my $dpic = "$tdir/$pic"; $rotext->insert('end', " ($pcount/".scalar @piclist.") $pic ", "G"); $rotext->see('end'); if (!-f $dpic) { $rotext->insert('end', " *** $dpic is missing - skipping! ***", "R"); $rotext->see('end'); warn "importPictures: $dpic is missing - skipping!\n"; next; } my $tmppic = "$dpic"."-cjpg"; # temporary file ############################################################## ##### interpolate dead pixels if ($config{ImportDeadPixel}) { if (checkWriteable($dpic)) { # check if temp file exists if (checkTempFile($tmppic)) { $rotext->insert('end', "interpolating, "); $rotext->see('end'); # call external command jpegpixi $command = "jpegpixi -m ".$config{DeadPixelMethod}." \"$dpic\" \"$tmppic\" ".$config{DeadPixelStr}; print "command = $command\n" if $verbose; execute($command); # now overwrite the original pic with the temp file and delete the temp file overwrite("$dpic", "$tmppic"); } else { warn "importPictures: problem with temppic ($tmppic)"; } } else { warn "importPictures: picture $pic is not writeable"; } } ############################################################## ##### auto rotate pics if ($config{ImportRotate}) { $rotext->insert('end', "rotating, "); $rotext->see('end'); $command = "jhead -autorot \"$dpic\" "; print "command = $command\n" if $verbose; execute($command); } ############################################################## ##### add file name to comment if ($config{NameComment}) { $rotext->insert('end', "adding name to comment, "); $rotext->see('end'); my $com = $pic; if (($config{NameComRmSuffix}) and ($pic =~ /(.*)(\.jp(g|eg))/i)) { $com = $1; # just the file name without .jp(e)g suffix } # add the filename as comment addCommentToPic($com, $dpic, NO_TOUCH) if ($com ne ""); } ############################################################## ##### add IPTC template to picture if ($config{ImportAddIPTC} and defined $config{ImportIPTCTempl} and -f $config{ImportIPTCTempl}) { $rotext->insert('end', "adding IPTC, "); $rotext->see('end'); # add IPTC to pic my $meta = getMetaData($dpic, 'APP13'); if (defined $meta) { # todo, we could also use UPDATE or REPLACE here $meta->set_app13_data($iptc, 'ADD', 'IPTC'); # make the SupplementalCategories and Keywords unique and sorted uniqueIPTC($meta); $meta->save(); } } ############################################################## ##### add comment to picture if ($config{ImportAddCom} and defined $config{ImportAddComment} and $config{ImportAddComment} ne '') { $rotext->insert('end', "adding comment, "); $rotext->see('end'); # add comment to pic addCommentToPic($config{ImportAddComment}, $dpic, NO_TOUCH); } ############################################################## ##### smart rename pics if ($config{ImportRename}) { $rotext->insert('end', "renaming "); $rotext->see('end'); my $newname = ""; my $doForAll = 1; # use the file date, if there is no EXIF date without asking my $rc = applyRenameFormat($dpic, $config{FileNameFormat}, \$newname, \$doForAll); $newname = findNewName("$tdir/$newname"); if (($rc ne "Skip this picture") and ($rc ne "Cancel all")) { if (-f "$tdir/$newname") { # just a safety check warn "$newname already exists - skipping\n"; next; } print "renaming from $pic to $newname\n" if $verbose; # rename the picture if (!rename ($dpic, "$tdir/$newname")) { # rename failed $top->messageBox(-icon => 'warning', -message => "Could not rename $pic to $newname: $!", -title => 'Error', -type => 'OK'); } else { # todo: rename raw pics as option (but how to handle renameSmartFix? push @renamed, "$tdir/$newname"; } } } $rotext->insert('end', "\n"); $rotext->see('end'); $rotext->update; } # foreach pics end my $errors = ""; renameSmartFix(\$errors, @renamed) if $config{ImportRename}; } $stopB->configure(-state => "disabled"); ############################################################## ##### delete worthless camera state files if ($config{ImportDeleteCameraJunk}) { my @junkfiles = grep {m/.*\.($cameraJunkSuffixes)$/i} @importfiles; $pcount = 0; $stopB->configure(-state => 'normal'); foreach (@junkfiles) { last if $stop; $pcount++; $rotext->insert('end', " ($pcount/".scalar @junkfiles.") deleting $_\n"); $rotext->see('end'); $rotext->update; removeFile("$tdir/$_"); } $stopB->configure(-state => "disabled"); } ############################################################## ##### delete imported pics if ($config{ImportDelete}) { # check if everything is alright if (($filediff > 0) or ($sizediff > 0)) { my $rc = $top->messageBox(-icon => 'question', -message => "There have been some warnings while importing.\nShould I continue and delete the ".scalar @importfiles." files in the source folder?", -title => "Continue?", -type => 'OKCancel'); return 0 if ($rc !~ m/Ok/i); } $pcount = 0; $stopB->configure(-state => 'normal'); # remove the pics on the source dir foreach (@importfiles) { last if $stop; $pcount++; $rotext->insert('end', " ($pcount/".scalar @importfiles.") deleting $_\n"); $rotext->see('end'); $rotext->update; removeFile("$source/$_"); } } } # foreach dirs end $stopB->configure(-state => "disabled"); ($s,$m,$ho,$d,$mo,$y) = localtime(time()); $time = sprintf "%02d:%02d:%02d", $ho, $m, $s; $rotext->insert('end', "$time import finished!\n", "B"); $rotext->see('end'); $rotext->update; return 1; } ############################################################## # dock_keyword_dialog ############################################################## sub dock_keyword_dialog { # only if dock is selected return unless ($config{KeywordDialogDock}); # and the keyword dialog is open return unless (Exists($keyw)); # get coordinates of main window my $geo = $top->geometry; my ($tw, $th, $tx, $ty) = splitGeometry($geo); # take the border and menubar into account my $rootx = $top->rootx; my $borderx = $rootx-$tx; # get coordinates of keyword window $geo = $keyw->geometry; my ($w, $h, $x, $y) = splitGeometry($geo); if ($config{KeywordDialogDockL}) { # move keyword window to left side of main window $x = $tx - $w - 2*$borderx; } else { # move keyword window to right side of main window $x = $tx + $tw + 2*$borderx; } $h = $th + 4*$borderx + 3; $keyw->geometry("${w}x${h}+${x}+${ty}"); } ############################################################## # setChildState - changes the state of a widget and # all his descendants (if possible) ############################################################## sub setChildState { my $widget = shift; my $state = shift; $widget->Walk( sub { print "changing widget ",ref($_[0])," to state $state\n" if $verbose; eval { $_[0]->configure(-state => $state); } }); } ############################################################## # progressWinInit ############################################################## sub progressWinInit($$) { my $widget = shift; my $title = shift; # open window my $pw = $widget->Toplevel(); $pw->withdraw; $pw->title("Mapivi: $title"); $pw->iconimage($mapiviicon) if $mapiviicon; $pw->iconname("Mapivi progress"); # init the values $pw->{stop} = 0; $pw->{percent} = 0; $pw->{label} = ""; $pw->{label2} = "0% done"; $pw->{start_time} = Tk::timeofday(); $pw->Label(-textvariable => \$pw->{label}, -width => 80, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -pady => 10); $pw->Label(-textvariable => \$pw->{label2}, -anchor => 'w', -bg => $config{ColorBG})->pack(-padx => 3, -pady => 10); $pw->{progbar} = $pw->ProgressBar(-takefocus => 0, -borderwidth => 1, -relief => 'sunken', #-width => (2*$config{FontSize}), # try to guess the height of the labels #-length => 30, -padx => 0, -pady => 0, -variable => \$pw->{percent}, -colors => [0 => $config{ColorProgress}], -resolution => 1, -blocks => 10, -anchor => 'w', -from => 0, -to => 100, )->pack(-fill => 'both', -expand => 0, -padx => 3, -pady => 10); $pw->Button(-text => 'Cancel', -command => sub { $pw->{stop} = 1; $pw->{label} = "stopping ..."; $pw->update(); })->pack(-fill => 'x', -expand => 1, -padx => 3, -pady => 10); centerWindow($pw); $pw->deiconify; $pw->raise; return $pw; } ############################################################## # progressWinCheck ############################################################## sub progressWinCheck($) { my $pw = shift; warn "pw->stop undefined!" unless defined($pw->{stop}); return ($pw->{stop}); } ############################################################## # progressWinUpdate ############################################################## sub progressWinUpdate($$$$) { my $pw = shift; # show progress and found pics every 0.3 seconds - idea from Slaven return unless (!defined $pw->{last_time} || Tk::timeofday()-$pw->{last_time} > 0.3); my $string = shift; my $index = shift; my $total = shift; $pw->{label} = $string; if ($total > 0) { my $add_str = ''; my $percent = int(($index/$total)*100); my $min = 0; my $sec = int(Tk::timeofday() - $pw->{start_time}); # try to estimate the time to go, after 3% are finished and 10 seconds are over if (($percent > 3) and ($sec > 5)) { my $to_go = int($sec * $total / $index) - $sec; # time to go in seconds my $totalt = $to_go + $sec; my $tgmin = 0; my $total_min = 0; if ($to_go > 59) { $tgmin = int($to_go / 60); $to_go = $to_go % 60; } # modulo if ($totalt > 59) { $total_min = int($totalt / 60); $totalt = $totalt % 60; } # modulo $add_str = sprintf "\n\nEstimated time to go %d:%02d, estimated total time %d:%02d",$tgmin, $to_go, $total_min, $totalt; } if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo $pw->{label2} = sprintf "%d%% done, time elapsed %d:%02d%s", $percent, $min, $sec, $add_str; $pw->{percent} = $percent; $pw->iconname("$percent% done"); } else { $pw->{label2} = ''; } $pw->update(); $pw->{last_time} = Tk::timeofday() if ($total > 0); } ############################################################## # progressWinEnd ############################################################## sub progressWinEnd($) { my $pw = shift; if (Exists($pw)) { $pw->withdraw; $pw->destroy; } } ############################################################## # fullscreen ############################################################## sub fullscreen { my $win = shift; my $fullscreen = shift; # Mai 2007: $win->attributes(-fullscreen => 1); should also work with 804.027_500 but it doesn't (at least not under windows) if ($fullscreen) { #saveOffsets($win); #my $screenw = $top->screenwidth - 10; #my $screenh = $top->screenheight - 30; #$geo = "${screenw}x${screenh}+0+0"; print "fullscreen: full \n" if $verbose; # this should also work: $win->packPropagate(0); $win->FullScreen; } else { #my ($w, $h) = getSize($dpic); $win->packPropagate(1); #$geo = "${w}x${h}+${picwinx}+${picwiny}"; print "fullscreen: normal \n" if $verbose; } #$win->geometry($geo); $win->update; $win->overrideredirect($config{Overrideredirect}); # no window decoration, but also no key input possible?! $win->focusForce; } ############################################################## # topFullScreen - toggle the main window to fullscreen and back ############################################################## sub topFullScreen { if ($topFullScreen == 0) { # save layout and geometry %topFullSceenConf = %config; $topFullSceenConf{Geometry} = $top->geometry; # save the actual geometry } toggle(\$topFullScreen); # remove/add the window border topToggleBorder() if $config{ToggleBorder}; if ($topFullScreen) { # switch to fullscreen #unset geometry #$top->geometry(""); #$top->geometry("+0+0"); #$config{ShowMenu} = 0; #$config{ShowInfoFrame} = 0; #$config{ShowCommentField} = 0; #$config{ShowEXIFField} = 0; #$config{Layout} = 4 ; #layout(1); #$mainF->configure(-bg => $config{ColorBGCanvas}); #$mainF->configure(-fg => $config{ColorBGCanvas}); #$mainF->configure(-highlightcolor => $config{ColorBGCanvas}); #$mainF->configure(-highlightbackground => $config{ColorBGCanvas}); $top->withdraw; my $w = $top->screenwidth; # - 20; my $h = $top->screenheight; # - 80; $top->geometry("${w}x${h}+0+0"); #$top->GeometryRequest($w,$h); $top->deiconify; #$top->overrideredirect(1); $top->packPropagate(0); $top->Post(0,0); $top->update; if ($config{ToggleBorder}) { $top->grabGlobal; } } else { # reset from fullscreen mode #$top->withdraw; $mainF->configure(-bg => $config{ColorBGCanvas}); $top->geometry($topFullSceenConf{Geometry}); #$config{ShowMenu} = $topFullSceenConf{ShowMenu}; #$config{ShowInfoFrame} = $topFullSceenConf{ShowInfoFrame}; #$config{ShowCommentField} = $topFullSceenConf{ShowCommentField}; #$config{ShowEXIFField} = $topFullSceenConf{ShowEXIFField}; #$config{Layout} = $topFullSceenConf{Layout}; #$top->deiconify; #layout(1); } $top->focusForce; # the canvas size has changed, so we need to rezoom all cached pics deleteCachedPics(); fitPicture(); #$top->deiconify; #$top->focus; } ############################################################## # topToggleBorder ############################################################## sub topToggleBorder { return unless $config{ToggleBorder}; print "fullscreen: $topFullScreen\n" if $verbose; $top->overrideredirect($topFullScreen); # toggle window decoration on/off if ($topFullScreen) { # switch to fullscreen # rebind the Esc-key to escape from fullscreen $top->bind('', sub { topFullScreen(); Tk->break; } ); # grab the focus to receive all keys - this is a bit dangerous $top->bind('', sub { $top->focusForce; $top->grabGlobal; }); $top->bind('', sub { $top->grabRelease; }); } else { # rebind Esc-key to the old binding #$top->bind('', sub { Tk->break; } ); $top->bind('', sub { $top->iconify; Tk->break; } ); $top->bind('', sub { Tk->break; }); $top->bind('', sub { Tk->break; }); $top->grabRelease; } } ############################################################## # mapiviUpdate - called if the mapivi version number changed # between two starts of mapivi (introduced with # version 0.7.3) ############################################################## sub mapiviUpdate { my $ver = 'unknown'; $ver = $config{Version} if ((defined $config{Version}) and ($config{Version} ne '000')); print "Mapivi up/downgrade from version $ver to version $version detected\n" } ############################################################## # beep - play a beep sound (bell) ############################################################## sub beep { print "\a"; # this is a beep # if this won't work, try this: #print "\007"; } ############################################################## # round ############################################################## sub round { # int() does not round! return sprintf "%d", shift; } ############################################################## # about - display some infos about the application ############################################################## sub about { my $title = "About Mapivi $version"; my @date = split / /, '$Date: 2008/02/21 20:53:27 $ '; my @datum = split /\//, $date[1]; my $nrs = $config{NrOfRuns}; my $about = << "EOA"; Mapivi - Martin\'s Picture Viewer and Manager Open-source and cross-platform picture manager with IPTC, EXIF and Comment support. Mapivi Version: $version Date of last change: $datum[2].$datum[1].$datum[0] Author: Martin Herrmann email: Martin-Herrmann\@gmx.de www: $mapiviURL download: http://sourceforge.net/projects/mapivi You have used Mapivi $nrs times EOA $about .= ' Mapivi is free software, if you want you may make a donation, see http://herrmanns-stern.de/software/donations.shtml Your donation of any amount will encourage me to continue the development.'; $about .= "\n\n I am always happy to receive some feedback about Mapivi!\n"; showText($title, $about, WAIT, $mapiviiconfile); } ############################################################## # systemInfo - show some infos about the system to the user ############################################################## sub systemInfo { my $sec = time() - $^T; my $min = 0; my $hou = 0; my $day = 0; # some modula calculations if ($sec > 59) { $min = int($sec / 60); $sec = $sec % 60; } # modulo if ($min > 59) { $hou = int($min / 60); $min = $min % 60; } if ($hou > 24) { $day = int($hou / 24); $hou = $hou % 24; } my $uptime = sprintf "%d day(s) %02d:%02d:%02d", $day, $hou, $min, $sec; my $perlversion = sprintf "%vd",$^V; my $string = << "EOA"; Mapivi config dir: $configdir Perl version: $perlversion Perl/Tk version: $Tk::VERSION Tcl/Tk version: $Tk::version Tcl/Tk patch level: $Tk::patchLevel Tk::JPEG version: $Tk::JPEG::VERSION MetaData version: $Image::MetaData::JPEG::VERSION Perl executable: $^X System (OS): $^O Process ID (PID): $$ Running since: $uptime EOA my $procTabAvail = (eval "require Proc::ProcessTable") ? 1 : 0 ; my $mem = int(getMemoryUsage()/(1024*1024))."MB" if $procTabAvail; $string .= " memory usage: ".$mem."\n" if $procTabAvail; $string .= " OS type: ".$ENV{OS}."\n" if ($ENV{OS}); $string .= " OS: ".$ENV{PC_OS}."\n" if ($ENV{PC_OS}); $string .= " OS type: ".$ENV{OSTYPE}."\n" if ($ENV{OSTYPE}); $string .= " System name: ".$ENV{HOSTNAME}."\n" if ($ENV{HOSTNAME}); $string .= " System name: ".$ENV{COMPUTERNAME}."\n" if ($ENV{COMPUTERNAME}); $string .= " System type: ".$ENV{HOSTTYPE}."\n" if ($ENV{HOSTTYPE}); $string .= " # of processors: ".$ENV{NUMBER_OF_PROCESSORS}."\n" if ($ENV{NUMBER_OF_PROCESSORS}); $string .= " Processor: ".$ENV{CPU}."\n" if ($ENV{CPU}); $string .= " Processor: ".$ENV{PROCESSOR_ARCHITECTURE}."\n" if ($ENV{PROCESSOR_ARCHITECTURE}); $string .= " Processor type: ".$ENV{PROCESSOR_IDENTIFIER}."\n" if ($ENV{PROCESSOR_IDENTIFIER}); $string .= " Processor type: ".$ENV{MACHTYPE}."\n" if ($ENV{MACHTYPE}); $string .= " Processor rev.: ".$ENV{PROCESSOR_REVISION}."\n" if ($ENV{PROCESSOR_REVISION}); $string .= "Here is a list of all external programs used by Mapivi.\nSome of them are needed, some are optional.\n\n"; foreach my $prog (sort keys %exprogs) { if ($exprogs{$prog}) { $string .= " "; } else { $string .= " not "; } $string .= sprintf("available: %-12s - %s\n", $prog, $exprogscom{$prog}); } showText("System Information", $string, WAIT, $mapiviiconfile); } ############################################################## # gratulation ############################################################## sub gratulation { my $nr = $config{NrOfRuns}; my $text = <<"EOT"; Gratulation!!! You\'ve started MaPiVi $nr times! You are a real MaPiVi Power User! I would be really glad to receive an email about this event. Mapivi is free software, but if you wish you may make a donation, please go to http://herrmanns-stern.de/software/donations.shtml Your donation of any amount will encourage me to continue the development of Mapivi. Maybe you could also tell me on which hardware and operating system you are using MaPiVi? I would like to add this information on the supported systems section of the README file. Martin Herrmann (author of Mapivi) email: Martin-Herrmann\@gmx.de EOT showText("MaPiVi start nr. $nr", $text, NO_WAIT); } ############################################################## # showCopyright ############################################################## sub showCopyright { print <. If there are still problems, restart Mapivi with the menu File->Restart. This problem may occur, when you are working with Mapivi while it's still busy e.g. loading the thumbnails. 2. What's about the memory consumption, when adding comments and IPTC information to pictures? It's like you would expect it: about one byte per char. Example: adding a comment of 30 chars to a 1MB picture will increase the file size about 0.03%. 3. How many comments are allowed in a JPEG picture? From the wrjpgcom man page: The JPEG standard allows "comment" (COM) blocks to occur within a JPEG file. Although the standard doesn't actually define what COM blocks are for, they are widely used to hold user-supplied text strings. This lets you add annotations, titles, index terms, etc to your JPEG files, and later retrieve them as text. COM blocks do not interfere with the image stored in the JPEG file. The maximum size of a COM block is 64K, but you can have as many of them as you like in one JPEG file. However I recommend using IPTC instead of JPEG comments, see question 25. 4. How do I work with comments? Simply select a picture to comment and press , enter the comment and press Ctrl-x to close the dialog. Example: you have three pictures to comment, one with Tom and Tim, one with Tom and Peter and one with Tom and Linda. They were taken at Lucy's party. Here is what I would do: select all three pictures, press , enter "Lucy's Party Tom", press Ctrl-x. Now all pictures have the comment "Lucy's Party Tom", now select the first one and add "Tim", the second and add "Peter", and so on ... However I recommend using IPTC instead of JPEG comments, see question 25. 5. I've added several comments to my picture; I can see them with Mapivi, but not with my other tool. Why? Some viewer tools only support the first comment of a JPEG picture. You can use the join comments function of Mapivi to join all comments to one. 6. I can manipulate pictures with Mapivi, but why is there no "Save" or "Save as"? When manipulating pictures, Mapivi serves as a frontend to the ImageMagick tools. The manipulation is done directly on the file, so there is no need to save. But there is also no undo, so better keep the option "Create backup" enabled. You can also force a backup with the menu File->Make backup. If there is already a backup, Mapivi will ask you to overwrite it. The backup of file.jpg will always be named: file-bak.jpg. If you delete file.jpg and there is a backup named file-bak.jpg, Mapivi will ask to rename the backup file to the old file name. This is also done when renaming the original file. If a file has a backup file the string "[bak]" is shown in the size column of the thumbnail table. 7. What's the IPTC urgency tag for? The urgency is an IPTC field to specify the importance of a picture. The urgency may be used as a search or sort criteria. I use it to separate the really good and important pictures from the rest. That's my reflection: My grandma has about 5 photo albums of her whole life, that number of pictures can be viewed in some hours. Since I own a digital camera the number of photos I take is exploding (even if I really try hard to sort out about 50%). So when I keep on taking so much photos I never will have the time to look at them, when I am older. That's where the urgency tag comes into play, I simply mark the best or most important pictures with a high priority. Later I can choose a view to see only the best pictures of e.g. my children. This can be done in the search dialog by selecting the proper urgency and e.g. the Name of the person to search for in the pattern field. 8. How can I get the Mapivi Icon under MS Windows? Use the MapiviIcon32.ico (this is located in the directory pictures of your Mapivi packet) in the properties dialog of the windows explorer. 9. How do I open a directory not accessible with the directory tree on the left? (This may happen when running Mapivi under MS Windows) Press , or use the menu File->open directory. Or left click on the label, where the actual directory is displayed (above the thumbnail list). A dialog will pop up, where you can enter the directory name to open. 10. Is it recommended to do image manipulation with pictures in JPEG format? Usually image manipulations should be done with an image manipulation program, like The GIMP or Photoshop. They support lossless image formats, like XCF or PNG. The disadvantage of JPEG is the fact, that every time you change and save a JPEG picture it has to be compressed again. This compression is NOT lossless, so with every step your picture quality gets worse and worse. However there are some lossless JPEG operations, which don't affect the quality of the picture. It may be appropriate to use JPEG for some image manipulation (like the functions provided by Mapivi) if the source and target format should be JPEG anyway. Mapivi tries to support the manipulation of JPEG files as much as possible by lossless operations (rotation, cropping, adding of comments and IPTC information) and lossy one-step-manipulations. It's e.g. possible to apply several filters and color adjustments to a picture while adding a border. So there is just one recompression to the picture. This should produce the same results like manipulating the picture with the GIMP and then saving it as a JPEG file. To get the maximum possible quality, I recommend setting the quality to 95%. A higher value just increases the file size, not the quality! This setting is also recommended, if it's necessary to do a manipulation including several steps. Note: Adding, editing or removing JPEG meta information, like IPTC, EXIF or comments is lossless with Mapivi! 11. How to compare details on two pictures? Switch the autozoom option of (menu: Options->Window->auto zoom) or open the pictures and press to zoom to 100% for each. Click on the thumbnail of the first and then on the thumbnail of the second picture. Now you are able to move the picture in the canvas, when you switch back to the other picture you will see the same part (e.g. the lower right corner) of this picture. Another possibility is to build a difference picture of two pictures. This can be done using the menu "Extra->build difference picture". 12. What the meaning of all the special info in the thumbnail table? Let's start with the EXIF column: [s] the EXIF info has been saved to an extra file use the menu to restore it back [t] there is an EXIF thumbnail embedded in the picture this is optional (press key to view the thumbnail) date the date and time the picture was taken 18mm the focal length of the lens (27mm) the focal length of the lens in 35mm film equivalent F2.8 the aperture 1/60s the exposure time +0.3 the exposure bias value ISO100 the ISO speed rating the size column: [bak] the file has a backup (e.g. file-bak.jpg) 1143kB the file size in kB (1kB = 1KiB = 1024 Byte) 2048x1536 the picture size in pixels 3.15MP the amount of pixels in mega pixels (1MP = 1000000 pixel) 2.69 b/p the bits per pixel value (kind of quality value) [3:4] the aspect ratio date the file manipulation date Viewed x times how often the picture has been displayed in Mapivi the rest should be obvious, I hope. 13. Panic! Where is my backup file? A backup file (named e.g. pic-bak.jpg) is only created, when the "Create backup" button was selected. If the backup is not shown directly after a conversation, please press to update the thumbnail table. Hint: If a picture has a backup this string: [bak] is shown in the size column. 14. I've rotated my pictures manually, but the rotate flag is wrong now. What should I do? Clear the rotate flag (see menu Edit->Rotate->Clear rotate flag). 15. I've rotated my pictures, but the EXIF thumbnail is still in the old wrong position. What should I do? There are two possibilities: a) lossless (rotate thumbnail) Press to open the options dialog, go to the Thumbnails pad and deselect "Rotate EXIF thumbnail when rotating picture". Now rotate the picture to match the EXIF thumbnail (press to see the EXIF thumbnail). Now select "Rotate EXIF thumbnail when rotating picture" in the dialog noted above and rotate the picture again. b) fast (create new thumbnail) Just build a new EXIF thumbnail (see menu Edit->EXIF info->(re)build thumbnail). Both possibilities are lossless for the picture. 16. I want to save a copy of a picture in the same directory, with a different name (Save As ...). How to do this with Mapivi? Select the picture (e.g. pic1.jpg), use the menu: File->make backup. A new file named pic1-bak.jpg will be created, select this picture and press (or use the menu: File->rename) and rename the picture to the new name. 17. If I resize the Mapivi window the pictures do not resize. What's wrong? Nothing is wrong, zooming is slow, and so Mapivi just rezooms on user request. Press key (Shift-u) above the picture and it will be reloaded and zoomed to the new canvas size. You may also try (fit picture in canvas) or (display in original/100% size). 18. Mapivi is great! Why is it free? Because I like and use a lot of free open source software myself and Mapivi is my contribution back to the community. But anyway, you are free to make a donation, see http://herrmanns-stern.de/software/donations.shtml Your donation of any amount will encourage me to continue the development. 19. How can I reuse the saved EXIF information or IPTC templates from the pre-0.7.0 Mapivi versions? The only way is to use an old Mapivi version, restore the EXIF information to the pictures and apply the IPTC templates to certain pictures: Quit the old Mapivi version. Then start the new Mapivi version (>= 0.7.0) and save the EXIF information (if needed) and the IPTC templates again. Before using an old Mapivi version I recommend to make a backup of the Mapivi configuration file: (for UNIX: ~/.maprogs/mapivi/mapivirc) and restore it before switching back to the actual Mapivi version. 20. How to use hierarchical keywords and categories? If there is no tree visible in the "edit keywords" or "edit categories" dialog press the right mouse button and add some items. A double click on a keyword will insert it in the IPTC segment of all selected pictures. I recommend using the join mode. In this mode Mapivi will store your keyword hierarchie in the pictures. You can retrieve the hierarchie anytime later by simply browsing your pictures. Hint: According to the IPTC standard, supplemental categories are depricated. Based on that I recommend using only IPTC keywords. 21. Is it possible to search for pictures stored on an external media (e.g. CD, DVD, USB-Stick, external HD)? Yes, of course, if Mapivi knows about them. Follow this procedure: 1. Insert the media 2. Press F7 in main window (directory tree will show up) 3. Select media root folder (e.g. /media/dvd for UNIX or D:\ for Windows) in Mapivi directory tree 4. Select Mapivi menu: Search->build database ... to add the pictures stored on the external media to the Mapivi search database Hints: - As Mapivi will just show the path to the picture (e.g. /media/dvd/pic1.jpg or D:\pic1.jpg) it is recommended to use a CD/DVD folder structure with unambiguous naming e.g. dates like 20051026_Party/ this will help you to find the right CD/DVD - If you didn't use Mapivi for deleting the pictures you should select Mapivi menu: Search->clean database ... to update the Mapivi search database - For thumbnails see next question 22. When I find pictures stored on external media (e.g. CD, DVD, USB-Stick, external hard disk no thumbnails are shown. Can this be changed? Or: Is it possible to show the thumbnails of pictures stored on an external media in the search dialog? Yes, it is possible. Follow these steps: 1. Insert the media 2. Press F7 in main window (directory tree will show up) 3. Select media root folder (e.g. /media/dvd for UNIX or D:\ for Windows) in Mapivi directory tree 4. Select Mapivi menu: Extra->build thumbs in all sub directories ... Mapivi will store these thumbnails automatically in a central folder if the media is not writable. 23. Does Mapivi store the thumbnails? Where are they stored? Yes, Mapivi tries to store all produced thumbnails. They are stored depending on the configuration in a) a sub folder of the current folder named .thumbs or b) in a central folder (for UNIX: ~/.maprogs/mapivi/thumbDB/) 24. What is the dotted line in the menu for? When you select the dotted line you will get a so called tear-of menu. The menu will become a new window and you may place it anywhere on your desktop. This is very handy if you need some functions several times. 25. Should I store my picture comments in the IPTC or the JPEG comments? Use the IPTC information. The IPTC information is much more structured than the JPEG comments. A JPEG comment is just one long text string. So when your picture collection keeps growing, searching pictures will become more difficult. The problem is not finding pictures with a certain comment, but that the search results are simply to numerous. Example: You have a picture of the car from your best friend Tom. When using JPEG comments you would write something like "Tom's car" into the comment. When you later search for pictures of Tom, you will find this picture, even while Tom himself is not on the picture, just his car. Using IPTC information, the description would be the same "Tom's car", but you would not search the IPTC description field for "Tom", but the IPTC keywords (where you store the names of the persons shown on the picture). So this picture will not show up in the search results, just the pictures which really depict Tom. 26. I there a support for other encodings, character sets, German umlaute, accents etc. in IPTC meta information? No, currently there is no support for this in Mapivi. Anyhow, it is possible to add and see them in the IPTC dialog, but they are not correctly displayed in the thumbnail list and it is not possible to search for words with umlauts, accents etc. I still haven't figured out how to handle this properly in Mapivi any hints are welcome. Meanwhile I recommend to use translations like these for the German umlauts: (u with two dots above) -> ue, -> ae etc. 27. When I start other gnome/GTK applications, Mapivi is killed with a segmentation fault. Is there a fix? Yes, there is one, see: http://ubuntuforums.org/showthread.php?t=130912&highlight=mapivi You just have to apply a 3 line patch to one of the PerlTk files, rebuild and install PerlTk. It's not a Mapivi, but a PerlTk bug, thus all PerlTk applications stop with a segmentation fault, when a gnome application is started. 28. Will image quality decrease when adding or editing meta data? Is there a recompression of my picture when I add or change IPTC information? No, a JPEG picture has several segments, when you add, change or remove meta information (IPTC, EXIF, comments) the segment containing the image data is not changed. You will see no quality decrease when commenting your pictures with Mapivi, even when you change e.g. the IPTC keywords a hundred times.