Clear["@"]; (********** INPUT STARTS **********) dir0="d:\\html\\pictures\\archives"; test=1; (* 1 for testing *) mroll=120; (* max. possible number of rolls *) myear=1999; (* the last year *) firstyear=1996; local=1; (* !=0 if original full-size images are stored locally *) host0="http://lepera.chem.purdue.edu"; (* if local==0 then name of the host were they are stored *) host1="http://picket.cc.purdue.edu/~sergeev"; (* if local==0 then name of the host were compressed pictures are stored *) {charleft,charright}={50,40}; (* number of characters in a shortened title *) archive=If[test==0 && local==0, 1, 0]; (* whether to create archive *) (********** INPUT ENDS **********) (* Eliminates flanking blanks or new-lines of a string. *) Module[{s,s0,s9}, flankblank[s_String]:= If[s=="",s, If[s0=StringTake[s,1];s0==" "||s0=="\n",flankblank[StringDrop[s,1]], If[s9=StringTake[s,-1];s9==" "||s9=="\n",flankblank[StringDrop[s,-1]],s]]] ]; (* Printing *) Module[{s}, p[s_String]:=Write[of,s] ]; Module[{s}, p1[s_String]:=Write[of1,s] ]; (* Shortening a title *) Module[{s,cleft,cright,b,ctot,wb,cb,wb1,cb1,cb1a,wb2,cb2,cb2a,wb3}, shrink[s_String,cleft_Integer,cright_Integer]:=( b=ReadList[StringToStream[s],Word]; ctot=cleft+cright; wb=Length[b]; cb=Sum[StringLength[b[[n]]],{n,wb}]+wb-1; If[cb>ctot, wb1=cb1=0; Do[cb1a=cb1+StringLength[b[[n]]]+1; If[cb1a>cleft,Break[]]; wb1++; cb1=cb1a ,{n,wb}]; wb2=cb2=0; Do[cb2a=cb2+StringLength[b[[wb-n+1]]]+1; If[cb2a>cright,Break[]]; wb2++; cb2=cb2a ,{n,wb}]; wb3=wb-wb1-wb2; If[wb3>1, b=Flatten[{Take[b,wb1],"...["<>ToString[wb3]<>" words]...",Take[b,-wb2]}] ] ]; b=StringReplace[ToString[b],{"{"->"","}"->"",", "->" "}] ) ]; (* Transforms rgb to hls *) Module[{rgbmax,rgbmin,rc,gc,bc}, rgbtohls[r_,g_,b_]:= ( (* Compute lightness *) rgbmax=Max[r,g,b]//N; rgbmin=Min[r,g,b]//N; l=(rgbmax+rgbmin)/2.0; (* Compute saturation *) If[rgbmax==rgbmin, s = 0.0, If[l<=0.5, s=(rgbmax-rgbmin)/(rgbmax+rgbmin), s=(rgbmax-rgbmin)/(2.0-rgbmax-rgbmin) ] ]; (* Compute the hue *) If[rgbmax==rgbmin, h=0.0, rc=(rgbmax-r)/(rgbmax-rgbmin); gc=(rgbmax-g)/(rgbmax-rgbmin); bc=(rgbmax-b)/(rgbmax-rgbmin); If[r==rgbmax, h=bc-gc, If[g==rgbmax, h=2.0+rc-bc, h=4.0+gc-rc ] ]; h=h/6.0; h=Mod[h,1.0]; ]; {h,l,s} )]; (********** Reading colors and calculating background color *) Clear[c]; hex[c_]:= (* Converting to hexadecimal form *) StringJoin@@((ToString/@IntegerDigits[Round[255. c],16,2])/.{"10"->"A", "11"->"B","12"->"C","13"->"D","14"->"E","15"->"F"}); <{"/","."}]; If[Length[d1]!=5,Print["Corrupted record in colors-file ",n];Continue[]]; roll=d1[[2]];fn=d1[[4]]; {r,g,b}={r,g,b}/255.; {h,l,s}=rgbtohls[r,g,b]; {h,l,s}={h,180/240.,Sqrt[s]}; (* set background color *) {r,g,b}=List@@Graphics`Colors`HLSColor[h,l,s]; color[roll,fn]="#"<>hex[r]<>hex[g]<>hex[b]; ,{n,mcdata}]; (********** Reading links data file *) flinks=ToFileName[dir0,"links.txt"]; ldata=ReadList[flinks,Record,RecordSeparators -> {"#"}]; mldata=Length[ldata]; (* Defining root directory *) rootdir=""; Do[ndata=ldata[[n]]; nd=ReadList[StringToStream[ndata],Word]; If[nd[[1]]=="ROOTDIRECTORY", rootdir=nd[[2]]] ,{n,mldata}]; mrep=0; rootdir0="../.."; (* respectively to pictures/archives *) of=OpenWrite[ToFileName[dir0,"links.htm"],PageWidth->Infinity,FormatType->OutputForm]; ""//p; ""//p; "Testing links that are automatically added to picture captions where possible"//p; ""//p; "

Testing links

"//p; "

The following list contains links that are automatically added to picture captions.
It was created from the data file links.txt automatically for easy view and testing of these links.

"//p; Do[ndata=ldata[[n]]; mark=ReadList[StringToStream[ndata],Word]//First; If[mark=="COMMENT" || mark=="ROOTDIRECTORY",Continue[]]; nd1=ReadList[StringToStream[ndata],Record,RecordSeparators->{"->"}]; If[Length[nd1]<2,Continue[]]; mrep++; ref[mrep]=flankblank[StringReplace[nd1[[2]],{"ROOTDIRECTORY"->rootdir,"-NNNNN-"->"#"}]]; anchs=ReadList[StringToStream[nd1[[1]]],Record,RecordSeparators->{"!"}]; excl[mrep]=flankblank/@Drop[anchs,1]; (* Currently ignored *) incl[mrep]=flankblank/@ReadList[StringToStream[anchs[[1]]],Record,RecordSeparators->{"|"}]; "
StringReplace[ref[mrep],rootdir->rootdir0]<>"\">"<>ToString[incl[mrep]]<>""<> If[StringMatchQ[ref[mrep],"*"<>rootdir<>"*"]," (local)",""]//p ,{n,mldata}]; ""//p; Close[of]; (********** Finishing links HTML document *) blanksrc="../../../../../blank.gif"; urlcompress=If[local==0,host1<>"/pictures/archives/compress/","../../"]; (* Start scanning *) If[test==1,{mroll,myear}={2,1996}]; npic=0; Do[ (* year *) year=ToString[nyear]; (* Reading year caption *) filecapt=ToFileName[dir0,"captions.txt"]; data=ReadList[filecapt,Record,RecordSeparators -> {"#"}]; mrec=Length[data]; yearcap[year]=""; Do[rec=data[[nrec]]; pos=StringPosition[rec,{" ","\n",":"}]; n=pos[[1,1]]; head=StringTake[rec,n-1]; sep=StringTake[rec,{n,n}]; content=StringDrop[rec,n]//flankblank; If[head==year,yearcap[year]=StringReplace[content,{"\n"->" "}]] ,{nrec,mrec}]; (* *) yearsize[year]=0; Do[ (* roll *) roll=ToString[nroll]; dirslide=ToFileName[{dir0,"compress",year,roll,"jpeg"}]; If[FileType[dirslide]=!=Directory,Continue[]]; SetDirectory[dirslide]; fnames=FileNames["*.jpg"]; mf=Length[fnames]; rollsize[roll]=mf; yearsize[year]=yearsize[year]+mf; (* Reading roll name *) filecapt=ToFileName[{dir0,year,roll},"captions.txt"]; data=ReadList[filecapt,Record,RecordSeparators -> {"#"}]; mrec=Length[data]; rolltitle[roll]=""; Do[rec=data[[nrec]]; pos=StringPosition[rec,{" ","\n",":"}]; n=pos[[1,1]]; head=StringTake[rec,n-1]; sep=StringTake[rec,{n,n}]; content=StringDrop[rec,n]//flankblank; If[head=="ROLL", If[rolltitle[roll]!="",Print["WARNING: several titles for the same roll encountered in the captions file "<>filecapt]]; rolltitle[roll]=content] ,{nrec,mrec}]; If[rolltitle[roll]=="",Print["WARNING: no title of the roll found in the captions file "<>filecapt]]; (* Cycling through images *) Do[fname=fnames[[nf]]; fn=StringDrop[fname,-4]; If[StringLength[fn]>3,Continue[],npic++]; (***********) (* Reading the title of the slide from the file captions.txt *) fn1=StringReplace[fn,"000"->"-1"]; nfn=ToExpression[fn1]; capt=gcapt=""; Do[rec=data[[nrec]]; pos=StringPosition[rec,{" ","\n",":"}]; n=pos[[1,1]]; head=StringTake[rec,n-1]; sep=StringTake[rec,{n,n}]; content=StringDrop[rec,n]//flankblank; If[sep=="\n"||sep==" ", If[head==fn, If[capt!="",Print["WARNING: several captions for the same slide "<>fn<>" encountered in the caption file "<>capt]]; capt=content;Continue[]]]; If[sep==":", head1=StringReplace[head,{"000"->"-1","-"->"+"}]; range=Flatten[Release[ToExpression["{"<>head1<>"}",InputForm,Hold]/.Plus->Range]]; If[MemberQ[range,nfn], gcapt=gcapt<>"
\n"<>content;Continue[]]]; ,{nrec,mrec}]; capt=flankblank[capt]; gcapt=flankblank[gcapt]; gcapt=StringReplace[gcapt,{" "->" ","""->""}]; While[StringMatchQ[gcapt,"*<*>*"], n1=StringPosition[gcapt,"<"][[1,1]]; n2=StringPosition[gcapt,">"][[1,1]]; gcapt=If[n1" ","'"->""}]]; (* Abbrevating description if it is too long *) descr[npic]=shrink[description[npic],charleft,charright]; Print["#"<>fn<>"-"<>roll<>" - "<>descr[npic]]; (**) caplink="

"<> If[capt=="", StringReplace[gcapt,{"\n"->"\n
"}],capt] <>"

#"<>fn<>"-"<>roll<>If[capt=="","
"<>rolltitle[roll],""]<>"

"; (* Adding links where possible *) Do[ pos=StringPosition[caplink,incl[nrep],Overlaps->False,IgnoreCase->True]; mpos=Length[pos]; If[mpos==0,Continue[]]; mcap=StringLength[caplink]; nref=ref[nrep]; Do[ {pos1,pos2}=pos[[npos]]; If[pos1!=1 && !StringMatchQ[ToUpperCase[StringTake[caplink,{pos1-1}]],"@"],Continue[]]; If[pos2!=mcap && !StringMatchQ[ToUpperCase[StringTake[caplink,{pos2+1}]],"@"],Continue[]]; caplink=StringInsert[caplink,"",pos2+1]; caplink=StringInsert[caplink,"nref<>"\">",pos1]; ,{npos,mpos,1,-1}] ,{nrep,mrep}]; caption[npic]=caplink; (* End reading from captfile *) years[npic]=year;rolls[npic]=roll;numbers[npic]=fn; If[!NumberQ[startroll[nroll]],startroll[nroll]=npic]; endroll[nroll]=npic; If[!NumberQ[startyear[nyear]],startyear[nyear]=npic]; endyear[nyear]=npic; ,{nf,mf}] ,{nroll,mroll}],{nyear,firstyear,myear}]; mpic=npic; Clear[npic]; minyear=ToExpression[years[1]]; maxyear=ToExpression[years[mpic]]; of1=OpenWrite[ToFileName[dir0,"fulllist.htm"],PageWidth->Infinity,FormatType->OutputForm]; ""//p1; ""//p1; t="Full list of "<>ToString[mpic]<>" pictures from archives "<>ToString[minyear]<>" - "<>ToString[maxyear]; ""<>t<>""//p1; ""//p1; "

"<>t<>"

"//p1; "

The following list was printed automatically. It does not include Black and white pictures.

"//p1; "

Contents

"//p1; ""//p1; Do[year=ToString[nyear]; n1roll=ToExpression[rolls[startyear[nyear]]]; n2roll=ToExpression[rolls[endyear[nyear]]]; listrolls=""; Do[roll=ToString[nroll]; listrolls=listrolls<>"roll<>"\">"<>roll<>" "; ,{nroll,n1roll,n2roll}]; ""//p1; ,{nyear,minyear,maxyear}]; "
YearsRolls of film
year<>"\">"<>year<>""<>listrolls<>"

year<>"/list.htm\" NAME=\"y"<>year<>"\">Year "<>year<>". "<>yearcap[year]<>", "<>ToString[yearsize[year]]<>" pictures

year<>"/"<>roll<>"/browser.htm\" NAME=\"r"<>roll<>"\">Roll #"<>roll<>": "<>rolltitle[roll]<>"

"//p1; (* References *) "

"//p1; ""//p1; ""//p1; ""//p1; ""//p1; ""//p1; ""//p1; "
Picture ArchivesSelected PicturesRandom Slide ShowTechnical detailsDirectory of filesA. Sergeev

"//p1; ""//p1; Close[of1]; If[archive!=0,Run[dir0<>"\\ziphtm.bat"]]; (* creating archive c:\temp\transfer\htm.zip *)