EasyTimeline.pl 143 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719
  1. #!/usr/bin/perl
  2. # Copyright (C) 2004 Erik Zachte , email xxx\@chello.nl (nospam: xxx=epzachte)
  3. # This program is free software; you can redistribute it and/or
  4. # modify it under the terms of the GNU General Public License version 2
  5. # as published by the Free Software Foundation.
  6. # This program is distributed in the hope that it will be useful,
  7. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. # See the GNU General Public License for more details, at
  10. # http://www.fsf.org/licenses/gpl.html
  11. # history:
  12. # 1.5 May 27 2004 :
  13. # - when a chart contains only one bar this bar was always centered in the image
  14. # now AlignBars works well in this case aslo ("justify" treated as "center")
  15. # - interwiki links reinstalled e.g. [[de:Gorbachev]]
  16. # - error msgs corrected
  17. # - minimum image size fixed
  18. # - line numbering adapted <timeline>spaces<br> does not count as line one in Wikipedia
  19. # - line breaks in wiki links parsed correctly [[Vladimir~Ilyich~Lenin]]
  20. # - partial url shown as hint for external link (in GIF/PNG)
  21. # - BarData: no attribute 'text:..' supplied -> default to space = show no text on axis
  22. # - PlotData: new attribute 'anchor:..'
  23. # - revert html encoding of '<' & '>' by MediaWiki
  24. # 1.6 May 28 2004 :
  25. # - SVG decode special chars in SVG input fixed
  26. # - BarData: new attributes 'barset:..' and 'barcount:..' # autoincrement bar id
  27. # - PlotData: new attribute 'barset:..'
  28. # - LineData: new attribute 'layer:..', draw lines to back or front of bars and texts
  29. # 1.7
  30. # - EscapeShellArg (Tim Starling)
  31. # 1.8 June .. 2004 :
  32. # - optional autosizing of image (implied when auto incrementing bar count (also new))
  33. # - presentation left-right order of bars reversed on TimeAxis = orientation:vertical
  34. # - TimeAxis option 'order:[normal|reverse]' added
  35. # - BarData: option barcount replaced by auto incrementing bar count and 'break' and 'skip' attributes
  36. # - DrawLines -> LineData (command renamed, but also restructured like PlotData, TextData)
  37. # - new drawing options for LineData, now also lines parallel to time axis, or between arbitrary points
  38. # - Preset command added (specify default settings with 'Preset =', two sets to start with)
  39. # - 'text' attribute parsing bugs (# or : in text gave problems, spaces got lost)
  40. # - PlotArea new attributes 'top' and 'right' make it possible to define plot area margins only
  41. # so resizing image does not imply adjusting PlotArea 'width' and 'height'
  42. # - PlotData option 'shift': only changing x or y value is now possible, e.g. shift=(,10)
  43. # - command ScaleMajor: subs for time axis can now be specified verbatim in option 'text'
  44. # - extra validation checks, defaults, etc
  45. # - function PlotScale now provides workaround for Ploticus bug: auto incrementing dates failed
  46. # 1.9 June 2004
  47. # - stub display order fixed on non time axis
  48. # 1.10 July 2004
  49. # - tempory debug code (removed)
  50. # 1.11 August 2004
  51. # - dot in folder name in input path was misunderstood as start of file extension
  52. # - utf-8 chars within 160-255 range are translated to extended ascii
  53. # however internal font used by Ploticus has strange mapping so some are replaced
  54. # by undercore or unaccented version of character
  55. # this is a make do solution until full unicode support with external fonts will be added
  56. $version = "1.9" ;
  57. use Time::Local ;
  58. use Getopt::Std ;
  59. use Cwd ;
  60. $| = 1; # flush screen output
  61. print "EasyTimeline version $version\n" .
  62. "Copyright (C) 2004 Erik Zachte\n" .
  63. "Email xxx\@chello.nl (nospam: xxx=epzachte)\n\n" .
  64. "This program is free software; you can redistribute it\n" .
  65. "and/or modify it under the terms of the \n" .
  66. "GNU General Public License version 2 as published by\n" .
  67. "the Free Software Foundation\n" .
  68. "------------------------------------------------------\n" ;
  69. &SetImageFormat ;
  70. &ParseArguments ;
  71. &InitFiles ;
  72. open "FILE_IN", "<", $file_in ;
  73. @lines = <FILE_IN> ;
  74. close "FILE_IN" ;
  75. &InitVars ;
  76. &ParseScript ;
  77. if ($CntErrors == 0)
  78. { &WritePlotFile ; }
  79. if ($CntErrors == 1)
  80. { &Abort ("1 error found") ; }
  81. elsif ($CntErrors > 1)
  82. { &Abort ("$CntErrors errors found") ; }
  83. else
  84. {
  85. if (defined @Info)
  86. {
  87. print "\nINFO\n" ;
  88. print @Info ;
  89. print "\n" ;
  90. }
  91. if (defined @Warnings)
  92. {
  93. print "\nWARNING(S)\n" ;
  94. print @Warnings ;
  95. print "\n" ;
  96. }
  97. if (! (-e $file_bitmap))
  98. {
  99. print "\nImage $file_bitmap not created.\n" ;
  100. if ((! (-e "pl.exe")) && (! (-e "pl")))
  101. { print "\nPloticus not found in local folder. Is it on your system path?\n" ; }
  102. }
  103. elsif (! (-e $file_vector))
  104. {
  105. print "\nImage $file_vector not created.\n" ;
  106. }
  107. else
  108. { print "\nREADY\nNo errors found.\n" ; }
  109. }
  110. exit ;
  111. sub ParseArguments
  112. {
  113. my $options ;
  114. getopt ("iTAPe", \%options) ;
  115. &Abort ("Specify input file as: -i filename") if (! defined (@options {"i"})) ;
  116. $file_in = @options {"i"} ;
  117. $listinput = @options {"l"} ; # list all input lines (not recommended)
  118. $linkmap = @options {"m"} ; # make clickmap for inclusion in html
  119. $makehtml = @options {"h"} ; # make test html file with gif/png + svg output
  120. $bypass = @options {"b"} ; # do not use in Wikipedia:bypass some checks
  121. $showmap = @options {"d"} ; # debug: shows clickable areas in gif/png
  122. # The following parameters are used by MediaWiki
  123. # to pass config settings from LocalSettings.php to
  124. # the perl script
  125. $tmpdir = @options {"T"} ; # For MediaWiki: temp directory to use
  126. $plcommand = @options {"P"} ; # For MediaWiki: full path of ploticus command
  127. $articlepath=@options {"A"} ; # For MediaWiki: Path of an article, relative to this servers root
  128. if (! defined @options {"A"} )
  129. { $articlepath="http://en.wikipedia.org/wiki/\$1"; }
  130. if (! -e $file_in)
  131. { &Abort ("Input file '" . $file_in . "' not found.") ; }
  132. }
  133. sub InitVars
  134. {
  135. $true = 1 ;
  136. $false = 0 ;
  137. $CntErrors = 0 ;
  138. $LinkColor = "brightblue" ;
  139. $MapPNG = $false ; # switched when link or hint found
  140. $MapSVG = $false ; # switched when link found
  141. $WarnTextOutsideArea = 0 ;
  142. $WarnOnRightAlignedText = 0 ;
  143. $hPerc = &EncodeInput ("\%") ;
  144. $hAmp = &EncodeInput ("\&") ;
  145. $hAt = &EncodeInput ("\@") ;
  146. $hDollar = &EncodeInput ("\$") ;
  147. $hBrO = &EncodeInput ("\(") ;
  148. $hBrC = &EncodeInput ("\)") ;
  149. $hSemi = &EncodeInput ("\;") ;
  150. $hIs = &EncodeInput ("\=") ;
  151. $hLt = &EncodeInput ("\<") ;
  152. $hGt = &EncodeInput ("\>") ;
  153. }
  154. sub InitFiles
  155. {
  156. print "\nInput: Script file $file_in\n" ;
  157. $file = $file_in ;
  158. # 1.10 dot ignore dots in folder names ->
  159. $file =~ s/\.[^\\\/\.]*$// ; # remove extension
  160. $file_name = $file ;
  161. $file_bitmap = $file . "." . $fmt ;
  162. $file_vector = $file . ".svg" ;
  163. $file_png = $file . ".png" ;
  164. $file_htmlmap = $file . ".map" ;
  165. $file_html = $file . ".html" ;
  166. $file_errors = $file . ".err" ;
  167. # $file_pl_info = $file . ".inf" ;
  168. # $file_pl_err = $file . ".err" ;
  169. print "Output: Image files $file_bitmap & $file_vector\n" ;
  170. if ($linkmap)
  171. { print " Map file $file_htmlmap (add to html for clickable map)\n" ; }
  172. if ($makehtml)
  173. { print " HTML test file $file_html\n" ; }
  174. # remove previous output
  175. if (-e $file_bitmap) { unlink $file_bitmap ; }
  176. if (-e $file_vector) { unlink $file_vector ; }
  177. if (-e $file_png) { unlink $file_png ; }
  178. if (-e $file_htmlmap) { unlink $file_htmlmap ; }
  179. if (-e $file_html) { unlink $file_html ; }
  180. if (-e $file_errors) { unlink $file_errors ; }
  181. }
  182. sub SetImageFormat
  183. {
  184. $env = "" ;
  185. # $dir = cwd() ; # is there a better way to detect OS?
  186. # if ($dir =~ /\//) { $env = "Linux" ; $fmt = "png" ; $pathseparator = "/";}
  187. # if ($dir =~ /\\/) { $env = "Windows" ; $fmt = "gif" ; $pathseparator = "\\";}
  188. # cwd always to returns '/'s ? ->
  189. $OS = $^O ;
  190. if ($OS =~ /darwin/i)
  191. { $env = "Linux"; $fmt = "png" ; $pathseparator = "/";}
  192. elsif ($OS =~ /win/i)
  193. { $env = "Windows" ; $fmt = "gif" ; $pathseparator = "\\";}
  194. else
  195. { $env = "Linux" ; $fmt = "png" ; $pathseparator = "/";}
  196. if ($env ne "")
  197. { print "\nOS $env detected -> create image in $fmt format.\n" ; }
  198. else
  199. {
  200. print "\nOS not detected. Assuming Windows -> create image in $fmt format.\n" ;
  201. $env = "Windows" ;
  202. }
  203. }
  204. sub ParseScript
  205. {
  206. my $command ; # local version, $Command = global
  207. $LineNo = 0 ;
  208. $InputParsed = $false ;
  209. $CommandNext = "" ;
  210. $DateFormat = "x.y" ;
  211. $firstcmd = $true ;
  212. &GetCommand ;
  213. &StoreColor ("white", &EncodeInput ("gray(0.999)"), "") ;
  214. &StoreColor ("barcoldefault", &EncodeInput ("rgb(0,0.6,0)"), "") ;
  215. while (! $InputParsed)
  216. {
  217. if ($Command =~ /^\s*$/)
  218. { &GetCommand ; next ; }
  219. if (! ($Command =~ /$hIs/))
  220. { &Error ("Invalid statement. No '=' found.") ;
  221. &GetCommand ; next ; }
  222. if ($Command =~ /$hIs.*$hIs/)
  223. { &Error ("Invalid statement. Multiple '=' found.") ;
  224. &GetCommand ; next ; }
  225. my ($name, $value) = split ($hIs, $Command) ;
  226. $name =~ s/^\s*(.*?)\s*$/$1/ ;
  227. if ($name =~ /PlotDividers/i)
  228. { &Error ("Command 'PlotDividers' has been renamed to 'LineData', please adjust.") ;
  229. &GetCommand ; next ; }
  230. if ($name =~ /DrawLines/i)
  231. { &Error ("Command 'DrawLines' has been renamed to 'LineData', please adjust.\n" .
  232. " Reason for change is consistency: LineData now follows the same syntax rules as PlotData and TextData.") ;
  233. &GetCommand ; next ; }
  234. if ((! ($name =~ /^(?:Define)\s/)) &&
  235. (! ($name =~ /^(?:AlignBars|BarData|
  236. BackgroundColors|Colors|DateFormat|LineData|
  237. ScaleMajor|ScaleMinor|
  238. LegendLeft|LegendTop|
  239. ImageSize|PlotArea|Legend|
  240. Period|PlotData|Preset|
  241. TextData|TimeAxis)$/xi)))
  242. { &ParseUnknownCommand ;
  243. &GetCommand ; next ; }
  244. $value =~ s/^\s*(.*?)\s*// ;
  245. if (! ($name =~ /^(?:BarData|Colors|LineData|PlotData|TextData)$/i))
  246. {
  247. if ((! (defined ($value))) || ($value eq ""))
  248. {
  249. if ($name =~ /Preset/i)
  250. {
  251. &Error ("$name definition incomplete. No value specified\n" .
  252. " At the moment only one preset exists: 'TimeVertical_OneBar_UnitYear'.\n" .
  253. " See also meta.wikipedia.org/wiki/EasyTimeline/Presets") ;
  254. }
  255. else
  256. { &Error ("$name definition incomplete. No attributes specified") ; }
  257. &GetCommand ; next ; }
  258. }
  259. if ($name =~ /^(?:BackgroundColors|Colors|Period|ScaleMajor|ScaleMinor|TimeAxis)$/i)
  260. {
  261. my @attributes = split (" ", $value) ;
  262. foreach $attribute (@attributes)
  263. {
  264. my ($attrname, $attrvalue) = split ("\:", $attribute) ;
  265. if (! ($name."-".$attrname =~ /^(?:Colors-Value|Colors-Legend|
  266. Period-From|Period-Till|
  267. ScaleMajor-Color|ScaleMajor-Unit|ScaleMajor-Increment|ScaleMajor-Start|
  268. ScaleMinor-Color|ScaleMinor-Unit|ScaleMinor-Increment|ScaleMinor-Start|
  269. BackgroundColors-Canvas|BackgroundColors-Bars|
  270. TimeAxis-Orientation|TimeAxis-Format)$/xi))
  271. { &Error ("$name definition invalid. Unknown attribute '$attrname'.") ;
  272. &GetCommand ; next ; }
  273. if ((! defined ($attrvalue)) || ($attrvalue eq ""))
  274. { &Error ("$name definition incomplete. No value specified for attribute '$attrname'.") ;
  275. &GetCommand ; next ; }
  276. }
  277. }
  278. if ($Command =~ /^AlignBars/i) { &ParseAlignBars ; }
  279. elsif ($Command =~ /^BackgroundColors/i) { &ParseBackgroundColors ; }
  280. elsif ($Command =~ /^BarData/i) { &ParseBarData ; }
  281. elsif ($Command =~ /^Colors/i) { &ParseColors ; }
  282. elsif ($Command =~ /^DateFormat/i) { &ParseDateFormat ; }
  283. elsif ($Command =~ /^Define/i) { &ParseDefine ; }
  284. elsif ($Command =~ /^ImageSize/i) { &ParseImageSize ; }
  285. elsif ($Command =~ /^Legend/i) { &ParseLegend ; }
  286. elsif ($Command =~ /^LineData/i) { &ParseLineData ; }
  287. elsif ($Command =~ /^Period/i) { &ParsePeriod ; }
  288. elsif ($Command =~ /^PlotArea/i) { &ParsePlotArea ; }
  289. elsif ($Command =~ /^PlotData/i) { &ParsePlotData ; }
  290. elsif ($Command =~ /^Preset/i) { &ParsePreset ; }
  291. elsif ($Command =~ /^Scale/i) { &ParseScale ; }
  292. elsif ($Command =~ /^TextData/i) { &ParseTextData ; }
  293. elsif ($Command =~ /^TimeAxis/i) { &ParseTimeAxis ; }
  294. &GetCommand ;
  295. $firstcmd = $false ;
  296. }
  297. if ($CntErrors == 0)
  298. { &DetectMissingCommands ; }
  299. if ($CntErrors == 0)
  300. { &ValidateAndNormalizeDimensions ; }
  301. }
  302. sub GetLine
  303. {
  304. if ($#lines < 0)
  305. { $InputParsed = $true ; return ("") ; }
  306. # running in Wikipedia context and first line empty ?
  307. # skip first line without incrementing line count
  308. # this is part behind <timeline> and will not be thought of as line 1
  309. if (defined @options {"A"})
  310. {
  311. if (($#lines >= 0) && (@lines [0] =~ /^\s*$/))
  312. { $Line = shift (@lines) ; }
  313. }
  314. $Line = "" ;
  315. while (($#lines >= 0) && ($Line =~ /^\s*$/))
  316. {
  317. $LineNo ++ ;
  318. $Line = shift (@lines) ;
  319. chomp ($Line) ;
  320. if ($listinput)
  321. { print "$LineNo: " . &DecodeInput ($Line) . "\n" ; }
  322. # preserve '#' within double quotes
  323. $Line =~ s/(\"[^\"]*\")/$a=$1,$a=~s^\#^\%\?\+^g,$a/ge ;
  324. $Line =~ s/#>.*?<#//g ;
  325. if ($Line =~ /#>/)
  326. {
  327. $commentstart = $LineNo ;
  328. $Line =~ s/#>.*?$// ;
  329. }
  330. elsif ($Line =~ /<#/)
  331. {
  332. undef $commentstart ;
  333. $Line =~ s/^.*?<#//x ;
  334. }
  335. elsif (defined ($commentstart))
  336. { $Line = "" ; next ; }
  337. # remove single line comments (keep html char tags, like &#32;)
  338. $Line =~ s/\&\#/\&\$\%/g ;
  339. $Line =~ s/\#.*$// ;
  340. $Line =~ s/\&\$\%/\&\#/g ;
  341. $Line =~ s/\%\?\+/\#/g ;
  342. $Line =~ s/\s*$//g ;
  343. $Line =~ s/\t/ /g ;
  344. }
  345. if ($Line !~ /^\s*$/)
  346. {
  347. $Line = &EncodeInput ($Line) ;
  348. if (! ($Line =~ /^\s*Define/i))
  349. { $Line =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($Line,$1)/ge ; }
  350. }
  351. if (($#lines < 0) && (defined ($commentstart)))
  352. { &Error2 ("No matching end of comment found for comment block starting at line $commentstart.\n" .
  353. "Text between \#> and <\# (multiple lines) or following \# (single line) will be treated as comment.") ; }
  354. return ($Line) ;
  355. }
  356. sub GetCommand
  357. {
  358. undef (%Attributes) ;
  359. $Command = "" ;
  360. if ($CommandNext ne "")
  361. {
  362. $Command = $CommandNext ;
  363. $CommandNext = "" ;
  364. }
  365. else
  366. { $Command = &GetLine ; }
  367. if ($Command =~ /^\s/)
  368. {
  369. &Error ("New command expected instead of data line (= line starting with spaces). Data line(s) ignored.\n") ;
  370. $Command = &GetLine ;
  371. while (($#lines >= 0) && ($Command =~ /^\s/))
  372. { $Command = &GetLine ; }
  373. }
  374. if ($Command =~ /^[^\s]/)
  375. {
  376. $line = $Command ;
  377. $line =~ s/^.*$hIs\s*// ;
  378. &CollectAttributes ($line) ;
  379. }
  380. }
  381. sub GetData
  382. {
  383. undef (%Attributes) ;
  384. $Command = "" ;
  385. $NoData = $false ;
  386. my $line = &GetLine ;
  387. if ($line =~ /^[^\s]/)
  388. {
  389. $CommandNext = $line ;
  390. $NoData = $true ;
  391. return ("") ;
  392. }
  393. if ($line =~ /^\s*$/)
  394. {
  395. $NoData = $true ;
  396. return ("") ;
  397. }
  398. $line =~ s/^\s*//g ;
  399. &CollectAttributes ($line) ;
  400. }
  401. sub CollectAttributes
  402. {
  403. my $line = shift ;
  404. $line =~ s/(\slink\:[^\s\:]*)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax
  405. $line =~ s/(\stext\:[^\s\:]*)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax
  406. $line =~ s/(https?)\:/$1'colon'/i ; # replace colon (:), would conflict with syntax
  407. my $text ;
  408. ($line, $text) = &ExtractText ($line) ;
  409. $text =~ s/'colon'/:/ ;
  410. $line =~ s/( $hBrO .+? $hBrC )/&RemoveSpaces($1)/gxe ;
  411. $line =~ s/\s*\:\s*/:/g ;
  412. $line =~ s/([a-zA-Z0-9\_]+)\:/lc($1) . ":"/gxe ;
  413. @Fields = split (" ", $line) ;
  414. $name = "" ;
  415. foreach $field (@Fields)
  416. {
  417. if ($field =~ /\:/)
  418. {
  419. ($name, $value) = split (":", $field) ;
  420. $name =~ s/^\s*(.*)\s*$/lc($1)/gxe ;
  421. $value =~ s/^\s*(.*)\s*$/$1/gxe ;
  422. if (($name ne "bar") && ($name ne "text") && ($name ne "link") && ($name ne "legend")) # && ($name ne "hint")
  423. { $value = lc ($value) ; }
  424. if ($name eq "link") # restore colon
  425. { $value =~ s/'colon'/:/ ; }
  426. if ($value eq "")
  427. {
  428. if ($name =~ /Text/i)
  429. { $value = " " ; }
  430. else
  431. { &Error ("No value specified for attribute '$name'. Attribute ignored.") ; }
  432. }
  433. else
  434. { @Attributes {$name} = $value ; }
  435. }
  436. else
  437. {
  438. if (defined (@Attributes {"single"}))
  439. { &Error ("Invalid attribute '$field' ignored.\nSpecify attributes as 'name:value' pair(s).") ; }
  440. else
  441. {
  442. $field =~ s/^\s*(.*)\s*$/$1/gxe ;
  443. @Attributes {"single"} = $field ;
  444. }
  445. }
  446. }
  447. if (($name ne "") && (@Attributes {"single"} ne ""))
  448. {
  449. &Error ("Invalid attribute '" . @Attributes {"single"} . "' ignored.\nSpecify attributes as 'name:value' pairs.") ;
  450. delete (@Attributes {"single"}) ;
  451. }
  452. if ((defined ($text)) && ($text ne ""))
  453. { @Attributes {"text"} = &ParseText ($text) ; }
  454. }
  455. sub GetDefine
  456. {
  457. my $command = shift ;
  458. my $const = shift ;
  459. $const = lc ($const) ;
  460. my $value = @Consts {lc ($const)} ;
  461. if (! defined ($value))
  462. {
  463. &Error ("Unknown constant. 'Define $const = ... ' expected.") ;
  464. return ($const);
  465. }
  466. return ($value) ;
  467. }
  468. sub ParseAlignBars
  469. {
  470. &CheckPreset ("AlignBars") ;
  471. $align = @Attributes {"single"} ;
  472. if (! ($align =~ /^(?:justify|early|late)$/i))
  473. { &Error ("AlignBars value '$align' invalid. Specify 'justify', 'early' or 'late'.") ; return ; }
  474. $AlignBars = lc ($align) ;
  475. }
  476. sub ParseBackgroundColors
  477. {
  478. if (! &ValidAttributes ("BackgroundColors"))
  479. { &GetData ; next ;}
  480. &CheckPreset ("BackGroundColors") ;
  481. foreach $attribute (keys %Attributes)
  482. {
  483. my $attrvalue = @Attributes {$attribute} ;
  484. if ($attribute =~ /Canvas/i)
  485. {
  486. if (! &ColorPredefined ($attrvalue))
  487. {
  488. if (! defined (@Colors {lc ($attrvalue)}))
  489. { &Error ("BackgroundColors definition invalid. Attribute '$attribute': unknown color '$attrvalue'.\n" .
  490. " Specify command 'Color' before this command.") ; return ; }
  491. }
  492. if (defined (@Colors {lc ($attrvalue)}))
  493. { @Attributes {"canvas"} = @Colors { lc ($attrvalue) } ; }
  494. else
  495. { @Attributes {"canvas"} = lc ($attrvalue) ; }
  496. }
  497. elsif ($attribute =~ /Bars/i)
  498. {
  499. if (! defined (@Colors {lc ($attrvalue)}))
  500. { &Error ("BackgroundColors definition invalid. Attribute '$attribute' unknown color '$attrvalue'.\n" .
  501. " Specify command 'Color' before this command.") ; return ; }
  502. @Attributes {"bars"} = lc ($attrvalue) ;
  503. }
  504. }
  505. %BackgroundColors = %Attributes ;
  506. }
  507. sub ParseBarData
  508. {
  509. &GetData ;
  510. if ($NoData)
  511. { &Error ("Data expected for command 'BarData', but line is not indented.\n") ; return ; }
  512. my ($bar, $text, $link, $hint, $barset) ; # , $barcount) ;
  513. BarData:
  514. while ((! $InputParsed) && (! $NoData))
  515. {
  516. if (! &ValidAttributes ("BarData"))
  517. { &GetData ; next ;}
  518. $bar = "" ; $link = "" ; $hint = "" ; $barset = "" ; # $barcount = "" ;
  519. my $data2 = $data ;
  520. ($data2, $text) = &ExtractText ($data2) ;
  521. @Attributes = split (" ", $data2) ;
  522. foreach $attribute (keys %Attributes)
  523. {
  524. my $attrvalue = @Attributes {$attribute} ;
  525. if ($attribute =~ /^Bar$/i)
  526. {
  527. $bar = $attrvalue ;
  528. }
  529. elsif ($attribute =~ /^BarSet$/i)
  530. {
  531. $barset = $attrvalue ;
  532. }
  533. # elsif ($attribute =~ /^BarCount$/i)
  534. # {
  535. # $barcount = $attrvalue ;
  536. # if (($barcount !~ /^\d?\d?\d$/) || ($barcount < 2) || ($barcount > 200))
  537. # { &Error ("BarData attribute 'barcount' invalid. Specify a number between 2 and 200\n") ;
  538. # &GetData ; next BarData ; }
  539. # }
  540. elsif ($attribute =~ /^Text$/i)
  541. {
  542. $text = $attrvalue ;
  543. $text =~ s/\\n/~/gs ;
  544. if ($text =~ /\~/)
  545. { &Warning ("BarData attribute 'text' contains ~ (tilde).\n" .
  546. "Tilde will not be translated into newline character (only in PlotData)") ; }
  547. if ($text =~ /\^/)
  548. { &Warning ("BarData attribute 'text' contains ^ (caret).\n" .
  549. "Caret will not be translated into tab character (only in PlotData)") ; }
  550. }
  551. elsif ($attribute =~ /^Link$/i)
  552. {
  553. $link = &ParseText ($attrvalue) ;
  554. if ($link =~ /\[.*\]/)
  555. { &Error ("BarData attribute 'link' contains implicit (wiki style) link.\n" .
  556. "Use implicit link style with attribute 'text' only.\n") ;
  557. &GetData ; next BarData ; }
  558. $link = &EncodeURL (&NormalizeURL ($link)) ;
  559. $MapPNG = $true ;
  560. }
  561. }
  562. if (($bar eq "") && ($barset eq ""))
  563. { &Error ("BarData attribute missing. Specify either 'bar' of 'barset'.\n") ;
  564. &GetData ; next BarData ; }
  565. if (($bar ne "") && ($barset ne ""))
  566. { &Error ("BarData attributes 'bar' and 'barset' are mutually exclusive.\nSpecify one of these per data line\n") ;
  567. &GetData ; next BarData ; }
  568. # if (($barset ne "") && ($barcount eq ""))
  569. # { &Error ("BarData attribute 'barset' specified without attribute 'barcount'.\n") ;
  570. # &GetData ; next BarData ; }
  571. # if (($barset eq "") && ($barcount ne ""))
  572. # { &Error ("BarData attribute 'barcount' specified without attribute 'barset'.\n") ;
  573. # &GetData ; next BarData ; }
  574. if (($barset ne "") && ($link ne ""))
  575. { &Error ("BarData attribute 'link' not valid in combination with attribute 'barset'.\n") ;
  576. &GetData ; next BarData ; }
  577. if ($link ne "")
  578. {
  579. if ($text =~ /\[.*\]/)
  580. {
  581. &Warning ("BarData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" .
  582. "Implicit link(s) ignored.") ;
  583. $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ;
  584. }
  585. if ($hint eq "")
  586. { $hint = &ExternalLinkToHint ($link) ; }
  587. }
  588. if (($bar ne "") && ($bar !~ /[a-zA-Z0-9\_]+/))
  589. { &Error ("BarData attribute bar:'$bar' invalid.\nUse only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ;
  590. &GetData ; next BarData ; }
  591. if ($bar ne "")
  592. {
  593. if (@Axis {"time"} eq "x")
  594. { push @Bars, $bar ; }
  595. else
  596. { unshift @Bars, $bar ; }
  597. if ($text ne "")
  598. { @BarLegend {lc ($bar)} = $text ; }
  599. else
  600. { @BarLegend {lc ($bar)} = " " ; }
  601. if ($link ne "")
  602. { @BarLink {lc ($bar)} = $link ; }
  603. }
  604. else
  605. {
  606. # for ($b = 1 ; $b <= $barcount ; $b++)
  607. # {
  608. # $bar = $barset . "#" . $b ;
  609. $bar = $barset . "#1" ;
  610. if (@Axis {"time"} eq "x")
  611. { push @Bars, $bar ; }
  612. else
  613. { unshift @Bars, $bar ; }
  614. if ($text ne "")
  615. { @BarLegend {lc ($bar)} = $text . " - " . $b ; }
  616. else
  617. { @BarLegend {lc ($bar)} = " " ; }
  618. # }
  619. }
  620. &GetData ;
  621. }
  622. }
  623. sub ParseColors
  624. {
  625. &GetData ;
  626. if ($NoData)
  627. { &Error ("Data expected for command 'Colors', but line is not indented.\n") ; return ; }
  628. Colors:
  629. while ((! $InputParsed) && (! $NoData))
  630. {
  631. if (! &ValidAttributes ("Colors"))
  632. { &GetData ; next ;}
  633. &CheckPreset ("Colors") ;
  634. my $addtolegend = $false ;
  635. my $legendvalue = "" ;
  636. my $colorvalue = "" ;
  637. foreach $attribute (keys %Attributes)
  638. {
  639. my $attrvalue = @Attributes {$attribute} ;
  640. if ($attribute =~ /Id/i)
  641. {
  642. $colorname = $attrvalue ;
  643. }
  644. elsif ($attribute =~ /Legend/i)
  645. {
  646. $addtolegend = $true ;
  647. $legendvalue = $attrvalue ;
  648. if ($legendvalue =~ /^[yY]$/)
  649. { push @LegendData, $colorname ; }
  650. elsif (! ($attrvalue =~ /^[nN]$/))
  651. {
  652. $legendvalue = &ParseText ($legendvalue) ;
  653. push @LegendData, $legendvalue ;
  654. }
  655. }
  656. elsif ($attribute =~ /Value/i)
  657. {
  658. $colorvalue = $attrvalue ;
  659. if ($colorvalue =~ /^white$/i)
  660. { $colorvalue = "gray" . $hBrO . "0.999" . $hBrC ; }
  661. }
  662. }
  663. if (&ColorPredefined ($colorvalue))
  664. {
  665. &StoreColor ($colorname, $colorvalue, $legendvalue) ;
  666. &GetData ; next Colors ;
  667. }
  668. if ($colorvalue =~ /^[a-z]+$/i)
  669. {
  670. if (! ($colorvalue =~ /^(?:gray|rgb|hsb)/i))
  671. { &Error ("Color value invalid: unknown constant '$colorvalue'.") ;
  672. &GetData ; next Colors ; }
  673. }
  674. if (! ($colorvalue =~ /^(?:gray|rgb|hsb) $hBrO .+? $hBrC/xi))
  675. { &Error ("Color value invalid. Specify constant or 'gray/rgb/hsb(numeric values)' ") ;
  676. &GetData ; next Colors ; }
  677. if ($colorvalue =~ /^gray/i)
  678. {
  679. if ($colorvalue =~ /gray $hBrO (?:0|1|0\.\d+) $hBrC/xi)
  680. { &StoreColor ($colorname, $colorvalue, $legendvalue) ; }
  681. else
  682. { &Error ("Color value invalid. Specify 'gray(x) where 0 <= x <= 1' ") ; }
  683. &GetData ; next Colors ;
  684. }
  685. if ($colorvalue =~ /^rgb/i)
  686. {
  687. my $colormode = substr ($colorvalue,0,3) ;
  688. if ($colorvalue =~ /rgb $hBrO
  689. (?:0|1|0\.\d+) \,
  690. (?:0|1|0\.\d+) \,
  691. (?:0|1|0\.\d+)
  692. $hBrC/xi)
  693. { &StoreColor ($colorname, $colorvalue, $legendvalue) ; }
  694. else
  695. { &Error ("Color value invalid. Specify 'rgb(r,g,b) where 0 <= r,g,b <= 1' ") ; }
  696. &GetData ; next Colors ;
  697. }
  698. if ($colorvalue =~ /^hsb/i)
  699. {
  700. my $colormode = substr ($colorvalue,0,3) ;
  701. if ($colorvalue =~ /hsb $hBrO
  702. (?:0|1|0\.\d+) \,
  703. (?:0|1|0\.\d+) \,
  704. (?:0|1|0\.\d+)
  705. $hBrC/xi)
  706. { &StoreColor ($colorname, $colorvalue, $legendvalue) ; }
  707. else
  708. { &Error ("Color value invalid. Specify 'hsb(h,s,b) where 0 <= h,s,b <= 1' ") ; }
  709. &GetData ; next Colors ;
  710. }
  711. &Error ("Color value invalid.") ;
  712. &GetData ;
  713. }
  714. }
  715. sub StoreColor
  716. {
  717. my $colorname = shift ;
  718. my $colorvalue = shift ;
  719. my $legendvalue = shift ;
  720. if (defined (@Colors {lc ($colorname)}))
  721. { &Warning ("Color '$colorname' redefined.") ; }
  722. @Colors {lc ($colorname)} = lc ($colorvalue) ;
  723. if ((defined ($legendvalue)) && ($legendvalue ne ""))
  724. { @ColorLabels {lc ($colorname)} = $legendvalue ; }
  725. }
  726. sub ParseDateFormat
  727. {
  728. &CheckPreset ("DateFormat") ;
  729. my $datevalue = lc (@Attributes {"single"}) ;
  730. $datevalue =~ s/\s//g ;
  731. $datevalue = lc ($datevalue) ;
  732. if (($datevalue ne "dd/mm/yyyy") && ($datevalue ne "mm/dd/yyyy") && ($datevalue ne "yyyy") && ($datevalue ne "x.y"))
  733. { &Error ("Invalid DateFormat. Specify as 'dd/mm/yyyy', 'mm/dd/yyyy', 'yyyy' or 'x.y'\n" .
  734. " (use first two only for years >= 1800)\n") ; return ; }
  735. $DateFormat = $datevalue ;
  736. }
  737. sub ParseDefine
  738. {
  739. my $command = $Command ;
  740. my $command2 = $command ;
  741. $command2 =~ s/^Define\s*//i ;
  742. my ($name, $value) = split ($hIs, $command2) ;
  743. $name =~ s/^\s*(.*?)\s*$/$1/g ;
  744. $value =~ s/^\s*(.*?)\s*$/$1/g ;
  745. if (! ($name =~ /^$hDollar/))
  746. { &Error ("Define '$name' invalid. Name does not start with '\$'.") ; return ; }
  747. if (! ($name =~ /^$hDollar[a-zA-Z0-9\_]+$/))
  748. { &Error ("Define '$name' invalid. Valid characters are 'a'-'z', 'A'-'Z', '0'-'9', '_'.") ; return ; }
  749. $value =~ s/($hDollar[a-zA-Z0-9]+)/&GetDefine($command,$1)/ge ;
  750. @Consts {lc ($name)} = $value ;
  751. }
  752. sub ParseLineData
  753. {
  754. &GetData ;
  755. if ($NoData)
  756. { &Error ("Data expected for command 'LineData', but line is not indented.\n") ; return ; }
  757. if ((! (defined ($DateFormat))) || (! (defined (@Period {"from"}))))
  758. {
  759. if (! (defined ($DateFormat)))
  760. { &Error ("LineData invalid. No (valid) command 'DateFormat' specified in previous lines.") ; }
  761. else
  762. { &Error ("LineData invalid. No (valid) command 'Period' specified in previous lines.") ; }
  763. while ((! $InputParsed) && (! $NoData))
  764. { &GetData ; }
  765. return ;
  766. }
  767. my ($at, $from, $till, $atpos, $frompos, $tillpos, $color, $layer, $width, $points, $explanation) ;
  768. $layer = "front" ;
  769. $width = 2.0 ;
  770. my $data2 = $data ;
  771. LineData:
  772. while ((! $InputParsed) && (! $NoData))
  773. {
  774. $at = "" ; $from = "" ; $till = "" ; $atpos = "" ; $frompos = "" ; $tillpos = "" ; $points = "" ;
  775. &CheckPreset ("LineData") ;
  776. if (! &ValidAttributes ("LineData"))
  777. { &GetData ; next ;}
  778. if (defined (@LineDefs {"color"})) { $color = @LineDefs {"color"} ; }
  779. if (defined (@LineDefs {"layer"})) { $layer = @LineDefs {"layer"} ; }
  780. if (defined (@LineDefs {"width"})) { $width = @LineDefs {"width"} ; }
  781. if (defined (@LineDefs {"frompos"})) { $frompos = @LineDefs {"frompos"} ; }
  782. if (defined (@LineDefs {"tillpos"})) { $tillpos = @LineDefs {"tillpos"} ; }
  783. if (defined (@LineDefs {"atpos"})) { $atpos = @LineDefs {"atpos"} ; }
  784. foreach $attribute (keys %Attributes)
  785. {
  786. my $attrvalue = @Attributes {$attribute} ;
  787. if ($attribute =~ /^(?:At|From|Till)$/i)
  788. {
  789. if ($attrvalue =~ /^Start$/i)
  790. { $attrvalue = @Period {"from"} ; }
  791. if ($attrvalue =~ /^End$/i)
  792. { $attrvalue = @Period {"till"} ; }
  793. if (! &ValidDateFormat ($attrvalue))
  794. { &Error ("LineData attribute '$attribute' invalid.\n" .
  795. "Date does not conform to specified DateFormat '$DateFormat'.") ;
  796. &GetData ; next LineData ; }
  797. if (! &ValidDateRange ($attrvalue))
  798. { &Error ("LineData attribute '$attribute' invalid.\n" .
  799. "Date '$attrvalue' not within range as specified by command Period.") ;
  800. &GetData ; next LineData ; }
  801. # if (substr ($attrvalue,6,4) < 1800)
  802. # { &Error ("LineData attribute '$attribute' invalid. Specify year >= 1800.") ;
  803. # &GetData ; next LineData ; }
  804. if ($attribute =~ /At/i)
  805. {
  806. $at = $attrvalue ; $from = "" ; $till = "" ; }
  807. elsif ($attribute =~ /From/i)
  808. { $from = $attrvalue ; $at = "" ; }
  809. else
  810. { $till = $attrvalue ; $at = "" ; }
  811. }
  812. elsif ($attribute =~ /^(?:atpos|frompos|tillpos)$/i)
  813. {
  814. if ($attrvalue =~ /^(?:Start|End)$/i)
  815. { $attrvalue = lc ($attrvalue) ; }
  816. elsif (! &ValidAbs ($attrvalue))
  817. { &Error ("LineData attribute '$attribute' invalid.\n" .
  818. "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ;
  819. &GetData ; next LineData ; }
  820. if ($attribute =~ /atpos/i)
  821. { $atpos = &Normalize ($attrvalue) ; }
  822. elsif ($attribute =~ /frompos/i)
  823. { $frompos = &Normalize ($attrvalue) ; }
  824. else
  825. { $tillpos = &Normalize ($attrvalue) ; }
  826. }
  827. elsif ($attribute =~ /Color/i)
  828. {
  829. if ((! &ColorPredefined ($attrvalue)) && (! defined (@Colors {lc ($attrvalue)})))
  830. { &Error ("LineData attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" .
  831. " Specify command 'Color' before this command.") ;
  832. &GetData ; next LineData ; }
  833. if (! &ColorPredefined ($attrvalue))
  834. { $attrvalue = @Colors {lc ($attrvalue)} ; }
  835. $color = $attrvalue ;
  836. }
  837. elsif ($attribute =~ /Layer/i)
  838. {
  839. if (! ($attrvalue =~ /^(?:back|front)$/i))
  840. { &Error ("LineData attribute '$attrvalue' invalid.\nSpecify back(default) or front") ;
  841. &GetData ; next LineData ; }
  842. $layer = $attrvalue ;
  843. }
  844. elsif ($attribute =~ /Points/i)
  845. {
  846. $attribute =~ s/\s//g ;
  847. if ($attrvalue !~ /^$hBrO\d+\,\d+$hBrC$hBrO\d+\,\d+$hBrC$/)
  848. { &Error ("LineData attribute '$attrvalue' invalid.\nSpecify 'points:(x1,y1)(x2,y2)'") ;
  849. &GetData ; next LineData ; }
  850. $attrvalue =~ s/^$hBrO(\d+)\,(\d+)$hBrC$hBrO(\d+)\,(\d+)$hBrC$/$1,$2,$3,$4/ ;
  851. $points = $attrvalue ;
  852. }
  853. elsif ($attribute =~ /Width/i)
  854. {
  855. if (! &ValidAbs ($attrvalue))
  856. { &Error ("LineData attribute '$attribute' invalid.\n" .
  857. "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ;
  858. &GetData ; next LineData ; }
  859. if (($attrvalue < 0.1) || ($attrvalue > 10))
  860. { &Error ("LineData attribute '$attribute' invalid.\n" .
  861. "Specify value as between 0.1 and 10") ;
  862. &GetData ; next LineData ; }
  863. $width = $attrvalue ;
  864. }
  865. }
  866. if (($at eq "") && ($from eq "") && ($till eq "") && ($points eq "")) # upd defaults
  867. {
  868. if ($color ne "") { @LineDefs {"color"} = $color ; }
  869. if ($layer ne "") { @LineDefs {"layer"} = $layer ; }
  870. if ($width ne "") { @LineDefs {"width"} = $width ; }
  871. if ($atpos ne "") { @LineDefs {"atpos"} = $atpos ; }
  872. if ($frompos ne "") { @LineDefs {"frompos"} = $frompos ; }
  873. if ($tillpos ne "") { @LineDefs {"tillpos"} = $tillpos ; }
  874. }
  875. if ($layer eq "")
  876. { $layer = "back" ; }
  877. if ($color eq "")
  878. { $color = "black" ; }
  879. $explanation = "\nA line is defined as follows:\n" .
  880. " Perpendicular to the time axis: 'at frompos tillpos'\n" .
  881. " Parralel to the time axis: 'from till atpos'\n" .
  882. " Any direction: points(x1,y1)(x2,y2)\n" .
  883. " at,from,till expect date/time values, just like with command PlotData\n" .
  884. " frompos,tillpos,atpos,x1,x2,y1,y2 expect coordinates (e.g. pixels values)\n" ;
  885. if (($at ne "") && (($from ne "") || ($till ne "") || ($points ne "")))
  886. { &Error ("LineData attribute 'at' can not be combined with 'from', 'till' or 'points'\n" . $explanation) ;
  887. $explanation = "" ;
  888. &GetData ; next LineData ; }
  889. if ((($from ne "") && ($till eq "")) || (($from eq "") && ($till ne "")))
  890. { &Error ("LineData attributes 'from' and 'till' should always be specified together\n" . $explanation) ;
  891. $explanation = "" ;
  892. &GetData ; next LineData ; }
  893. if (($points ne "") && (($from ne "") || ($till ne "") || ($at ne "")))
  894. { &Error ("LineData attribute 'points' can not be combined with 'at', 'from' or 'till'\n" . $explanation) ;
  895. $explanation = "" ;
  896. &GetData ; next LineData ; }
  897. if ($at ne "")
  898. { push @DrawLines, sprintf ("1|%s|%s|%s|%s|%s|%s\n", $at, $frompos, $tillpos, lc ($color), $width, lc ($layer)) ; }
  899. if ($from ne "")
  900. { push @DrawLines, sprintf ("2|%s|%s|%s|%s|%s|%s\n", $atpos, $from, $till, lc ($color), $width, lc ($layer)) ; }
  901. if ($points ne "")
  902. { push @DrawLines, sprintf ("3|%s|%s|%s|%s\n", $points, lc ($color), $width, lc ($layer)) ; }
  903. &GetData ;
  904. }
  905. }
  906. sub ParseImageSize
  907. {
  908. if (! &ValidAttributes ("ImageSize")) { return ; }
  909. &CheckPreset ("ImageSize") ;
  910. foreach $attribute (keys %Attributes)
  911. {
  912. my $attrvalue = @Attributes {$attribute} ;
  913. if ($attribute =~ /Width|Height/i)
  914. {
  915. if ($attrvalue !~ /auto/i)
  916. {
  917. if (! &ValidAbs ($attrvalue))
  918. { &Error ("ImageSize attribute '$attribute' invalid.\n" .
  919. "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; }
  920. }
  921. }
  922. elsif ($attribute =~ /BarIncrement/i)
  923. {
  924. if (! &ValidAbs ($attrvalue))
  925. { &Error ("ImageSize attribute '$attribute' invalid.\n" .
  926. "Specify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; }
  927. @Attributes {"barinc"} = $attrvalue ;
  928. }
  929. # if ($attribute =~ /Width/i)
  930. # { @Attributes {"width"} = $attrvalue ; }
  931. # elsif ($attribute =~ /Height/i)
  932. # { @Attributes {"height"} = $attrvalue ; }
  933. }
  934. if ((@Attributes {"width"} =~ /auto/i) || (@Attributes {"height"} =~ /auto/i))
  935. {
  936. if (@Attributes {"barinc"} eq "")
  937. { &Error ("ImageSize attribute 'barincrement' missing.\n" .
  938. "Automatic determination of image width or height implies specification of this attribute") ; return ; }
  939. }
  940. if ((@Attributes {"width"} !~ /auto/i) && (@Attributes {"height"} !~ /auto/i))
  941. {
  942. if (@Attributes {"barinc"} ne "")
  943. { &Error ("ImageSize attribute 'barincrement' not valid now.\n" .
  944. "This attribute is only valid (and mandatory) in combination with 'width:auto' or 'height:auto'") ; return ; }
  945. }
  946. %Image = %Attributes ;
  947. }
  948. sub ParseLegend
  949. {
  950. if (! &ValidAttributes ("Legend")) { return ; }
  951. &CheckPreset ("Legend") ;
  952. foreach $attribute (keys %Attributes)
  953. {
  954. my $attrvalue = @Attributes {$attribute} ;
  955. if ($attribute =~ /Columns/i)
  956. {
  957. if (($attrvalue < 1) || ($attrvalue > 4))
  958. { &Error ("Legend attribute 'columns' invalid. Specify 1,2,3 or 4") ; return ; }
  959. }
  960. elsif ($attribute =~ /Orientation/i)
  961. {
  962. if (! ($attrvalue =~ /^(?:hor|horizontal|ver|vertical)$/i))
  963. { &Error ("Legend attribute '$attrvalue' invalid. Specify hor[izontal] or ver[tical]") ; return ; }
  964. @Attributes {"orientation"} = substr ($attrvalue,0,3) ;
  965. }
  966. elsif ($attribute =~ /Position/i)
  967. {
  968. if (! ($attrvalue =~ /^(?:top|bottom|right)$/i))
  969. { &Error ("Legend attribute '$attrvalue' invalid.\nSpecify top, bottom or right") ; return ; }
  970. }
  971. elsif ($attribute =~ /Left/i)
  972. {
  973. if (! &ValidAbsRel ($attrvalue))
  974. { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } }
  975. elsif ($attribute =~ /Top/i)
  976. {
  977. if (! &ValidAbsRel ($attrvalue))
  978. { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; } }
  979. elsif ($attribute =~ /ColumnWidth/i)
  980. {
  981. if (! &ValidAbsRel ($attrvalue))
  982. { &Error ("Legend attribute '$attribute' invalid.\nSpecify value as x[.y][px, in, cm] examples: '200', '20px', '1.3in'") ; return ; }
  983. }
  984. }
  985. if (defined (@Attributes {"position"}))
  986. {
  987. if (defined (@Attributes {"left"}))
  988. { &Error ("Legend definition invalid. Attributes 'position' and 'left' are mutually exclusive.") ; return ; }
  989. }
  990. else
  991. {
  992. if ((! defined (@Attributes {"left"})) && (! defined (@Attributes {"top"})))
  993. {
  994. &Info ("Legend definition: none of attributes 'position', 'left' or 'top' have been defined. Position 'bottom' assumed.") ;
  995. @Attributes {"position"} = "bottom" ;
  996. }
  997. elsif ((! defined (@Attributes {"left"})) || (! defined (@Attributes {"top"})))
  998. { &Error ("Legend definition invalid. Specify 'position', or 'left' & 'top'.") ; return ; }
  999. }
  1000. if (@Attributes {"position"} =~ /right/i)
  1001. {
  1002. if (defined (@Attributes {"columns"}))
  1003. { &Error ("Legend definition invalid.\nAttribute 'columns' and 'position:right' are mutually exclusive.") ; return ; }
  1004. if (defined (@Attributes {"columnwidth"}))
  1005. { &Error ("Legend definition invalid.\nAttribute 'columnwidth' and 'position:right' are mutually exclusive.") ; return ; }
  1006. }
  1007. if (@Attributes {"orientation"} =~ /hor/i)
  1008. {
  1009. if (@Attributes {"position"} =~ /right/i)
  1010. { &Error ("Legend definition invalid.\n'position:right' and 'orientation:horizontal' are mutually exclusive.") ; return ; }
  1011. if (defined (@Attributes {"columns"}))
  1012. { &Error ("Legend definition invalid.\nAttribute 'columns' and 'orientation:horizontal' are mutually exclusive.") ; return ; }
  1013. if (defined (@Attributes {"columnwidth"}))
  1014. { &Error ("Legend definition invalid.\nAttribute 'columnwidth' and 'orientation:horizontal' are mutually exclusive.") ; return ; }
  1015. }
  1016. if ((@Attributes {"orientation"} =~ /hor/i) && (defined (@Attributes {"columns"})))
  1017. { &Error ("Legend definition invalid.\nDo not specify attribute 'columns' with 'orientation:horizontal'.") ; return ; }
  1018. if (@Attributes {"columns"} > 1)
  1019. {
  1020. if ((defined (@Attributes {"left"})) && (! defined (@Attributes {"columnwidth"})))
  1021. { &Error ("Legend attribute 'columnwidth' not defined.\nThis is needed when attribute 'left' is specified.") ; return ; }
  1022. }
  1023. if (! defined (@Attributes {"orientation"}))
  1024. { @Attributes {"orientation"} = "ver" ; }
  1025. %Legend = %Attributes ;
  1026. }
  1027. sub ParsePeriod
  1028. {
  1029. if (! defined ($DateFormat))
  1030. { &Error ("Period definition ambiguous. No (valid) command 'DateFormat' specified in previous lines.") ; return ; }
  1031. if (! ValidAttributes ("Period")) { return ; }
  1032. foreach $attribute (keys %Attributes)
  1033. {
  1034. my $attrvalue = @Attributes {$attribute} ;
  1035. if ($DateFormat eq "yyyy")
  1036. {
  1037. if ($attrvalue !~ /^\-?\d+$/)
  1038. { &Error ("Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'.") ; return ; }
  1039. }
  1040. elsif ($DateFormat eq "x.y")
  1041. {
  1042. if (! ($attrvalue =~ /^\-?\d+(?:\.\d+)?$/))
  1043. { &Error ("Period definition invalid.\nInvalid year '$attrvalue' specified for attribute '$attribute'.") ; return ; }
  1044. }
  1045. else
  1046. {
  1047. if (($attrvalue =~ /^\d+$/) && ($attrvalue >= 1800) && ($attrvalue <= 2030))
  1048. {
  1049. if ($attribute =~ /^From$/i)
  1050. { $attrvalue = "01/01/" . $attrvalue ; }
  1051. if ($attribute =~ /^Till$/i)
  1052. {
  1053. if ($DateFormat eq "dd/mm/yyyy")
  1054. { $attrvalue = "31/12/" . $attrvalue ; }
  1055. else
  1056. { $attrvalue = "12/31/" . $attrvalue ; }
  1057. }
  1058. }
  1059. $ValidDate = &ValidDateFormat ($attrvalue) ;
  1060. if (! $ValidDate)
  1061. { &Error ("Period attribute '$attribute' invalid.\n" .
  1062. "Date does not conform to specified DateFormat '$DateFormat'.") ; return ; }
  1063. if (substr ($attrvalue,6,4) < 1800)
  1064. { &Error ("Period attribute '$attribute' invalid. Specify year >= 1800.") ; return ; }
  1065. @Attributes {$attribute} = $attrvalue ;
  1066. }
  1067. }
  1068. %Period = %Attributes ;
  1069. }
  1070. sub ParsePlotArea
  1071. {
  1072. if (! &ValidAttributes ("PlotArea")) { return ; }
  1073. &CheckPreset ("PlotArea") ;
  1074. foreach $attribute (@Attributes)
  1075. {
  1076. my $attrvalue = @Attributes {$attribute} ;
  1077. if (! &ValidAbsRel ($attrvalue))
  1078. { &Error ("PlotArea attribute '$attribute' invalid.\n" .
  1079. "Specify value as x[.y][px, in, cm, %] examples: '200', '20px', '1.3in', '80%'") ; return ; }
  1080. }
  1081. if ((@Attributes {"top"} ne "") && (@Attributes {"height"} ne ""))
  1082. { &Error ("PlotArea attributes 'top' and 'height' are mutually exclusive. Specify only one of them.") ; return ; }
  1083. if ((@Attributes {"right"} ne "") && (@Attributes {"width"} ne ""))
  1084. { &Error ("PlotArea attributes 'right' and 'width' are mutually exclusive. Specify only one of them.") ; return ; }
  1085. if ((@Attributes {"top"} eq "") && (@Attributes {"height"} eq ""))
  1086. { &Error ("PlotArea definition incomplete. Either attribute 'top' (advised) or 'height' should be specified") ; return ; }
  1087. if ((@Attributes {"right"} eq "") && (@Attributes {"width"} eq ""))
  1088. { &Error ("PlotArea definition incomplete. Either attribute 'right' (advised) or 'width' should be specified") ; return ; }
  1089. %PlotArea = %Attributes ;
  1090. }
  1091. # command Bars found ?
  1092. # Y | N
  1093. # bar: found ? | bar: found ?
  1094. # Y | N | Y | N
  1095. # validate | previous bar: found? | @Bars contains | previous bar: found?
  1096. # bar:.. | | bar: ? | Y | N
  1097. # | Y | N | | copy | assume
  1098. # | copy | $#Bars .. | Y | N | bar: | bar:---
  1099. # | bar: |== 0 | - | assume | |
  1100. # | | assume bar:--- | | bar:--- | |
  1101. # | |== 1 |
  1102. # | | assume @Bar[0] |
  1103. # | |> 1 |
  1104. # | | err |
  1105. sub ParsePlotData
  1106. {
  1107. if (defined (@Bars))
  1108. { $BarsCommandFound = $true ; }
  1109. else
  1110. { $BarsCommandFound = $false ; }
  1111. $prevbar = "" ;
  1112. if ((! (defined ($DateFormat))) || (@Period {"from"} eq "") || (@Axis {"time"} eq ""))
  1113. {
  1114. if (! (defined ($DateFormat)))
  1115. { &Error ("PlotData invalid. No (valid) command 'DateFormat' specified in previous lines.") ; }
  1116. elsif (@Period {"from"} eq "")
  1117. { &Error ("PlotData invalid. No (valid) command 'Period' specified in previous lines.") ; }
  1118. else
  1119. { &Error ("PlotData invalid. No (valid) command 'TimeAxis' specified in previous lines.") ; }
  1120. &GetData ;
  1121. while ((! $InputParsed) && (! $NoData))
  1122. { &GetData ; }
  1123. return ;
  1124. }
  1125. &GetData ;
  1126. if ($NoData)
  1127. { &Error ("Data expected for command 'PlotData', but line is not indented.\n") ; return ; }
  1128. my ($bar, $at, $from, $till, $color, $bgcolor, $textcolor, $fontsize, $width,
  1129. $text, $anchor, $align, $shift, $shiftx, $shifty, $mark, $markcolor, $link, $hint) ;
  1130. @PlotDefs {"anchor"} = "middle" ;
  1131. PlotData:
  1132. while ((! $InputParsed) && (! $NoData))
  1133. {
  1134. if (! &ValidAttributes ("PlotData"))
  1135. { &GetData ; next ;}
  1136. $bar = "" ; # $barset = "" ;
  1137. $at = "" ; $from = "" ; $till = "" ;
  1138. $color = "barcoldefault" ; $bgcolor = "" ; $textcolor = "black" ; $fontsize = "S" ; $width = "0.25" ;
  1139. $text = "" ; $align = "left" ; $shift = "" ; $shiftx = "" ; $shifty = "" ; $anchor = "" ;
  1140. $mark = "" ; $markcolor = "" ;
  1141. $link = "" ; $hint = "" ;
  1142. &CheckPreset ("PlotData") ;
  1143. if (defined (@PlotDefs {"bar"})) { $bar = @PlotDefs {"bar"} ; }
  1144. # if (defined (@PlotDefs {"barset"})) { $barset = @PlotDefs {"barset"} ; }
  1145. if (defined (@PlotDefs {"color"})) { $color = @PlotDefs {"color"} ; }
  1146. if (defined (@PlotDefs {"bgcolor"})) { $bgcolor = @PlotDefs {"bgcolor"} ; }
  1147. if (defined (@PlotDefs {"textcolor"})) { $textcolor = @PlotDefs {"textcolor"} ; }
  1148. if (defined (@PlotDefs {"fontsize"})) { $fontsize = @PlotDefs {"fontsize"} ; }
  1149. if (defined (@PlotDefs {"width"})) { $width = @PlotDefs {"width"} ; }
  1150. if (defined (@PlotDefs {"anchor"})) { $anchor = @PlotDefs {"anchor"} ; }
  1151. if (defined (@PlotDefs {"align"})) { $align = @PlotDefs {"align"} ; }
  1152. if (defined (@PlotDefs {"shiftx"})) { $shiftx = @PlotDefs {"shiftx"} ; }
  1153. if (defined (@PlotDefs {"shifty"})) { $shifty = @PlotDefs {"shifty"} ; }
  1154. if (defined (@PlotDefs {"mark"})) { $mark = @PlotDefs {"mark"} ; }
  1155. if (defined (@PlotDefs {"markcolor"})) { $markcolor = @PlotDefs {"markcolor"} ; }
  1156. # if (defined (@PlotDefs {"link"})) { $link = @PlotDefs {"link"} ; }
  1157. # if (defined (@PlotDefs {"hint"})) { $hint = @PlotDefs {"hint"} ; }
  1158. foreach $attribute (keys %Attributes)
  1159. {
  1160. my $attrvalue = @Attributes {$attribute} ;
  1161. if ($attribute =~ /^Bar$/i)
  1162. {
  1163. if (! ($attrvalue =~ /[a-zA-Z0-9\_]+/))
  1164. { &Error ("PlotData attribute '$attribute' invalid.\n" .
  1165. "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ;
  1166. &GetData ; next PlotData ; }
  1167. $attrvalue2 = $attrvalue ;
  1168. if ($BarsCommandFound)
  1169. {
  1170. if (! &BarDefined ($attrvalue2))
  1171. { &Error ("PlotData invalid. Bar '$attrvalue' not (properly) defined.") ;
  1172. &GetData ; next PlotData ; }
  1173. }
  1174. else
  1175. {
  1176. if (! &BarDefined ($attrvalue2))
  1177. {
  1178. if (@Axis {"time"} eq "x")
  1179. { push @Bars, $attrvalue2 ; }
  1180. else
  1181. { unshift @Bars, $attrvalue2 ; }
  1182. }
  1183. }
  1184. $bar = $attrvalue2 ;
  1185. $prevbar = $bar ;
  1186. }
  1187. elsif ($attribute =~ /^BarSet$/i)
  1188. {
  1189. if (! ($attrvalue =~ /[a-zA-Z0-9\_]+/))
  1190. { &Error ("PlotData attribute '$attribute' invalid.\n" .
  1191. "Use only characters 'a'-'z', 'A'-'Z', '0'-'9', '_'\n") ;
  1192. &GetData ; next PlotData ; }
  1193. $attrvalue2 = $attrvalue ;
  1194. if ($attrvalue =~ /break/i)
  1195. { $barndx = 0 ; }
  1196. elsif ($attrvalue =~ /skip/i)
  1197. {
  1198. $barndx ++ ;
  1199. &BarDefined ($prevbar . "#" . $barndx) ;
  1200. }
  1201. else
  1202. {
  1203. if ($BarsCommandFound)
  1204. {
  1205. if (! &BarDefined ($attrvalue2 . "#1"))
  1206. { &Error ("PlotData invalid. BarSet '$attrvalue' not (properly) defined with command BarData.") ;
  1207. &GetData ; next PlotData ; }
  1208. }
  1209. $bar = $attrvalue2 ;
  1210. if ($bar ne $prevbar)
  1211. { $barndx = 0 ; }
  1212. $prevbar = $bar ;
  1213. }
  1214. }
  1215. elsif ($attribute =~ /^(?:At|From|Till)$/i)
  1216. {
  1217. if ($attrvalue =~ /^Start$/i)
  1218. { $attrvalue = @Period {"from"} ; }
  1219. if ($attrvalue =~ /^End$/i)
  1220. { $attrvalue = @Period {"till"} ; }
  1221. if (! &ValidDateFormat ($attrvalue))
  1222. {
  1223. &Error ("PlotData attribute '$attribute' invalid.\n" .
  1224. "Date '$attrvalue' does not conform to specified DateFormat $DateFormat.") ;
  1225. &GetData ; next PlotData ; }
  1226. if (! &ValidDateRange ($attrvalue))
  1227. { &Error ("Plotdata attribute '$attribute' invalid.\n" .
  1228. "Date '$attrvalue' not within range as specified by command Period.") ;
  1229. &GetData ; next PlotData ; }
  1230. if ($attribute =~ /^At$/i)
  1231. { $at = $attrvalue ; }
  1232. elsif ($attribute =~ /^From$/i)
  1233. { $from = $attrvalue ; }
  1234. else
  1235. { $till = $attrvalue ; }
  1236. }
  1237. # elsif ($attribute =~ /^From$/i)
  1238. # {
  1239. # if ($attrvalue =~ /^Start$/i)
  1240. # { $attrvalue = @Period {"from"} ; }
  1241. # if (! &ValidDateFormat ($attrvalue))
  1242. # { &Error ("PlotData invalid.\nDate '$attrvalue' does not conform to specified DateFormat $DateFormat.") ;
  1243. # &GetData ; next PlotData ; }
  1244. # if (! &ValidDateRange ($attrvalue))
  1245. # { &Error ("Plotdata attribute 'from' invalid.\n" .
  1246. # "Date '$attrvalue' not within range as specified by command Period.") ;
  1247. # &GetData ; next PlotData ; }
  1248. # $from = $attrvalue ;
  1249. # }
  1250. # elsif ($attribute =~ /^Till$/i)
  1251. # {
  1252. # if ($attrvalue =~ /^End$/i)
  1253. # { $attrvalue = @Period {"till"} ; }
  1254. # if (! &ValidDateFormat ($attrvalue))
  1255. # { &Error ("PlotData invalid. Date '$attrvalue' does not conform to specified DateFormat $DateFormat.") ;
  1256. # &GetData ; next PlotData ; }
  1257. # if (! &ValidDateRange ($attrvalue))
  1258. # { &Error ("Plotdata attribute 'till' invalid.\n" .
  1259. # "Date '$attrvalue' not within range as specified by command Period.") ;
  1260. # &GetData ; next PlotData ; }
  1261. # $till = $attrvalue ;
  1262. # }
  1263. elsif ($attribute =~ /^Color$/i)
  1264. {
  1265. if (! &ColorPredefined ($attrvalue))
  1266. {
  1267. if (! defined (@Colors {lc ($attrvalue)}))
  1268. { &Error ("PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" .
  1269. " Specify command 'Color' before this command.") ;
  1270. &GetData ; next PlotData ; }
  1271. }
  1272. if (defined (@Colors {lc ($attrvalue)}))
  1273. { $color = @Colors { lc ($attrvalue) } ; }
  1274. else
  1275. { $color = lc ($attrvalue) ; }
  1276. $color = $attrvalue ;
  1277. }
  1278. elsif ($attribute =~ /^BgColor$/i)
  1279. {
  1280. if (! &ColorPredefined ($attrvalue))
  1281. {
  1282. if (! defined (@Colors {lc ($attrvalue)}))
  1283. { &Error ("PlotData invalid. Attribute '$attribute' has unknown color '$attrvalue'.\n" .
  1284. " Specify command 'Color' before this command.") ;
  1285. &GetData ; next PlotData ; }
  1286. }
  1287. if (defined (@Colors {lc ($attrvalue)}))
  1288. { $bgcolor = @Colors { lc ($attrvalue) } ; }
  1289. else
  1290. { $bgcolor = lc ($attrvalue) ; }
  1291. }
  1292. elsif ($attribute =~ /^TextColor$/i)
  1293. {
  1294. if (! &ColorPredefined ($attrvalue))
  1295. {
  1296. if (! defined (@Colors {lc ($attrvalue)}))
  1297. { &Error ("PlotData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" .
  1298. " Specify command 'Color' before this command.") ;
  1299. &GetData ; next PlotData ; }
  1300. }
  1301. if (defined (@Colors {lc ($attrvalue)}))
  1302. { $textcolor = @Colors { lc ($attrvalue) } ; }
  1303. else
  1304. { $textcolor = lc ($attrvalue) ; }
  1305. }
  1306. elsif ($attribute =~ /^Width$/i)
  1307. {
  1308. $width = &Normalize ($attrvalue) ;
  1309. if ($width > $MaxBarWidth)
  1310. { $MaxBarWidth = $width ; }
  1311. }
  1312. elsif ($attribute =~ /^FontSize$/i)
  1313. {
  1314. if (($attrvalue !~ /\d+(?:\.\d)?/) && ($attrvalue !~ /xs|s|m|l|xl/i))
  1315. { &Error ("PlotData invalid. Specify for attribute '$attribute' a number of XS,S,M,L,XL.") ;
  1316. &GetData ; next PlotData ; }
  1317. $fontsize = $attrvalue ;
  1318. if ($fontsize =~ /(?:XS|S|M|L|XL)/i)
  1319. {
  1320. if ($fontsize !~ /(?:xs|s|m|l|xl)/i)
  1321. {
  1322. if ($fontsize < 6)
  1323. { &Warning ("TextData attribute 'fontsize' value too low. Font size 6 assumed.\n") ;
  1324. $fontsize = 6 ; }
  1325. if ($fontsize > 30)
  1326. { &Warning ("TextData attribute 'fontsize' value too high. Font size 30 assumed.\n") ;
  1327. $fontsize = 30 ; }
  1328. }
  1329. }
  1330. }
  1331. elsif ($attribute =~ /^Anchor$/i)
  1332. {
  1333. if (! ($attrvalue =~ /^(?:from|till|middle)$/i))
  1334. { &Error ("PlotData value '$attribute' invalid. Specify 'from', 'till' or 'middle'.") ;
  1335. &GetData ; next PlotData ; }
  1336. $anchor = lc ($attrvalue) ;
  1337. }
  1338. elsif ($attribute =~ /^Align$/i)
  1339. {
  1340. if (! ($attrvalue =~ /^(?:left|right|center)$/i))
  1341. { &Error ("PlotData value '$attribute' invalid. Specify 'left', 'right' or 'center'.") ;
  1342. &GetData ; next PlotData ; }
  1343. $align = lc ($attrvalue) ;
  1344. }
  1345. elsif ($attribute =~ /^Shift$/i)
  1346. {
  1347. $shift = $attrvalue ;
  1348. $shift =~ s/$hBrO(.*?)$hBrC/$1/ ;
  1349. $shift =~ s/\s//g ;
  1350. ($shiftx2,$shifty2) = split (",", $shift) ;
  1351. if ($shiftx2 ne "")
  1352. { $shiftx = &Normalize ($shiftx2) ; }
  1353. if ($shifty2 ne "")
  1354. { $shifty = &Normalize ($shifty2) ; }
  1355. if (($shiftx < -10) || ($shiftx > 10) || ($shifty < -10) || ($shifty > 10))
  1356. { &Error ("PlotData invalid. Attribute '$shift', specify value(s) between -1000 and 1000 pixels = -10 and 10 inch.") ;
  1357. &GetData ; next PlotData ; }
  1358. }
  1359. elsif ($attribute =~ /^Text$/i)
  1360. {
  1361. $text = &ParseText ($attrvalue) ;
  1362. $text =~ s/\\n/\n/g ;
  1363. if ($text =~ /\^/)
  1364. { &Warning ("TextData attribute 'text' contains ^ (caret).\n" .
  1365. "Caret symbol will not be translated into tab character (use TextData when tabs are needed)") ; }
  1366. # $text=~ s/(\[\[ [^\]]* \n [^\]]* \]\])/&NormalizeWikiLink($1)/gxe ;
  1367. $text=~ s/(\[\[? [^\]]* \n [^\]]* \]?\])/&NormalizeWikiLink($1)/gxe ;
  1368. }
  1369. elsif ($attribute =~ /^Link$/i)
  1370. {
  1371. $link = &ParseText ($attrvalue) ;
  1372. $link = &EncodeURL (&NormalizeURL ($link)) ;
  1373. }
  1374. # elsif ($attribute =~ /^Hint$/i)
  1375. # {
  1376. # $hint = &ParseText ($attrvalue) ;
  1377. # $hint =~ s/\\n/\n/g ;
  1378. # }
  1379. elsif ($attribute =~ /^Mark$/i)
  1380. {
  1381. $attrvalue =~ s/$hBrO (.*) $hBrC/$1/x ;
  1382. (@suboptions) = split (",", $attrvalue) ;
  1383. $mark = @suboptions [0] ;
  1384. if (! ($mark =~ /^(?:Line|None)$/i))
  1385. { &Error ("PlotData invalid. Value '$mark' for attribute 'mark' unknown.") ;
  1386. &GetData ; next PlotData ; }
  1387. if (defined (@suboptions [1]))
  1388. {
  1389. $markcolor = @suboptions [1] ;
  1390. if (! &ColorPredefined ($markcolor))
  1391. {
  1392. if (! defined (@Colors {lc ($markcolor)}))
  1393. { &Error ("PlotData invalid. Attribute 'mark': unknown color '$markcolor'.\n" .
  1394. " Specify command 'Color' before this command.") ;
  1395. &GetData ; next PlotData ; }
  1396. }
  1397. $markcolor = lc ($markcolor) ;
  1398. }
  1399. else
  1400. { $markcolor = "black" ; }
  1401. }
  1402. else
  1403. { &Error ("PlotData invalid. Unknown attribute '$attribute' found.") ;
  1404. &GetData ; next PlotData ; }
  1405. }
  1406. # if ($text =~ /\[\[.*\[\[/s)
  1407. # { &Error ("PlotData invalid. Text segment '$text' contains more than one wiki link. Only one allowed.") ;
  1408. # &GetData ; next PlotData ; }
  1409. # if (($text ne "") || ($link ne ""))
  1410. # { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; }
  1411. $shift = $shiftx . "," . $shifty ;
  1412. if ($MaxBarWidth eq "")
  1413. { $MaxBarWidth = $width - 0.001 ; }
  1414. if ($bar ne "")
  1415. {
  1416. if (! defined (@BarLegend {lc($bar)}))
  1417. { @BarLegend {lc($bar)} = $bar ; }
  1418. if (! defined (@BarWidths {$bar}))
  1419. { @BarWidths {$bar} = $width ; } # was 0 ??
  1420. }
  1421. if (($at eq "") && ($from eq "") && ($till eq "")) # upd defaults
  1422. {
  1423. if ($bar ne "") { @PlotDefs {"bar"} = $bar ; }
  1424. # if ($barset ne "") { @PlotDefs {"barset"} = $barset ; }
  1425. if ($color ne "") { @PlotDefs {"color"} = $color ; }
  1426. if ($bgcolor ne "") { @PlotDefs {"bgcolor"} = $bgcolor ; }
  1427. if ($textcolor ne "") { @PlotDefs {"textcolor"} = $textcolor ; }
  1428. if ($fontsize ne "") { @PlotDefs {"fontsize"} = $fontsize ; }
  1429. if ($width ne "") { @PlotDefs {"width"} = $width ; }
  1430. if ($anchor ne "") { @PlotDefs {"anchor"} = $anchor ; }
  1431. if ($align ne "") { @PlotDefs {"align"} = $align ; }
  1432. if ($shiftx ne "") { @PlotDefs {"shiftx"} = $shiftx ; }
  1433. if ($shifty ne "") { @PlotDefs {"shifty"} = $shifty ; }
  1434. if ($mark ne "") { @PlotDefs {"mark"} = $mark ; }
  1435. if ($markcolor ne "") { @PlotDefs {"markcolor"} = $markcolor ; }
  1436. # if ($link ne "") { @PlotDefs {"link"} = $link ; }
  1437. # if ($hint ne "") { @PlotDefs {"hint"} = $hint ; }
  1438. &GetData ; next PlotData ;
  1439. }
  1440. if ($bar eq "")
  1441. {
  1442. if ($prevbar ne "")
  1443. { $bar = $prevbar ; }
  1444. else
  1445. {
  1446. # if ($BarsCommandFound)
  1447. # {
  1448. if ($#Bars > 0)
  1449. { &Error ("PlotData invalid. Specify attribute 'bar'.") ;
  1450. &GetData ; next PlotData ; }
  1451. elsif ($#Bars == 0)
  1452. {
  1453. $bar = @Bars [0] ;
  1454. &Info ($data, "PlotData incomplete. Attribute 'bar' missing, value '" . @Bars [0] . "' assumed.") ;
  1455. }
  1456. else
  1457. { $bar = "1" ; }
  1458. # }
  1459. # else
  1460. # {
  1461. # if ($#Bars > 0)
  1462. # { &Error ("PlotData invalid. Attribute 'bar' missing.") ;
  1463. # &GetData ; next PlotData ; }
  1464. # elsif ($#Bars == 0)
  1465. # {
  1466. # $bar = @Bars [0] ;
  1467. # &Info ($data, "PlotData incomplete. Attribute 'bar' missing, value '" . @Bars [0] . "' assumed.") ;
  1468. # }
  1469. # else { $bar = "1" ; }
  1470. # }
  1471. $prevbar = $bar ;
  1472. }
  1473. }
  1474. if (&BarDefined ($bar . "#1")) # bar is actually a bar set
  1475. {
  1476. if (($from ne "") || ($at ne "") || ($text eq " ")) # data line ?
  1477. {
  1478. $barndx++ ;
  1479. if (! &BarDefined ($bar . "#" . $barndx))
  1480. { $barndx = 1 ; }
  1481. $bar = $bar . "#" . $barndx ;
  1482. # $text = $bar ;
  1483. }
  1484. }
  1485. if (($at ne "") && (($from ne "") || ($till ne "")))
  1486. { &Error ("PlotData invalid. Attributes 'at' and 'from/till' are mutually exclusive.") ;
  1487. &GetData ; next PlotData ; }
  1488. if ((($from eq "") && ($till ne "")) || (($from ne "") && ($till eq "")))
  1489. { &Error ("PlotData invalid. Specify attribute 'at' or 'from' + 'till'.") ;
  1490. &GetData ; next PlotData ; }
  1491. if ($at ne "")
  1492. {
  1493. if ($text ne "")
  1494. {
  1495. if ($align eq "")
  1496. { &Error ("PlotData invalid. Attribute 'align' missing.") ;
  1497. &GetData ; next PlotData ; }
  1498. if ($fontsize eq "")
  1499. { &Error ("PlotData invalid. Attribute '[font]size' missing.") ;
  1500. &GetData ; next PlotData ; }
  1501. if ($text eq "")
  1502. { &Error ("PlotData invalid. Attribute 'text' missing.") ;
  1503. &GetData ; next PlotData ; }
  1504. }
  1505. }
  1506. else
  1507. {
  1508. if (($text ne "") && ($anchor eq ""))
  1509. { &Error ("PlotData invalid. Attribute 'anchor' missing.") ;
  1510. &GetData ; next PlotData ; }
  1511. if ($color eq "")
  1512. { &Error ("PlotData invalid. Attribute 'color' missing.") ;
  1513. &GetData ; next PlotData ; }
  1514. if ($width eq "")
  1515. { &Error ("PlotData invalid. Attribute 'width' missing.") ;
  1516. &GetData ; next PlotData ; }
  1517. }
  1518. if ($from ne "")
  1519. {
  1520. if (($link ne "") && ($hint eq ""))
  1521. { $hint = &ExternalLinkToHint ($link) ; }
  1522. if (($link ne "") || ($hint ne ""))
  1523. { $MapPNG = $true ; }
  1524. if ($link ne "")
  1525. { $MapSVG = $true ; }
  1526. push @PlotBars, sprintf ("%6.3f,%s,%s,%s,%s,%s,%s,\n", $width, $bar, $from, $till, lc ($color),$link,$hint) ;
  1527. if ($width > @BarWidths {$bar})
  1528. { @BarWidths {$bar} = $width ; }
  1529. if ($text ne "")
  1530. {
  1531. if ($anchor eq "from")
  1532. { $at = $from ; }
  1533. elsif ($anchor eq "till")
  1534. { $at = $till ; }
  1535. else
  1536. { $at = &DateMedium ($from, $till) ; }
  1537. }
  1538. if (($mark ne "") && ($mark !~ /none/i))
  1539. {
  1540. push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $from, $from, lc ($markcolor)) ;
  1541. push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $till, $till, lc ($markcolor)) ;
  1542. $mark = "" ;
  1543. }
  1544. }
  1545. if ($at ne "")
  1546. {
  1547. if (($mark ne "") && ($mark !~ /none/i))
  1548. { push @PlotLines, sprintf ("%s,%s,%s,%s,,,\n", $bar, $at, $at, lc ($markcolor)) ; }
  1549. if ($text ne "")
  1550. {
  1551. my $textdetails = "" ;
  1552. if ($link ne "")
  1553. {
  1554. if ($text =~ /\[.*\]/)
  1555. {
  1556. &Warning ("PlotData contains implicit link(s) in attribute 'text' and explicit attribute 'link'. " .
  1557. "Implicit link(s) ignored.") ;
  1558. $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ;
  1559. }
  1560. if ($hint eq "")
  1561. { $hint = &ExternalLinkToHint ($link) ; }
  1562. }
  1563. if ($anchor eq "")
  1564. { $anchor = "middle" ; }
  1565. if ($align eq "")
  1566. { $align = "center" ; }
  1567. if ($color eq "")
  1568. { $color = "black" ; }
  1569. if ($fontsize eq "")
  1570. { $fontsize = "S" ; }
  1571. if ($adjust eq "")
  1572. { $adjust = "0,0" ; }
  1573. # $textdetails = " textdetails: align=$align size=$size" ;
  1574. # if ($textcolor eq "")
  1575. # { $textcolor = "black" ; }
  1576. # if ($color ne "")
  1577. # { $textdetails .= " color=$textcolor" ; }
  1578. # my ($xpos, $ypos) ;
  1579. # my $barcnt = 0 ;
  1580. # for ($b = 0 ; $b <= $#Bars ; $b++)
  1581. # {
  1582. # if (lc(@Bars [$b]) eq lc($bar))
  1583. # { $barcnt = ($b + 1) ; last ; }
  1584. # }
  1585. # if (@Axis {"time"} eq "x")
  1586. # { $xpos = "$at(s)" ; $ypos = "[$barcnt](s)" ; }
  1587. # else
  1588. # { $ypos = "$at(s)" ; $xpos = "[$barcnt](s)" ; }
  1589. # if ($shift ne "")
  1590. # {
  1591. # my ($shiftx, $shifty) = split (",", $shift) ;
  1592. # if ($shiftx > 0)
  1593. # { $xpos .= "+$shiftx" ; }
  1594. # if ($shiftx < 0)
  1595. # { $xpos .= "$shiftx" ; }
  1596. # if ($shifty > 0)
  1597. # { $ypos .= "+$shifty" ; }
  1598. # if ($shifty < 0)
  1599. # { $ypos .= "$shifty" ; }
  1600. # }
  1601. $text =~ s/\,/\#\%\$/g ;
  1602. $link =~ s/\,/\#\%\$/g ;
  1603. $hint =~ s/\,/\#\%\$/g ;
  1604. $shift =~ s/\,/\#\%\$/g ;
  1605. $textcolor =~ s/\,/\#\%\$/g ;
  1606. push @PlotText, sprintf ("%s,%s,%s,%s,%s,%s,%s,%s,%s", $at, $bar, $text, $textcolor, $fontsize, $align, $shift, $link, $hint) ;
  1607. }
  1608. }
  1609. &GetData ;
  1610. }
  1611. if ((! $BarsCommandFound) && ($#Bars > 1))
  1612. { &Info2 ("PlotBars definition: no (valid) command 'BarData' found in previous lines.\nBars will presented in order of appearance in PlotData.") ; }
  1613. $maxwidth = 0 ;
  1614. foreach $key (keys %BarWidths)
  1615. {
  1616. if (@BarWidths {$key} == 0)
  1617. { &Warning ("PlotData incomplete. No bar width defined for bar '$key', assume width from widest bar (used for line marks).") ; }
  1618. elsif (@BarWidths {$key} > $maxwidth)
  1619. { $maxwidth = @BarWidths {$key} ; }
  1620. }
  1621. foreach $key (keys %BarWidths)
  1622. {
  1623. if (@BarWidths {$key} == 0)
  1624. { @BarWidths {$key} = $maxwidth ; }
  1625. }
  1626. }
  1627. sub ParsePreset
  1628. {
  1629. if (! $firstcmd)
  1630. { &Error ("Specify 'Preset' command before any other commands, if desired at all.\n") ; return ; }
  1631. $preset = @Attributes {"single"} ;
  1632. if ($preset !~ /^(?:TimeVertical_OneBar_UnitYear|TimeHorizontal_AutoPlaceBars_UnitYear)$/i)
  1633. { &Error ("Preset value invalid.\n" .
  1634. " At the moment two presets are available:\n" .
  1635. " TimeVertical_OneBar_UnitYear and TimeHorizontal_AutoPlaceBars_UnitYear\n" .
  1636. " See also meta.wikipedia.org/wiki/EasyTimeline/Presets") ; return ; }
  1637. $Preset = $preset ;
  1638. if ($Preset =~ /^TimeVertical_OneBar_UnitYear/i)
  1639. {
  1640. $DateFormat = "yyyy" ;
  1641. $AlignBars = "early" ;
  1642. @Axis {"format"} = "yyyy" ;
  1643. @Axis {"time"} = "y" ;
  1644. @PlotArea {"left"} = 45 ;
  1645. @PlotArea {"right"} = 10 ;
  1646. @PlotArea {"top"} = 10 ;
  1647. @PlotArea {"bottom"} = 10 ;
  1648. push @PresetList, "PlotArea|+|left|" . @PlotArea {"left"} ;
  1649. push @PresetList, "PlotArea|+|right|" . @PlotArea {"right"};
  1650. push @PresetList, "PlotArea|+|top|" . @PlotArea {"top"} ;
  1651. push @PresetList, "PlotArea|+|bottom|" . @PlotArea {"bottom"} ;
  1652. push @PresetList, "PlotArea|-|width" ;
  1653. push @PresetList, "PlotArea|-|height" ;
  1654. push @PresetList, "Dateformat|-||yyyy" ;
  1655. push @PresetList, "TimeAxis|=|format|" . @Axis {"format"} ;
  1656. push @PresetList, "TimeAxis|=|orientation|vertical" ;
  1657. push @PresetList, "ScaleMajor|=|unit|year" ;
  1658. push @PresetList, "ScaleMinor|=|unit|year" ;
  1659. push @PresetList, "AlignBars|=||early" ;
  1660. push @PresetList, "PlotData|+|mark|" . $hBrO . "line,white" . $hBrC ;
  1661. push @PresetList, "PlotData|+|align|left" ;
  1662. push @PresetList, "PlotData|+|fontsize|S" ;
  1663. push @PresetList, "PlotData|+|width|20" ;
  1664. push @PresetList, "PlotData|+|shift|" . $hBrO . "20,0" . $hBrC ;
  1665. }
  1666. elsif ($Preset =~ /TimeHorizontal_AutoPlaceBars_UnitYear/i)
  1667. {
  1668. $DateFormat = "yyyy" ;
  1669. $AlignBars = "justify" ;
  1670. @Axis {"format"} = "yyyy" ;
  1671. @Axis {"time"} = "x" ;
  1672. @PlotArea {"left"} = 25 ;
  1673. @PlotArea {"right"} = 25 ;
  1674. @PlotArea {"top"} = 15 ;
  1675. @PlotArea {"bottom"} = 30 ;
  1676. @Image {"height"} = "auto" ;
  1677. @Image {"barinc"} = 20 ;
  1678. @BackgroundColors {"canvas"} = "gray(0.7)" ;
  1679. @Legend {"orientation"} = "ver" ;
  1680. @Legend {"left"} = @PlotArea {"left"}+10 ;
  1681. @Legend {"top"} = @PlotArea {"bottom"}+100 ;
  1682. &StoreColor ("canvas", &EncodeInput ("gray(0.7)"), "") ;
  1683. &StoreColor ("grid1", &EncodeInput ("gray(0.4)"), "") ;
  1684. &StoreColor ("grid2", &EncodeInput ("gray(0.2)"), "") ;
  1685. push @PresetList, "ImageSize|=|height|auto" ;
  1686. push @PresetList, "ImageSize|+|barincrement|20" ;
  1687. push @PresetList, "PlotArea|+|left|" . @PlotArea {"left"} ;
  1688. push @PresetList, "PlotArea|+|right|" . @PlotArea {"right"};
  1689. push @PresetList, "PlotArea|+|top|" . @PlotArea {"top"} ;
  1690. push @PresetList, "PlotArea|+|bottom|" . @PlotArea {"bottom"} ;
  1691. push @PresetList, "PlotArea|-|width" ;
  1692. push @PresetList, "PlotArea|-|height" ;
  1693. push @PresetList, "Dateformat|-||yyyy" ;
  1694. push @PresetList, "TimeAxis|=|format|" . @Axis {"format"} ;
  1695. push @PresetList, "TimeAxis|=|orientation|horizontal" ;
  1696. push @PresetList, "ScaleMajor|=|unit|year" ;
  1697. push @PresetList, "ScaleMajor|+|grid|grid1" ;
  1698. push @PresetList, "ScaleMinor|=|unit|year" ;
  1699. push @PresetList, "AlignBars|=||justify" ;
  1700. push @PresetList, "Legend|+|orientation|" . @Legend {"orientation"} ;
  1701. push @PresetList, "Legend|+|left|" . @Legend {"left"} ;
  1702. push @PresetList, "Legend|+|top|" . @Legend {"top"} ;
  1703. push @PresetList, "PlotData|+|align|left" ;
  1704. push @PresetList, "PlotData|+|anchor|from" ;
  1705. push @PresetList, "PlotData|+|fontsize|M" ;
  1706. push @PresetList, "PlotData|+|width|15" ;
  1707. push @PresetList, "PlotData|+|textcolor|black" ;
  1708. push @PresetList, "PlotData|+|shift|" . $hBrO . "4,-6" . $hBrC ;
  1709. }
  1710. }
  1711. sub ParseScale
  1712. {
  1713. my ($scale) ;
  1714. if ($Command =~ /ScaleMajor/i)
  1715. { $scale .= 'Major' ; }
  1716. else
  1717. { $scale .= 'Minor' ; }
  1718. if (! ValidAttributes ("Scale" . $scale)) { return ; }
  1719. &CheckPreset (Scale . $scale) ;
  1720. @Scales {$scale} = $true ;
  1721. foreach $attribute (keys %Attributes)
  1722. {
  1723. my $attrvalue = @Attributes {$attribute} ;
  1724. if ($attribute =~ /Grid/i) # preferred gridcolor instead of grid, grid allowed for compatability
  1725. {
  1726. if ((! &ColorPredefined ($attrvalue)) && (! defined (@Colors {lc ($attrvalue)})))
  1727. { &Error ("Scale attribute '$attribute' invalid. Unknown color '$attrvalue'.\n" .
  1728. " Specify command 'Color' before this command.") ; return ; }
  1729. @Attributes {$scale . " grid"} = $attrvalue ;
  1730. delete (@Attributes {"grid"}) ;
  1731. }
  1732. elsif ($attribute =~ /Text/i)
  1733. {
  1734. $attrvalue =~ s/\~/\\n/g ;
  1735. $attrvalue =~ s/^\"//g ;
  1736. $attrvalue =~ s/\"$//g ;
  1737. @Attributes {$scale . " stubs"} = $attrvalue ;
  1738. }
  1739. elsif ($attribute =~ /Unit/i)
  1740. {
  1741. if ($DateFormat eq "yyyy")
  1742. {
  1743. if (! ($attrvalue =~ /^(?:year|years)$/i))
  1744. { &Error ("Scale attribute '$attribute' invalid. DateFormat 'yyyy' implies 'unit:year'.") ; return ; }
  1745. }
  1746. else
  1747. {
  1748. if (! ($attrvalue =~ /^(?:year|month|day)s?$/i))
  1749. { &Error ("Scale attribute '$attribute' invalid. Specify year, month or day.") ; return ; }
  1750. }
  1751. $attrvalue =~ s/s$// ;
  1752. @Attributes {$scale . " unit"} = $attrvalue ;
  1753. delete (@Attributes {"unit"}) ;
  1754. }
  1755. elsif ($attribute =~ /Increment/i)
  1756. {
  1757. if ((! ($attrvalue =~ /^\d+$/i)) || ($attrvalue == 0))
  1758. { &Error ("Scale attribute '$attribute' invalid. Specify positive integer.") ; return ; }
  1759. @Attributes {$scale . " inc"} = $attrvalue ;
  1760. delete (@Attributes {"increment"}) ;
  1761. }
  1762. elsif ($attribute =~ /Start/i)
  1763. {
  1764. if (! (defined ($DateFormat)))
  1765. { &Error ("Scale attribute '$attribute' invalid.\n" .
  1766. "No (valid) command 'DateFormat' specified in previous lines.") ; return ; }
  1767. if (($DateFormat eq "dd/mm/yyyy") || ($DateFormat eq "mm/dd/yyyy"))
  1768. {
  1769. if (($attrvalue =~ /^\d+$/) && ($attrvalue >= 1800) && ($attrvalue <= 2030))
  1770. { $attrvalue = "01/01/" . $attrvalue ; }
  1771. }
  1772. if (! &ValidDateFormat ($attrvalue))
  1773. { &Error ("Scale attribute '$attribute' invalid.\n" .
  1774. "Date does not conform to specified DateFormat '$DateFormat'.") ; return ; }
  1775. if (($DateFormat =~ /\d\d\/\d\d\/\d\d\d\d/) && (substr ($attrvalue,6,4) < 1800))
  1776. { &Error ("Scale attribute '$attribute' invalid.\n" .
  1777. " Specify year >= 1800.") ; return ; }
  1778. if (! &ValidDateRange ($attrvalue))
  1779. { &Error ("Scale attribute '$attribute' invalid.\n" .
  1780. "Date '$attrvalue' not within range as specified by command Period.") ; return ; }
  1781. @Attributes {$scale . " start"} = $attrvalue ;
  1782. delete (@Attributes {"start"}) ;
  1783. }
  1784. if ($DateFormat eq "yyyy") { @Attributes {$scale . " unit"} = "year" ; }
  1785. }
  1786. foreach $attribute (keys %Attributes)
  1787. { @Scales {$attribute} = @Attributes {$attribute} ; }
  1788. }
  1789. sub ParseTextData
  1790. {
  1791. &GetData ;
  1792. if ($NoData)
  1793. { &Error ("Data expected for command 'TextData', but line is not indented.\n") ; return ; }
  1794. my ($pos, $tabs, $fontsize, $lineheight, $textcolor, $text, $link, $hint) ;
  1795. TextData:
  1796. while ((! $InputParsed) && (! $NoData))
  1797. {
  1798. if (! &ValidAttributes ("TextData"))
  1799. { &GetData ; next ;}
  1800. &CheckPreset ("TextData") ;
  1801. $pos = "" ; $tabs = "" ; $fontsize = "" ; $lineheight = "" ; $textcolor = "" ; $link = "" ; $hint = "" ;
  1802. if (defined (@TextDefs {"tabs"})) { $tabs = @TextDefs {"tabs"} ; }
  1803. if (defined (@TextDefs {"fontsize"})) { $fontsize = @TextDefs {"fontsize"} ; }
  1804. if (defined (@TextDefs {"lineheight"})) { $lineheight = @TextDefs {"lineheight"} ; }
  1805. if (defined (@TextDefs {"textcolor"})) { $textcolor = @TextDefs {"textcolor"} ; }
  1806. my $data2 = $data ;
  1807. ($data2, $text) = &ExtractText ($data2) ;
  1808. @Attributes = split (" ", $data2) ;
  1809. foreach $attribute (keys %Attributes)
  1810. {
  1811. my $attrvalue = @Attributes {$attribute} ;
  1812. if ($attribute =~ /^FontSize$/i)
  1813. {
  1814. if (($attrvalue !~ /\d+(?:\.\d)?/) && ($attrvalue !~ /^(?:xs|s|m|l|xl)$/i))
  1815. { &Error ("TextData invalid. Attribute '$attribute': specify number of XS,S,M,L,XL.") ;
  1816. &GetData ; next TextData ; }
  1817. $fontsize = $attrvalue ;
  1818. if ($fontsize !~ /^(?:xs|s|m|l|xl)$/i)
  1819. {
  1820. if ($fontsize < 6)
  1821. { &Warning ("TextData attribute 'fontsize' value too low. Font size 6 assumed.\n") ;
  1822. $fontsize = 6 ; }
  1823. if ($fontsize > 30)
  1824. { &Warning ("TextData attribute 'fontsize' value too high. Font size 30 assumed.\n") ;
  1825. $fontsize = 30 ; }
  1826. }
  1827. }
  1828. elsif ($attribute =~ /^LineHeight$/i)
  1829. {
  1830. $lineheight = &Normalize ($attrvalue) ;
  1831. if (($lineheight < -0.4) || ($lineheight > 0.4))
  1832. {
  1833. if (! $bypass)
  1834. { &Error ("TextData attribute 'lineheight' invalid.\n" .
  1835. "Specify value up to 40 pixels = 0.4 inch\n" .
  1836. "Run with option -b (bypass checks) when this is correct.\n") ; }
  1837. }
  1838. }
  1839. elsif ($attribute =~ /^Pos$/i)
  1840. {
  1841. $attrvalue =~ s/\s*$hBrO (.*) $hBrC\s*/$1/x ;
  1842. ($posx,$posy) = split (",", $attrvalue) ;
  1843. $posx = &Normalize ($posx) ;
  1844. $posy = &Normalize ($posy) ;
  1845. $pos = "$posx,$posy" ;
  1846. }
  1847. elsif ($attribute =~ /^Tabs$/i)
  1848. {
  1849. $tabs = $attrvalue ;
  1850. }
  1851. elsif ($attribute =~ /^(?:Color|TextColor)$/i)
  1852. {
  1853. if (! &ColorPredefined ($attrvalue))
  1854. {
  1855. if (! defined (@Colors {lc ($attrvalue)}))
  1856. { &Error ("TextData invalid. Attribute '$attribute' contains unknown color '$attrvalue'.\n" .
  1857. " Specify command 'Color' before this command.") ;
  1858. &GetData ; next TextData ; }
  1859. }
  1860. if (defined (@Colors {lc ($attrvalue)}))
  1861. { $textcolor = @Colors { lc ($attrvalue) } ; }
  1862. else
  1863. { $textcolor = lc ($attrvalue) ; }
  1864. }
  1865. elsif ($attribute =~ /^Text$/i)
  1866. {
  1867. $text = $attrvalue ;
  1868. $text =~ s/\\n/~/gs ;
  1869. if ($text =~ /\~/)
  1870. { &Warning ("TextData attribute 'text' contains ~ (tilde).\n" .
  1871. "Tilde will not be translated into newline character (only in PlotData)") ; }
  1872. }
  1873. elsif ($attribute =~ /^Link$/i)
  1874. {
  1875. $link = &ParseText ($attrvalue) ;
  1876. $link = &EncodeURL (&NormalizeURL ($link)) ;
  1877. }
  1878. }
  1879. if ($fontsize eq "")
  1880. { $fontsize = "S" ; }
  1881. if ($lineheight eq "")
  1882. {
  1883. if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i)
  1884. {
  1885. if ($fontsize =~ /XS/i) { $lineheight = 0.11 ; }
  1886. elsif ($fontsize =~ /S/i) { $lineheight = 0.13 ; }
  1887. elsif ($fontsize =~ /M/i) { $lineheight = 0.155 ; }
  1888. elsif ($fontsize =~ /XL/i) { $lineheight = 0.24 ; }
  1889. else { $lineheight = 0.19 ; }
  1890. }
  1891. else
  1892. {
  1893. $lineheight = sprintf ("%.2f", (($fontsize * 1.2) / 100)) ;
  1894. if ($lineheight < $fontsize/100 + 0.02)
  1895. { $lineheight = $fontsize/100 + 0.02 ; }
  1896. }
  1897. }
  1898. if ($textcolor eq "")
  1899. { $textcolor = "black" ; }
  1900. if ($pos eq "")
  1901. {
  1902. $pos = @TextDefs {"pos"} ;
  1903. ($posx,$posy) = split (",", $pos) ;
  1904. $posy -= $lineheight ;
  1905. if ($posy < 0)
  1906. { $posy = 0 ; }
  1907. $pos = "$posx,$posy" ;
  1908. @TextDefs {"pos"} = $pos ;
  1909. }
  1910. # if ($link ne "")
  1911. # { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; }
  1912. if ($text eq "") # upd defaults
  1913. {
  1914. if ($pos ne "") { @TextDefs {"pos"} = $pos ; }
  1915. if ($tabs ne "") { @TextDefs {"tabs"} = $tabs ; }
  1916. if ($fontsize ne "") { @TextDefs {"fontsize"} = $fontsize ; }
  1917. if ($textcolor ne "") { @TextDefs {"textcolor"} = $textcolor ; }
  1918. if ($lineheight ne "") { @TextDefs {"lineheight"} = $lineheight ; }
  1919. &GetData ; next TextData ;
  1920. }
  1921. if ($link ne "")
  1922. {
  1923. if ($text =~ /\[.*\]/)
  1924. {
  1925. &Warning ("TextData contains implicit link(s) in attribute 'text' and explicit attribute 'link'.\n" .
  1926. "Implicit link(s) ignored.") ;
  1927. $text =~ s/\[+ (?:[^\|]* \|)? ([^\]]*) \]+/$1/gx ;
  1928. }
  1929. if ($hint eq "")
  1930. { $hint = &ExternalLinkToHint ($link) ; }
  1931. }
  1932. if ($text =~ /\[ [^\]]* \^ [^\]]* \]/x)
  1933. {
  1934. &Warning ("TextData attribute 'text' contains tab character (^) inside implicit link ([[..]]). Tab ignored.") ;
  1935. $text =~ s/(\[+ [^\]]* \^ [^\]]* \]+)/($a = $1), ($a =~ s+\^+ +g), $a/gxe ;
  1936. }
  1937. if (defined ($tabs) && ($tabs ne ""))
  1938. {
  1939. $tabs =~ s/^\s*$hBrO (.*) $hBrC\s*$/$1/x ;
  1940. @Tabs = split (",", $tabs) ;
  1941. foreach $tab (@Tabs)
  1942. {
  1943. $tab =~ s/\s* (.*) \s*$/$1/x ;
  1944. if (! ($tab =~ /\d+\-(?:center|left|right)$/))
  1945. { &Error ("Specify attribute 'tabs' as 'n-a,n-a,n-a,.. where n = numeric value, a = left|right|center.") ;
  1946. while ((! $InputParsed) && (! $NoData)) { &GetData ; } return ; }
  1947. }
  1948. @Text = split ('\^', $text) ;
  1949. if ($#Text > $#Tabs + 1)
  1950. { &Error ("TextData invalid. " . $#Text . " tab characters ('^') in text, only " . ($#Tabs+1) . " tab(s) defined.") ;
  1951. &GetData ; next TextData ; }
  1952. }
  1953. &WriteText ("^", "", 0, $posx, $posy, $text, $textcolor, $fontsize, "left", $link, $hint, $tabs) ;
  1954. &GetData ;
  1955. }
  1956. }
  1957. sub ParseTimeAxis
  1958. {
  1959. if (! &ValidAttributes ("TimeAxis")) { return ; }
  1960. &CheckPreset ("TimeAxis") ;
  1961. foreach $attribute (keys %Attributes)
  1962. {
  1963. my $attrvalue = @Attributes {$attribute} ;
  1964. if ($attribute =~ /Format/i)
  1965. {
  1966. if ($attrvalue =~ /^yy$/i)
  1967. { &Error ("TimeAxis attribute '$attribute' valid but not available, waiting for bug fix.\n" .
  1968. "Please specify 'format:yyyy' instead of 'format:yy'.") ; return ; }
  1969. if ($DateFormat eq "yyyy")
  1970. {
  1971. if (! ($attrvalue =~ /^(?:yy|yyyy)$/i))
  1972. { &Error ("TimeAxis attribute '$attribute' invalid.\n" .
  1973. "DateFormat 'yyyy' implies 'format:yy' or 'format:yyyy'.") ; return ; }
  1974. }
  1975. }
  1976. elsif ($attribute =~ /Order/i)
  1977. {
  1978. if ($attrvalue !~ /^(?:normal|reverse)$/i)
  1979. { &Error ("TimeAxis attribute '$attribute' invalid.\n" .
  1980. " Specify 'order:normal' (default) or 'order:reverse'\n" .
  1981. " normal =\n" .
  1982. " vertical axis: highest date on top,\n" .
  1983. " horizontal axis: highest date at right side\n" ) ; return ; }
  1984. if (($attrvalue =~ /reverse/i) && ($DateFormat ne "yyyy"))
  1985. { &Error ("TimeAxis attribute '$attribute' invalid.\n" .
  1986. " 'order:reverse' is only possible with DateFormat=yyyy (sorry)\n") ; return ; }
  1987. @Attributes {"order"} = lc ($attrvalue) ;
  1988. }
  1989. elsif ($attribute =~ /Orientation/i)
  1990. {
  1991. if ($attrvalue =~ /^hor(?:izontal)?$/i)
  1992. { @Attributes {"time"} = "x" ; }
  1993. elsif ($attrvalue =~ /^ver(?:tical)?$/i)
  1994. { @Attributes {"time"} = "y" ; }
  1995. else
  1996. { &Error ("TimeAxis attribute '$attribute' invalid.\n" .
  1997. "Specify hor[izontal] or ver[tical]") ; return ; }
  1998. delete (@Attributes {"orientation"}) ;
  1999. }
  2000. }
  2001. if (! defined (@Attributes {"format"}))
  2002. { @Attributes {"format"} = "yyyy" ; }
  2003. %Axis = %Attributes ;
  2004. }
  2005. sub ParseUnknownCommand
  2006. {
  2007. $name = $Command ;
  2008. $name =~ s/[^a-zA-Z].*$// ;
  2009. &Error ("Command '$name' unknown.") ;
  2010. }
  2011. sub RemoveSpaces
  2012. {
  2013. my $text = shift ;
  2014. $text =~ s/\s//g ;
  2015. return ($text) ;
  2016. }
  2017. sub DetectMissingCommands
  2018. {
  2019. if (! defined (%Image)) { &Error2 ("Command ImageSize missing or invalid") ; }
  2020. if (! defined (%PlotArea)) { &Error2 ("Command PlotArea missing or invalid") ; }
  2021. if (! defined ($DateFormat)) { &Error2 ("Command DateFormat missing or invalid") ; }
  2022. if (! defined (@Axis {"time"})) { &Error2 ("Command TimeAxis missing or invalid") ; }
  2023. if ((@Image {"width"} =~ /auto/i) && (@Axis {"time"} =~ /x/i))
  2024. { &Error2 ("ImageSize value 'width:auto' only allowed with TimeAxis value 'orientation:vertical'") ; }
  2025. if ((@Image {"height"} =~ /auto/i) && (@Axis {"time"} =~ /y/i))
  2026. { &Error2 ("ImageSize value 'height:auto' only allowed with TimeAxis value 'orientation:horizontal'") ; }
  2027. }
  2028. sub Normalize
  2029. {
  2030. my $number = shift ;
  2031. my $reference = shift ;
  2032. my ($val, $dim) ;
  2033. if (($number eq "") || ($number =~ /auto/i))
  2034. { return ($number) ; }
  2035. $val = $number ; $val =~ s/[^\d\.\-].*$//g ;
  2036. $dim = $number ; $dim =~ s/\d//g ;
  2037. if ($dim =~ /in/i) { $number = $val ; }
  2038. elsif ($dim =~ /cm/i) { $number = $val / 2.54 ; }
  2039. elsif ($dim =~ /%/) { $number = $reference * $val / 100 ; }
  2040. else { $number = $val / 100 ; }
  2041. return (sprintf ("%.3f", $number)) ;
  2042. }
  2043. sub ValidateAndNormalizeDimensions
  2044. {
  2045. my ($val, $dim) ;
  2046. if (@Image {"width"} =~ /auto/i)
  2047. {
  2048. foreach $attribute ("width","left","right")
  2049. { if (@PlotArea {$attribute} =~ /\%/)
  2050. { &Error2 ("You specified 'ImageSize = width:auto'.\n" .
  2051. " This implies absolute values in PlotArea attributes 'left', 'right' and/or 'width' (no \%).\n") ; return ; }
  2052. }
  2053. if ((@PlotArea {"width"} ne "") || (@PlotArea {"left"} eq "") || (@PlotArea {"right"} eq ""))
  2054. { &Error2 ("You specified 'ImageSize = width:auto'.\n" .
  2055. " This implies 'PlotArea = width:auto'.\n" .
  2056. " Instead of 'width' specify plot margins with PlotArea attributes 'left' and 'right'.\n") ; return ; }
  2057. }
  2058. if (@Image {"height"} =~ /auto/i)
  2059. {
  2060. foreach $attribute ("height","top","bottom")
  2061. { if (@PlotArea {$attribute} =~ /\%/)
  2062. { &Error2 ("You specified 'ImageSize = height:auto'.\n" .
  2063. " This implies absolute values in PlotArea attributes 'top', 'bottom' and/or 'height' (no \%).\n") ; return ; }
  2064. }
  2065. if ((@PlotArea {"height"} ne "") || (@PlotArea {"top"} eq "") || (@PlotArea {"bottom"} eq ""))
  2066. { &Error2 ("You specified 'ImageSize = height:auto'.\n" .
  2067. " This implies 'PlotArea = height:auto'.\n" .
  2068. " Instead of 'height' specify plot margins with PlotArea attributes 'top' and 'bottom'.\n") ; return ; }
  2069. }
  2070. @Image {"width"} = &Normalize (@Image {"width"}) ;
  2071. @Image {"height"} = &Normalize (@Image {"height"}) ;
  2072. @Image {"barinc"} = &Normalize (@Image {"barinc"}) ;
  2073. @PlotArea {"width"} = &Normalize (@PlotArea {"width"}, @Image {"width"}) ;
  2074. @PlotArea {"height"} = &Normalize (@PlotArea {"height"}, @Image {"height"}) ;
  2075. @PlotArea {"left"} = &Normalize (@PlotArea {"left"}, @Image {"width"}) ;
  2076. @PlotArea {"right"} = &Normalize (@PlotArea {"right"}, @Image {"width"}) ;
  2077. @PlotArea {"bottom"} = &Normalize (@PlotArea {"bottom"}, @Image {"height"}) ;
  2078. @PlotArea {"top"} = &Normalize (@PlotArea {"top"}, @Image {"height"}) ;
  2079. if (@Image {"width"} =~ /auto/i)
  2080. {
  2081. @PlotArea {"width"} = $#Bars * @Image {"barinc"} ;
  2082. @Image {"width"} = @PlotArea {"left"} + @PlotArea {"width"} + @PlotArea {"right"} ;
  2083. }
  2084. elsif (@Image {"height"} =~ /auto/i)
  2085. {
  2086. @PlotArea {"height"} = $#Bars * @Image {"barinc"} ;
  2087. @Image {"height"} = @PlotArea {"top"} + @PlotArea {"height"} + @PlotArea {"bottom"} ;
  2088. }
  2089. if (@PlotArea {"right"} ne "")
  2090. { @PlotArea {"width"} = @Image {"width"} - @PlotArea {"left"} - @PlotArea {"right"} ; }
  2091. if (@PlotArea {"top"} ne "")
  2092. { @PlotArea {"height"} = @Image {"height"} - @PlotArea {"top"} - @PlotArea {"bottom"} ; }
  2093. if ((@Image {"width"} > 16) || (@Image {"height"} > 20))
  2094. {
  2095. if (! $bypass)
  2096. { &Error2 ("Maximum image size is 1600x2000 pixels = 16x20 inch\n" .
  2097. " Run with option -b (bypass checks) when this is correct.\n") ; return ; }
  2098. }
  2099. if ((@Image {"width"} < 0.25) || (@Image {"height"} < 0.25))
  2100. {
  2101. &Error2 ("Minimum image size is 25x25 pixels = 0.25x0.25 inch\n") ;
  2102. return ;
  2103. }
  2104. if (@PlotArea {"width"} > @Image {"width"})
  2105. { &Error2 ("Plot width larger than image width. Please adjust.\n") ; return ; }
  2106. if (@PlotArea {"width"} < 0.2)
  2107. { &Error2 ("Plot width less than 20 pixels = 0.2 inch. Please adjust.\n") ; return ; }
  2108. if (@PlotArea {"height"} > @Image {"height"})
  2109. { &Error2 ("Plot height larger than image height. Please adjust.\n") ; return ; }
  2110. if (@PlotArea {"height"} < 0.2)
  2111. { &Error2 ("Plot height less than 20 pixels = 0.2 inch. Please adjust.\n") ; return ; }
  2112. if (@PlotArea {"left"} + @PlotArea {"width"} > @Image {"width"})
  2113. { &Error2 ("Plot width + margins larger than image width. Please adjust.\n") ; return ; }
  2114. # @PlotArea {"left"} = @Image {"width"} - @PlotArea {"width"} ; }
  2115. if (@PlotArea {"left"} < 0)
  2116. { @PlotArea {"left"} = 0 ; }
  2117. if (@PlotArea {"bottom"} + @PlotArea {"height"} > @Image {"height"})
  2118. { &Error2 ("Plot height + margins larger than image height. Please adjust.\n") ; return ; }
  2119. # @PlotArea {"bottom"} = @Image {"height"} - @PlotArea {"height"} ; }
  2120. if (@PlotArea {"bottom"} < 0)
  2121. { @PlotArea {"bottom"} = 0 ; }
  2122. if ((defined (@Scales {"Major"})) ||
  2123. (defined (@Scales {"Minor"})))
  2124. {
  2125. if (defined (@Scales {"Major"}))
  2126. { $margin = 0.2 ; }
  2127. else
  2128. { $margin = 0.05 ; }
  2129. if (@Axis {"time"} eq "x")
  2130. {
  2131. if (@PlotArea {"bottom"} < $margin)
  2132. { &Error2 ("Not enough space below plot area for plotting time axis\n" .
  2133. " Specify 'PlotArea = bottom:x', where x is at least " . (100 * $margin) . " pixels = $margin inch\n") ; return ; }
  2134. }
  2135. else
  2136. {
  2137. if (@PlotArea {"left"} < $margin)
  2138. { &Error2 ("Not enough space outside plot area for plotting time axis\n" .
  2139. " Specify 'PlotArea = left:x', where x is at least " . (100 * $margin) . " pixels = $margin inch\n") ; return ; }
  2140. }
  2141. }
  2142. if (defined (@Legend {"orientation"}))
  2143. {
  2144. if (defined (@Legend {"left"}))
  2145. { @Legend {"left"} = &Normalize (@Legend {"left"}, @Image {"width"}) ; }
  2146. if (defined (@Legend {"top"}))
  2147. { @Legend {"top"} = &Normalize (@Legend {"top"}, @Image {"height"}) ; }
  2148. if (defined (@Legend {"columnwidth"}))
  2149. { @Legend {"columnwidth"} = &Normalize (@Legend {"columnwidth"}, @Image {"width"}) ; }
  2150. if (! defined (@Legend {"columns"}))
  2151. {
  2152. @Legend {"columns"} = 1 ;
  2153. if ((@Legend {"orientation"} =~ /ver/i) &&
  2154. (@Legend {"position"} =~ /^(?:top|bottom)$/i))
  2155. {
  2156. if ($#LegendData > 10)
  2157. {
  2158. @Legend {"columns"} = 3 ;
  2159. &Info2 ("Legend attribute 'columns' not defined. 3 columns assumed.") ;
  2160. }
  2161. elsif ($#LegendData > 5)
  2162. {
  2163. @Legend {"columns"} = 2 ;
  2164. &Info2 ("Legend attribute 'columns' not defined. 2 columns assumed.") ;
  2165. }
  2166. }
  2167. }
  2168. if (@Legend {"position"} =~ /top/i)
  2169. {
  2170. if (! defined (@Legend {"left"}))
  2171. { @Legend {"left"} = @PlotArea {"left"} ; }
  2172. if (! defined (@Legend {"top"}))
  2173. { @Legend {"top"} = (@Image {"height"} - 0.2) ; }
  2174. if ((! defined (@Legend {"columnwidth"})) && (@Legend {"columns"} > 1))
  2175. { @Legend {"columnwidth"} = sprintf ("%02f", ((@PlotArea {"left"} + @PlotArea {"width"} - 0.2) / @Legend {"columns"})) ; }
  2176. }
  2177. elsif (@Legend {"position"} =~ /bottom/i)
  2178. {
  2179. if (! defined (@Legend {"left"}))
  2180. { @Legend {"left"} = @PlotArea {"left"} ; }
  2181. if (! defined (@Legend {"top"}))
  2182. { @Legend {"top"} = (@PlotArea {"bottom"} - 0.4) ; }
  2183. if ((! defined (@Legend {"columnwidth"})) && (@Legend {"columns"} > 1))
  2184. { @Legend {"columnwidth"} = sprintf ("%02f", ((@PlotArea {"left"} + @PlotArea {"width"} - 0.2) / @Legend {"columns"})) ; }
  2185. }
  2186. elsif (@Legend {"position"} =~ /right/i)
  2187. {
  2188. if (! defined (@Legend {"left"}))
  2189. { @Legend {"left"} = (@PlotArea {"left"} + @PlotArea {"width"} + 0.2) ; }
  2190. if (! defined (@Legend {"top"}))
  2191. { @Legend {"top"} = (@PlotArea {"bottom"} + @PlotArea {"height"} - 0.2) ; }
  2192. }
  2193. }
  2194. if (! defined (@Axis {"order"}))
  2195. { @Axis {"order"} = "normal" ; }
  2196. }
  2197. sub WriteProcAnnotate
  2198. {
  2199. my $bar = shift ;
  2200. my $shiftx = shift ;
  2201. my $xpos = shift ;
  2202. my $ypos = shift ;
  2203. my $text = shift ;
  2204. my $textcolor = shift ;
  2205. my $fontsize = shift ;
  2206. my $align = shift ;
  2207. my $link = shift ;
  2208. my $hint = shift ;
  2209. if (length ($text) > 250)
  2210. { &Error ("Text segments can be up to 250 characters long. This segment is " . length ($text) . " chars.\n" .
  2211. " You can either shorten the text or\n" .
  2212. " - PlotData: insert line breaks (~)\n" .
  2213. " - TextData: insert tabs (~) to produce columns\n") ; return ; }
  2214. if ($textcolor eq "")
  2215. { $textcolor = "black" ; }
  2216. my $textdetails = " textdetails: align=$align size=$fontsize color=$textcolor" ;
  2217. push @PlotTextsPng, "#proc annotate\n" ;
  2218. push @PlotTextsSvg, "#proc annotate\n" ;
  2219. push @PlotTextsPng, " location: $xpos $ypos\n" ;
  2220. push @PlotTextsSvg, " location: $xpos $ypos\n" ;
  2221. push @PlotTextsPng, $textdetails . "\n" ;
  2222. push @PlotTextsSvg, $textdetails . "\n" ;
  2223. $text2 = $text ;
  2224. $text2 =~ s/\[\[//g ;
  2225. $text2 =~ s/\]\]//g ;
  2226. if ($text2 =~ /^\s/)
  2227. { push @PlotTextsPng, " text: \n\\$text2\n\n" ; }
  2228. else
  2229. { push @PlotTextsPng, " text: $text2\n\n" ; }
  2230. $text2 = $text ;
  2231. if ($link ne "")
  2232. {
  2233. # put placeholder in Ploticus input file
  2234. # will be replaced by real link after SVG generation
  2235. # this allows adding color info
  2236. push @linksSVG, &DecodeInput ($link) ;
  2237. my $lcnt = $#linksSVG ;
  2238. $text2 =~ s/\[\[ ([^\]]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x ;
  2239. $text2 =~ s/\[\[ ([^\]]+) $/\[$lcnt\[$1\]$lcnt\]/x ;
  2240. $text2 =~ s/^ ([^\[]+) \]\]/\[$lcnt\[$1\]$lcnt\]/x ;
  2241. }
  2242. $text3 = &EncodeHtml ($text2) ;
  2243. if ($text2 ne $text3)
  2244. {
  2245. # put placeholder in Ploticus input file
  2246. # will be replaced by real text after SVG generation
  2247. # Ploticus would autoscale image improperly when text contains &#xxx; tags
  2248. # because this would count as 5 chars
  2249. push @textsSVG, &DecodeInput ($text3) ;
  2250. $text3 = "{{" . $#textsSVG . "}}" ;
  2251. while (length ($text3) < length ($text2)) { $text3 .= "x" ; }
  2252. }
  2253. if ($text3 =~ /^\s/)
  2254. { push @PlotTextsSvg, " text: \n\\$text3\n\n" ; }
  2255. else
  2256. { push @PlotTextsSvg, " text: $text3\n\n" ; }
  2257. if ($link ne "")
  2258. {
  2259. $MapPNG = $true ;
  2260. push @PlotTextsPng, "#proc annotate\n" ;
  2261. push @PlotTextsPng, " location: $xpos $ypos\n" ;
  2262. # push @PlotTextsPng, " boxmargin: 0.01\n" ;
  2263. if ($align ne "right")
  2264. {
  2265. push @PlotTextsPng, " clickmapurl: $link\n" ;
  2266. if ($hint ne "")
  2267. { push @PlotTextsPng, " clickmaplabel: $hint\n" ; }
  2268. }
  2269. else
  2270. {
  2271. if ($bar eq "")
  2272. {
  2273. if ($WarnOnRightAlignedText ++ == 0)
  2274. { &Warning2 ("Links on right aligned texts are only supported for svg output,\npending Ploticus bug fix.") ; }
  2275. return ;
  2276. }
  2277. else
  2278. {
  2279. push @PlotTextsPng, " clickmapurl: $link\&\&$shiftx\n" ;
  2280. if ($hint ne "")
  2281. { push @PlotTextsPng, " clickmaplabel: $hint\n" ; }
  2282. }
  2283. }
  2284. $textdetails =~ s/color=[^\s]+/color=$LinkColor/ ;
  2285. push @PlotTextsPng, $textdetails . "\n" ;
  2286. $text = &DecodeInput ($text) ;
  2287. if ($text =~ /^[^\[]+\]\]/)
  2288. { $text = "[[" . $text ; }
  2289. if ($text =~ /\[\[[^\]]+$/)
  2290. { $text .= "]]" ; }
  2291. my $pos1 = index ($text, "[[") ;
  2292. my $pos2 = index ($text, "]]") + 1 ;
  2293. if (($pos1 > -1) && ($pos2 > -1))
  2294. {
  2295. for (my $i = 0 ; $i < length ($text) ; $i++)
  2296. {
  2297. $c = substr ($text, $i, 1) ;
  2298. if ($c ne "\n")
  2299. {
  2300. if (($i < $pos1) || ($i > $pos2))
  2301. { substr ($text, $i, 1) = " " ; }
  2302. }
  2303. }
  2304. }
  2305. $text =~ s/\[\[(.*?)\]\]/$1/s ;
  2306. if ($text =~ /^\s/)
  2307. { push @PlotTextsPng, " text: \n\\$text\n\n" ; }
  2308. else
  2309. { push @PlotTextsPng, " text: $text\n\n" ; }
  2310. # push @PlotTextsPng, "#proc rect\n" ;
  2311. # push @PlotTextsPng, " color: green\n" ;
  2312. # push @PlotTextsPng, " rectangle: 1(s)+0.25 1937.500(s)+0.06 1(s)+0.50 1937.500(s)+0.058\n" ;
  2313. # push @PlotTextsPng, "\n\n" ;
  2314. }
  2315. }
  2316. sub WriteText
  2317. {
  2318. my $mode = shift ;
  2319. my $bar = shift ;
  2320. my $shiftx = shift ;
  2321. my $posx = shift ;
  2322. my $posy = shift ;
  2323. my $text = shift ;
  2324. my $textcolor = shift ;
  2325. my $fontsize = shift ;
  2326. my $align = shift ;
  2327. my $link = shift ;
  2328. my $hint = shift ;
  2329. my $tabs = shift ;
  2330. my ($link2, $hint2, $tab) ;
  2331. my $outside = $false ;
  2332. if (@Axis {"order"} =~ /reverse/i)
  2333. {
  2334. if (@Axis {"time"} eq "y")
  2335. { $posy =~ s/(.*)(\(s\))/(-$1).$2/xe ; }
  2336. else
  2337. { $posx =~ s/(.*)(\(s\))/(-$1).$2/xe ; }
  2338. }
  2339. if ($posx !~ /\(s\)/)
  2340. {
  2341. if ($posx < 0)
  2342. { $outside = $true ; }
  2343. if (@Image {"width"} !~ /auto/i)
  2344. {
  2345. if ($posx > @Image {"width"}/100)
  2346. { $outside = $true ; }
  2347. }
  2348. }
  2349. if ($posy !~ /\(s\)/)
  2350. {
  2351. if ($posy < 0)
  2352. { $outside = $true ; }
  2353. if (@Image {"height"} !~ /auto/i)
  2354. {
  2355. if ($posy > @Image {"height"}/100)
  2356. { $outside = $true ; }
  2357. }
  2358. }
  2359. if ($outside)
  2360. {
  2361. if ($WarnTextOutsideArea++ < 5)
  2362. { $text =~ s/\n/~/g ;
  2363. &Error ("Text segment '$text' falls outside image area. Text ignored.") ; }
  2364. return ;
  2365. }
  2366. my @Tabs = split (",", $tabs) ;
  2367. foreach $tab (@Tabs)
  2368. { $tab =~ s/\s* (.*) \s*$/$1/x ; }
  2369. $posx0 = $posx ;
  2370. my @Text ;
  2371. my $dy = 0 ;
  2372. if ($text =~ /\[\[.*\]\]/)
  2373. {
  2374. $link = "" ; $hint = "" ;
  2375. }
  2376. my @Text ;
  2377. if ($mode eq "^")
  2378. { @Text = split ('\^', $text) ; }
  2379. elsif ($mode eq "~")
  2380. {
  2381. @Text = split ('\n', $text) ;
  2382. if ($fontsize =~ /^(?:XS|S|M|L|XL)$/i)
  2383. {
  2384. if ($fontsize =~ /XS/i) { $dy = 0.09 ; }
  2385. elsif ($fontsize =~ /S/i) { $dy = 0.11 ; }
  2386. elsif ($fontsize =~ /M/i) { $dy = 0.135 ; }
  2387. elsif ($fontsize =~ /XL/i) { $dy = 0.21 ; }
  2388. else { $dy = 0.16 ; }
  2389. }
  2390. else
  2391. {
  2392. $dy = sprintf ("%.2f", (($fontsize * 1.2) / 100)) ;
  2393. if ($dy < $fontsize/100 + 0.02)
  2394. { $dy = $fontsize/100 + 0.02 ; }
  2395. }
  2396. }
  2397. else
  2398. { push @Text, $text ; }
  2399. foreach $text (@Text)
  2400. {
  2401. if ($text !~ /^[\n\s]*$/)
  2402. {
  2403. $link2 = "" ;
  2404. $hint2 = "" ;
  2405. ($text, $link2, $hint2) = &ProcessWikiLink ($text, $link2, $hint2) ;
  2406. if ($link2 eq "")
  2407. {
  2408. $link2 = $link ;
  2409. if (($link ne "") && ($text !~ /\[\[.*\]\]/))
  2410. { $text = "[[" . $text . "]]" ;}
  2411. }
  2412. if ($hint2 eq "")
  2413. { $hint2 = $hint ; }
  2414. &WriteProcAnnotate ($bar, $shiftx, $posx, $posy, $text, $textcolor, $fontsize, $align, $link2, $hint2) ;
  2415. }
  2416. if ($#Tabs >= 0)
  2417. {
  2418. $tab = shift (@Tabs) ;
  2419. ($dx,$align) = split ("\-", $tab) ;
  2420. $posx = $posx0 + &Normalize ($dx) ;
  2421. }
  2422. if ($posy =~ /\+/)
  2423. { ($posy1, $posy2) = split ('\+', $posy) ; }
  2424. elsif ($posy =~ /.+\-/)
  2425. {
  2426. if ($posy =~ /^\-/)
  2427. {
  2428. ($sign, $posy1, $posy2) = split ('\-', $posy) ; $posy2 = -$posy2 ;
  2429. $posy1 = "-" . $posy1 ;
  2430. }
  2431. else
  2432. { ($posy1, $posy2) = split ('\-', $posy) ; $posy2 = -$posy2 ; }
  2433. }
  2434. else
  2435. { $posy1 = $posy ; $posy2 = 0 ; }
  2436. $posy2 -= $dy ;
  2437. if ($posy2 == 0)
  2438. { $posy = $posy1 ; }
  2439. elsif ($posy2 < 0)
  2440. { $posy = $posy1 . "$posy2" ; }
  2441. else
  2442. { $posy = $posy1 . "+" . $posy2 ; }
  2443. }
  2444. }
  2445. sub WriteProcDrawCommandsOld
  2446. {
  2447. my $posx = shift ;
  2448. my $posy = shift ;
  2449. my $text = shift ;
  2450. my $textcolor = shift ;
  2451. my $fontsize = shift ;
  2452. my $link = shift ;
  2453. my $hint = shift ;
  2454. $posx0 = $posx ;
  2455. my @Text = split ('\^', $text) ;
  2456. my $align = "text" ;
  2457. foreach $text (@Text)
  2458. {
  2459. push @TextData, " mov $posx $posy\n" ;
  2460. push @TextData, " textsize $fontsize\n" ;
  2461. push @TextData, " color $textcolor\n" ;
  2462. push @TextData, " $align $text\n" ;
  2463. $tab = shift (@Tabs) ;
  2464. ($dx,$align) = split ("\-", $tab) ;
  2465. $posx = $posx0 + &Normalize ($dx) ;
  2466. if ($align =~ /left/i) { $align = "text" ; }
  2467. elsif ($align =~ /right/i) { $align = "rightjust" ; }
  2468. else { $align = "centext" ; }
  2469. }
  2470. }
  2471. sub WritePlotFile
  2472. {
  2473. &WriteTexts ;
  2474. $script = "" ;
  2475. my ($color) ;
  2476. if (@Axis {"time"} eq "x")
  2477. { $AxisBars = "y" ; }
  2478. else
  2479. { $AxisBars = "x" ; }
  2480. # if ((@Axis {"time"} eq "y") && ($#Bars > 0))
  2481. # {
  2482. # undef @BarsTmp ;
  2483. # while ($#Bars >= 0)
  2484. # { push @BarsTmp, pop @Bars ; }
  2485. # @Bars = @BarsTmp ;
  2486. # }
  2487. if ($tmpdir ne "")
  2488. { $file_script = $tmpdir.$pathseparator."EasyTimeline.txt.$$" ; }
  2489. else
  2490. { $file_script = "EasyTimeline.txt" ; }
  2491. print "Ploticus input file = ".$file_script."\n";
  2492. # $fmt = "gif" ;
  2493. open "FILE_OUT", ">", $file_script ;
  2494. #proc settings
  2495. # $script .= "#proc settings\n" ;
  2496. # $script .= " xml_encoding: utf-8\n" ;
  2497. # $script .= "\n" ;
  2498. # proc page
  2499. $script .= "#proc page\n" ;
  2500. $script .= " dopagebox: no\n" ;
  2501. $script .= " pagesize: ". @Image {"width"} . " ". @Image {"height"} . "\n" ;
  2502. if (defined (@BackgroundColors {"canvas"}))
  2503. { $script .= " backgroundcolor: " . @BackgroundColors {"canvas"} . "\n" ; }
  2504. $script .= "\n" ;
  2505. $barcnt = $#Bars + 1 ;
  2506. # if ($AlignBars eq "justify") && ($#Bars > 0)
  2507. #
  2508. # given P = plotwidth in pixels
  2509. # given B = half bar width in pixels
  2510. # get U = plotwidth in units
  2511. # get x = half bar width in units
  2512. #
  2513. # first bar plotted at unit 1
  2514. # last bar plotted at unit c
  2515. # let C = c - 1 (units between centers of lowest and highest bar) -> x = (U-C) / 2
  2516. #
  2517. # Justify: calculate range for axis in units:
  2518. # axis starts at 1-x and ends at c+x =
  2519. # x/B = U/P -> x = BU/P (1)
  2520. # U = c+x - (1-x) = (c-1) + 2x -> x = (U-(c-1))/2 (2)
  2521. #
  2522. # (1) & (2) -> BU/P = (U-(c-1))/2
  2523. # -> 2BU/P = U-(c-1)
  2524. # -> 2BU/P = U - C
  2525. # -> 2BU = PU - PC
  2526. # -> U (2B-P) = -PC
  2527. # -> U = -PC/(2B-P)
  2528. # P = @PlotArea {$extent}
  2529. # C = c - 1 = $#Bars
  2530. # 2B = $MaxBarWidth
  2531. if (! defined ($AlignBars))
  2532. {
  2533. &Info2 ("AlignBars not defined. Alignment 'early' assumed.") ;
  2534. $AlignBars = "early" ;
  2535. }
  2536. if (@Axis {"time"} eq "x")
  2537. { $extent = "height" ; }
  2538. else
  2539. { $extent = "width" ; }
  2540. if ($MaxBarWidth > @PlotArea {$extent})
  2541. { &Error2 ("Maximum bar width exceeds plotarea " . $extent . ".") ; return ; }
  2542. if ($MaxBarWidth == @PlotArea {$extent})
  2543. { @PlotArea {$extent} += 0.01 ; }
  2544. if ($MaxBarWidth == @PlotArea {$extent})
  2545. {
  2546. $till = 1 ;
  2547. $from = 1 ;
  2548. }
  2549. else
  2550. {
  2551. if ($AlignBars eq "justify")
  2552. {
  2553. if ($#Bars > 0)
  2554. {
  2555. $U = - (@PlotArea {$extent} * $#Bars) / ($MaxBarWidth - @PlotArea {$extent}) ;
  2556. $x = ($U - $#Bars) / 2 ;
  2557. $from = 1 - $x ;
  2558. $till = 1 + $#Bars + $x ;
  2559. }
  2560. else # one bar-> "justify" is misnomer here, treat as "center"
  2561. {
  2562. # $x = ($MaxBarWidth /2) / @PlotArea {$extent} ;
  2563. # $from = 0.5 - $x ;
  2564. # $till = $from + 1 ;
  2565. $from = 0.5 ;
  2566. $till = 1.5 ;
  2567. }
  2568. }
  2569. elsif ($AlignBars eq "early")
  2570. {
  2571. $U = $#Bars + 1 ;
  2572. if ($U == 0)
  2573. { $U = 1 ; }
  2574. $x = (($MaxBarWidth /2) * $U) / @PlotArea {$extent} ;
  2575. $from = 1 - $x ;
  2576. $till = $from + $U ;
  2577. }
  2578. elsif ($AlignBars eq "late")
  2579. {
  2580. $U = $#Bars + 1 ;
  2581. $x = (($MaxBarWidth /2) * $U) / @PlotArea {$extent} ;
  2582. $till = $U + $x ;
  2583. $from = $till - $U ;
  2584. }
  2585. }
  2586. # if ($#Bars == 0)
  2587. # {
  2588. # $from = 1 - $MaxBarWidth ;
  2589. # $till = 1 + $MaxBarWidth ;
  2590. # }
  2591. if ($from eq $till)
  2592. { $till = $from + 1 ; }
  2593. #proc areadef
  2594. $script .= "#proc areadef\n" ;
  2595. $script .= " rectangle: " . @PlotArea {"left"} . " " . @PlotArea {"bottom"} . " " .
  2596. sprintf ("%.2f", @PlotArea {"left"} + @PlotArea {"width"}). " " . sprintf ("%.2f", @PlotArea {"bottom"} + @PlotArea {"height"}) . "\n" ;
  2597. if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y"))
  2598. { $script .= " " . @Axis {"time"} . "scaletype: linear\n" ; } # date yyyy
  2599. else
  2600. { $script .= " " . @Axis {"time"} . "scaletype: date $DateFormat\n" ; }
  2601. if (@Axis {"order"} !~ /reverse/i)
  2602. { $script .= " " . @Axis {"time"} . "range: " . @Period{"from"} . " " . @Period{"till"} . "\n" ; }
  2603. else
  2604. { $script .= " " . @Axis {"time"} . "range: " . (-@Period{"till"}) . " " . (-@Period{"from"}) . "\n" ; }
  2605. $script .= " " . $AxisBars . "scaletype: linear\n" ;
  2606. $script .= " " . $AxisBars . "range: " . sprintf ("%.3f", $from-0.001) . " " . sprintf ("%.3f", $till) . "\n" ;
  2607. $script .= " #saveas: A\n" ;
  2608. $script .= "\n" ;
  2609. #proc rect (test)
  2610. # $script .= "#proc rect\n" ;
  2611. # $script .= " rectangle 1.0 1.0 1.4 1.4\n" ;
  2612. # $script .= " color gray(0.95)\n" ;
  2613. # $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ;
  2614. # $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ;
  2615. #proc legendentry
  2616. foreach $color (sort keys %Colors)
  2617. {
  2618. $script .= "#proc legendentry\n" ;
  2619. $script .= " sampletype: color\n" ;
  2620. if ((defined (@ColorLabels {$color})) && (@ColorLabels {$color} ne ""))
  2621. { $script .= " label: " . @ColorLabels {$color} . "\n" ; }
  2622. $script .= " details: " . @Colors {$color} . "\n" ;
  2623. $script .= " tag: $color\n" ;
  2624. $script .= "\n" ;
  2625. }
  2626. if (defined (@BackgroundColors {"bars"}))
  2627. {
  2628. #proc getdata / #proc bars
  2629. $script .= "#proc getdata\n" ;
  2630. $script .= " delim: comma\n" ;
  2631. $script .= " data:\n" ;
  2632. $maxwidth = 0 ;
  2633. foreach $entry (@PlotBars)
  2634. {
  2635. ($width) = split (",", $entry) ;
  2636. if ($width > $maxwidth)
  2637. { $maxwidth = $width ; }
  2638. }
  2639. for ($b = 0 ; $b <= $#Bars ; $b++)
  2640. { $script .= ($b+1) . "," . @Period {"from"} . "," . @Period {"till"} . ",".
  2641. @BackgroundColors {"bars"} . "\n" ; }
  2642. $script .= "\n" ;
  2643. #proc bars
  2644. $script .= "#proc bars\n" ;
  2645. $script .= " axis: " . @Axis {"time"} . "\n" ;
  2646. $script .= " barwidth: $maxwidth\n" ;
  2647. $script .= " outline: no\n" ;
  2648. if (@Axis {"time"} eq "x")
  2649. { $script .= " horizontalbars: yes\n" ; }
  2650. $script .= " locfield: 1\n" ;
  2651. $script .= " segmentfields: 2 3\n" ;
  2652. $script .= " colorfield: 4\n" ;
  2653. # $script .= " clickmaplabel: Vladimir Ilyich Lenin\n" ;
  2654. # $script .= " clickmapurl: http://www.wikipedia.org/wiki/Vladimir_Lenin\n" ;
  2655. $script .= "\n" ;
  2656. }
  2657. #proc axis
  2658. if (defined (@Scales {"Minor grid"}))
  2659. { &PlotScale ("Minor", $true) ; }
  2660. if (defined (@Scales {"Major grid"}))
  2661. { &PlotScale ("Major", $true) ; }
  2662. &PlotLines ("back") ;
  2663. @PlotBarsNow = @PlotBars ;
  2664. &PlotBars ;
  2665. $script .= "\n([inc3])\n\n" ; # will be replace by rects
  2666. %x = %BarWidths ;
  2667. foreach $entry (@PlotLines)
  2668. {
  2669. ($bar) = split (",", $entry) ;
  2670. $bar =~ s/\#.*// ;
  2671. $width = @BarWidths {$bar} ;
  2672. $entry = sprintf ("%6.3f",$width) . "," . $entry ;
  2673. }
  2674. @PlotBarsNow = @PlotLines ;
  2675. &PlotBars ;
  2676. #proc axis
  2677. if ($#Bars > 0)
  2678. {
  2679. $scriptPng2 = "#proc " . $AxisBars . "axis\n" ;
  2680. $scriptSvg2 = "#proc " . $AxisBars . "axis\n" ;
  2681. if ($AxisBars eq "x")
  2682. {
  2683. $scriptPng2 .= " stubdetails: adjust=0,0.09\n" ;
  2684. $scriptSvg2 .= " stubdetails: adjust=0,0.09\n" ;
  2685. }
  2686. else
  2687. {
  2688. $scriptPng2 .= " stubdetails: adjust=0.09,0\n" ;
  2689. $scriptSvg2 .= " stubdetails: adjust=0.09,0\n" ;
  2690. }
  2691. $scriptPng2 .= " tics: none\n" ;
  2692. $scriptSvg2 .= " tics: none\n" ;
  2693. $scriptPng2 .= " stubrange: 1\n" ;
  2694. $scriptSvg2 .= " stubrange: 1\n" ;
  2695. if ($AxisBars eq "y")
  2696. {
  2697. $scriptPng2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ;
  2698. $scriptSvg2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ;
  2699. }
  2700. $scriptPng2 .= " stubs: text\n" ;
  2701. $scriptSvg2 .= " stubs: text\n" ;
  2702. my ($text, $link, $hint) ;
  2703. undef (@Bars2) ;
  2704. foreach $bar (@Bars)
  2705. {
  2706. if ($AxisBars eq "y")
  2707. { push @Bars2, $bar ; }
  2708. else
  2709. { unshift @Bars2, $bar ; }
  2710. }
  2711. foreach $bar (@Bars2)
  2712. {
  2713. $hint = "" ;
  2714. $text = @BarLegend {lc ($bar)} ;
  2715. if ($text =~ /^\s*$/)
  2716. { $text = "\\" ; }
  2717. $link = @BarLink {lc ($bar)} ;
  2718. if (! defined ($link))
  2719. {
  2720. if ($text =~ /\[.*\]/)
  2721. { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; }
  2722. }
  2723. $text =~ s/\[+([^\]]*)\]+/$1/ ;
  2724. $scriptPng2 .= "$text\n" ;
  2725. if (defined ($link))
  2726. {
  2727. push @linksSVG, $link ;
  2728. my $lcnt = $#linksSVG ;
  2729. $scriptSvg2 .= "[" . $lcnt . "[" . $text . "]" . $lcnt . "]\n" ;
  2730. }
  2731. else
  2732. { $scriptSvg2 .= "$text\n" ; }
  2733. }
  2734. $scriptPng2 .= "\n" ;
  2735. $scriptSvg2 .= "\n" ;
  2736. $scriptPng2 .= "#proc " . $AxisBars . "axis\n" ;
  2737. if ($AxisBars eq "x")
  2738. { $scriptPng2 .= " stubdetails: adjust=0,0.09 color=$LinkColor\n" ; }
  2739. else
  2740. { $scriptPng2 .= " stubdetails: adjust=0.09,0 color=$LinkColor\n" ; }
  2741. $scriptPng2 .= " tics: none\n" ;
  2742. $scriptPng2 .= " stubrange: 1\n" ;
  2743. if ($AxisBars eq "y")
  2744. { $scriptPng2 .= " stubslide: -" . sprintf ("%.2f", $MaxBarWidth / 2) . "\n" ; }
  2745. $scriptPng2 .= " stubs: text\n" ;
  2746. $barcnt = $#Bars + 1 ;
  2747. foreach $bar (@Bars2)
  2748. {
  2749. $hint = "" ;
  2750. $text = @BarLegend {lc ($bar)} ;
  2751. if ($text =~ /^\s*$/)
  2752. { $text = "\\" ; }
  2753. $link = @BarLink {lc ($bar)} ;
  2754. if (! defined ($link))
  2755. {
  2756. if ($text =~ /\[.*\]/)
  2757. { ($text, $link, $hint) = &ProcessWikiLink ($text, $link, $hint) ; }
  2758. }
  2759. if ((! defined ($link)) || ($link eq ""))
  2760. { $text = "\\" ; }
  2761. else
  2762. {
  2763. $scriptPng3 .= "#proc rect\n" ;
  2764. $scriptPng3 .= " rectangle: 0 $barcnt(s)+0.05 " . @PlotArea {"left"} . " $barcnt(s)-0.05\n" ;
  2765. $scriptPng3 .= " color: " . @BackgroundColors {"canvas"} . "\n" ;
  2766. $scriptPng3 .= " clickmapurl: " . $link . "\n" ;
  2767. if ((defined ($hint)) && ($hint ne ""))
  2768. { $scriptPng3 .= " clickmaplabel: " . $hint . "\n" ; }
  2769. $text =~ s/\[+([^\]]*)\]+/$1/ ;
  2770. }
  2771. $scriptPng2 .= "$text\n" ;
  2772. $barcnt-- ;
  2773. }
  2774. $scriptPng2 .= "\n" ;
  2775. }
  2776. &PlotLines ("front") ;
  2777. $script .= "\n([inc1])\n\n" ; # will be replaced by annotations
  2778. $script .= "\n([inc2])\n\n" ;
  2779. if ($#PlotTextsPng >= 0)
  2780. {
  2781. foreach $command (@PlotTextsPng)
  2782. {
  2783. if ($command =~ /^\s*location/)
  2784. { $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe ; }
  2785. $scriptPng1 .= $command ;
  2786. }
  2787. $scriptPng1 .= "\n" ;
  2788. }
  2789. if ($#PlotTextsSvg >= 0)
  2790. {
  2791. foreach $command (@PlotTextsSvg)
  2792. {
  2793. if ($command =~ /^\s*location/)
  2794. { $command =~ s/(.*)\[(.*)\](.*)/$1 . ($#Bars - $2 + 2) . $3/xe ; }
  2795. $scriptSvg1 .= $command ;
  2796. }
  2797. $scriptSvg1 .= "\n" ;
  2798. }
  2799. # $script .= "#proc symbol\n" ;
  2800. # $script .= " location: 01/01/1943(s) Korea \n" ;
  2801. # $script .= " symbol: style=fill shape=downtriangle fillcolor=white radius=0.04\n" ;
  2802. # $script .= "\n" ;
  2803. #proc axis
  2804. # repeat without grid to get axis on top of bar
  2805. # needed because axis may overlap bar slightly
  2806. if (defined (@Scales {"Minor"}))
  2807. { &PlotScale ("Minor", $false) ; }
  2808. if (defined (@Scales {"Major"}))
  2809. { &PlotScale ("Major", $false) ; }
  2810. #proc drawcommands
  2811. if ($#TextData >= 0)
  2812. {
  2813. $script .= "#proc drawcommands\n" ;
  2814. $script .= " commands:\n" ;
  2815. foreach $entry (@TextData)
  2816. { $script .= $entry ; }
  2817. $script .= "\n" ;
  2818. }
  2819. #proc legend
  2820. if (defined (@Legend {"orientation"}))
  2821. {
  2822. if (($#LegendData < 0) && ($Preset eq ""))
  2823. { &Error2 ("Command 'Legend' found, but no entries for the legend were specified.\n" .
  2824. " Please remove or disable command (disable = put \# before the command)\n" .
  2825. " or specify entries for the legend with command 'Colors', attribute 'legend'\n") ;
  2826. return ; }
  2827. $perColumn = 999 ;
  2828. if (@Legend {"orientation"} =~ /ver/i)
  2829. {
  2830. if (@Legend {"columns"} > 1)
  2831. {
  2832. $perColumn = 0 ;
  2833. while ((@Legend {"columns"} * $perColumn) < $#LegendData + 1)
  2834. { $perColumn ++ ; }
  2835. }
  2836. }
  2837. for ($l = 1 ; $l <= @Legend {"columns"} ; $l++)
  2838. {
  2839. $script .= "#proc legend\n" ;
  2840. $script .= " noclear: yes\n" ;
  2841. if (@Legend {"orientation"} =~ /ver/i)
  2842. { $script .= " format: multiline\n" ; }
  2843. else
  2844. { $script .= " format: singleline\n" ; }
  2845. $script .= " seglen: 0.2\n" ;
  2846. $script .= " swatchsize: 0.12\n" ;
  2847. $script .= " textdetails: size=S\n" ;
  2848. $script .= " location: " . (@Legend{"left"}+0.2) . " " . @Legend{"top"} . "\n" ;
  2849. $script .= " specifyorder:\n" ;
  2850. for ($l2 = 1 ; $l2 <= $perColumn ; $l2++)
  2851. {
  2852. $category = shift (@LegendData) ;
  2853. if (defined ($category))
  2854. { $script .= "$category\n" ; }
  2855. }
  2856. $script .= "\n" ;
  2857. @Legend {"left"} += @Legend {"columnwidth"} ;
  2858. }
  2859. }
  2860. $script .= "#endproc\n" ;
  2861. print "\nGenerating output:\n" ;
  2862. if ( $plcommand ne "" )
  2863. { $pl = $plcommand; }
  2864. else
  2865. {
  2866. $pl = "pl.exe" ;
  2867. if ($env eq "Linux")
  2868. { $pl = "pl" ; }
  2869. }
  2870. print "Using ploticus command \"".$pl."\" (".$plcommand.")\n";
  2871. $script_save = $script ;
  2872. $script =~ s/\(\[inc1\]\)/$scriptSvg1/ ;
  2873. $script =~ s/\(\[inc2\]\)/$scriptSvg2/ ;
  2874. $script =~ s/\(\[inc3\]\)// ;
  2875. $script =~ s/textsize XS/textsize 7/gi ;
  2876. $script =~ s/textsize S/textsize 8.9/gi ;
  2877. $script =~ s/textsize M/textsize 10.5/gi ;
  2878. $script =~ s/textsize L/textsize 13/gi ;
  2879. $script =~ s/textsize XL/textsize 17/gi ;
  2880. $script =~ s/size=XS/size=7/gi ;
  2881. $script =~ s/size=S/size=8.9/gi ;
  2882. $script =~ s/size=M/size=10.5/gi ;
  2883. $script =~ s/size=L/size=13/gi ;
  2884. $script =~ s/size=XL/size=17/gi ;
  2885. $script =~ s/(\n location:.*)/&ShiftOnePixelForSVG($1)/ge ;
  2886. open "FILE_OUT", ">", $file_script ;
  2887. print FILE_OUT &DecodeInput($script) ;
  2888. close "FILE_OUT" ;
  2889. $map = ($MapSVG) ? "-map" : "";
  2890. print "Running Ploticus to generate svg file\n" ;
  2891. # my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop -font \"Times\"" ;
  2892. # my $cmd = "$pl $map -" . "svg" . " -o $file_vector $file_script -tightcrop" ;
  2893. my $cmd = EscapeShellArg($pl) . " $map -" . "svg" . " -o " .
  2894. EscapeShellArg($file_vector) . " " . EscapeShellArg($file_script) . " -tightcrop" ;
  2895. print "$cmd\n";
  2896. system ($cmd) ;
  2897. $script = $script_save ;
  2898. $script =~ s/dopagebox: no/dopagebox: yes/ ;
  2899. $script =~ s/\(\[inc1\]\)/$scriptPng1/ ;
  2900. $script =~ s/\(\[inc2\]\)/$scriptPng2/ ;
  2901. $script =~ s/\(\[inc3\]\)/$scriptPng3/ ;
  2902. $script =~ s/textsize XS/textsize 6/gi ;
  2903. $script =~ s/textsize S/textsize 8/gi ;
  2904. $script =~ s/textsize M/textsize 10/gi ;
  2905. $script =~ s/textsize L/textsize 14/gi ;
  2906. $script =~ s/textsize XL/textsize 18/gi ;
  2907. $script =~ s/size=XS/size=6/gi ;
  2908. $script =~ s/size=S/size=8/gi ;
  2909. $script =~ s/size=M/size=10/gi ;
  2910. $script =~ s/size=L/size=14/gi ;
  2911. $script =~ s/size=XL/size=18/gi ;
  2912. open "FILE_OUT", ">", $file_script ;
  2913. print FILE_OUT &DecodeInput($script) ;
  2914. close "FILE_OUT" ;
  2915. $map = ($MapPNG && $linkmap) ? "-csmap" : "";
  2916. if ($linkmap && $showmap)
  2917. { $map .= " -csmapdemo" ; }
  2918. # $crop = "-crop 0,0," + @ImageSize {"width"} . "," . @ImageSize {"height"} ;
  2919. print "Running Ploticus to generate bitmap\n" ;
  2920. # $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop" ; # -v $file_bitmap" ;
  2921. # $cmd = "$pl $map -" . $fmt . " -o $file_bitmap $file_script -tightcrop -diagfile $file_pl_info -errfile $file_pl_err" ;
  2922. $cmd = EscapeShellArg($pl) . " $map -" . $fmt . " -o " .
  2923. EscapeShellArg($file_bitmap) . " " . EscapeShellArg($file_script) . " -tightcrop -font FreeSans.ttf" .
  2924. " -mapfile " . EscapeShellArg($file_htmlmap) ;
  2925. print "$cmd\n";
  2926. system ($cmd) ;
  2927. if ((-e $file_bitmap) && (-s $file_bitmap > 500 * 1024))
  2928. {
  2929. &Error2 ("Output image size exceeds 500 K. Image deleted.\n" .
  2930. "Run with option -b (bypass checks) when this is correct.\n") ;
  2931. unlink $file_bitmap ;
  2932. } ;
  2933. # not for Wikipedia, only for offline use:
  2934. if ((-e $file_bitmap) && ($fmt eq "gif"))
  2935. {
  2936. print "Running nconvert to convert gif image to png format\n\n" ;
  2937. print "---------------------------------------------------------------------------\n" ;
  2938. $cmd = "nconvert.exe -out png " . EscapeShellArg($file_bitmap) ;
  2939. system ($cmd) ;
  2940. print "---------------------------------------------------------------------------\n" ;
  2941. if (! (-e $file_png))
  2942. { print "PNG file not created (is nconvert.exe missing?)\n\n" ; }
  2943. }
  2944. if (-e $file_htmlmap) # correct click coordinates of right aligned texts (Ploticus bug)
  2945. {
  2946. open "FILE_IN", "<", $file_htmlmap ;
  2947. @map = <FILE_IN> ;
  2948. close "FILE_IN" ;
  2949. foreach $line (@map)
  2950. {
  2951. chomp $line ;
  2952. if ($line =~ /\&\&/)
  2953. {
  2954. $coords = $line ;
  2955. $shift = $line ;
  2956. $coords =~ s/^.*coords\=\"([^\"]*)\".*$/$1/ ;
  2957. $shift =~ s/^.*\&\&([^\"]*)\".*$/$1/ ;
  2958. $line =~ s/\&\&[^\"]*// ;
  2959. (@updcoords) = split (",", $coords) ;
  2960. $maplength = @updcoords [2] - @updcoords [0] ;
  2961. @updcoords [0] = @updcoords [0] - 2 * ($maplength-25) ;
  2962. @updcoords [2] = @updcoords [0] + $maplength ;
  2963. $coordsnew = join (",", @updcoords) ;
  2964. $line =~ s/$coords/$coordsnew/ ;
  2965. push @map2, $line . "\n" ;
  2966. }
  2967. else
  2968. { push @map2, $line . "\n" ; }
  2969. }
  2970. open "FILE_OUT", ">", $file_htmlmap ;
  2971. print FILE_OUT @map2 ;
  2972. close "FILE_OUT" ;
  2973. }
  2974. if (-e $file_vector)
  2975. {
  2976. open "FILE_IN", "<", $file_vector ;
  2977. @svg = <FILE_IN> ;
  2978. close "FILE_IN" ;
  2979. foreach $line (@svg)
  2980. {
  2981. $line =~ s/\{\{(\d+)\}\}x+/@textsSVG[$1]/gxe ;
  2982. $line =~ s/\[(\d+)\[ (.*?) \]\d+\]/'<a style="fill:blue;" xlink:href="' . @linksSVG[$1] . '">' . $2 . '<\/a>'/gxe ;
  2983. }
  2984. open "FILE_OUT", ">", $file_vector ;
  2985. print FILE_OUT @svg ;
  2986. close "FILE_OUT" ;
  2987. }
  2988. # not for Wikipedia, for offline use:
  2989. if ($makehtml)
  2990. {
  2991. $map = "" ;
  2992. if ($linkmap)
  2993. {
  2994. open "FILE_IN", "<", $file_htmlmap ;
  2995. while ($line = <FILE_IN>)
  2996. { $map .= $line ; }
  2997. close "FILE_IN" ;
  2998. }
  2999. print "Generating html test file\n" ;
  3000. $width = sprintf ("%.0f", @Image {"width"} * 100) ;
  3001. $height = sprintf ("%.0f", @Image {"height"} * 100) ;
  3002. $html = <<__HTML__ ;
  3003. <html>
  3004. <head>
  3005. <title>%FILENAME% - EasyTimeline test file</title>\n
  3006. </head>
  3007. <body>
  3008. <h1><font color="green">EasyTimeline</font> - Test Page</h1>
  3009. <b>Fixed size version (PNG): file $file_png</b><p>
  3010. <map name="map1">
  3011. $map</map>
  3012. <!--
  3013. If you want a border simplest way is set <img .. border='1'>
  3014. Here tables are used to draw similar borders around both images (border='1' seems not to work for embed tag)
  3015. -->
  3016. <table border='1' cellpadding='0' cellspacing='0'><tr><td>
  3017. <img src=$file_png usemap='#map1' border='0'>
  3018. </td></tr></table>
  3019. <hr>
  3020. <b>Scalable version (SVG): file $file_vector</b><p>
  3021. <table border='1' cellpadding='0' cellspacing='0'><tr><td>
  3022. <noembed>Your browser does not support embedded objects</noembed>
  3023. <embed src='$file_vector' name='SVGEmbed' border='1'
  3024. width='$width' height='$height' type='image/svg-xml' pluginspage='http://www.adobe.com/svg/viewer/install/'>
  3025. </td></tr></table>
  3026. <p>As you can see the scalable version renders fonts smoother better than the bitmap version.
  3027. <br>Any SVG picture can also be rescaled or zoomed into, without annoying artefacts.
  3028. <p>Windows users:<br>
  3029. <small>&nbsp;&nbsp;Right mouse click on picture for zoom options or</small>
  3030. <p><small>&nbsp;&nbsp;Ctrl+click for zoom in</small>
  3031. <br><small>&nbsp;&nbsp;Ctrl+Shift+click for zoom out</small>
  3032. <br><small>&nbsp;&nbsp;Alt+drag with mouse to move focus</small>
  3033. </body>
  3034. </html>
  3035. __HTML__
  3036. $html =~ s/\%FILENAME\%/$file_name/ ;
  3037. open "FILE_OUT", ">", $file_html ;
  3038. print FILE_OUT $html ;
  3039. close "FILE_OUT" ;
  3040. }
  3041. # my $cmd = "\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"" ;
  3042. # system ("\"c:\\\\Program Files\\\\XnView\\\\xnview.exe\"", "d:\\\\Wikipedia\\Perl\\\\Wo2\\\\Test.png") ;
  3043. }
  3044. sub WriteTexts
  3045. {
  3046. my ($line, $xpos, $ypos) ;
  3047. foreach $line (@PlotText)
  3048. {
  3049. my ($at, $bar, $text, $textcolor, $fontsize, $align, $shift, $link, $hint) = split (",", $line) ;
  3050. $text =~ s/\#\%\$/\,/g ;
  3051. $link =~ s/\#\%\$/\,/g ;
  3052. $hint =~ s/\#\%\$/\,/g ;
  3053. $shift =~ s/\#\%\$/\,/g ;
  3054. $textcolor =~ s/\#\%\$/\,/g ;
  3055. my $barcnt = 0 ;
  3056. for ($b = 0 ; $b <= $#Bars ; $b++)
  3057. {
  3058. if (lc(@Bars [$b]) eq lc($bar))
  3059. { $barcnt = ($b + 1) ; last ; }
  3060. }
  3061. if (@Axis {"time"} eq "x")
  3062. { $xpos = "$at(s)" ; $ypos = "[$barcnt](s)" ; }
  3063. else
  3064. { $ypos = "$at(s)" ; $xpos = "[$barcnt](s)" ; }
  3065. if ($shift ne "")
  3066. {
  3067. my ($shiftx, $shifty) = split (",", $shift) ;
  3068. if ($shiftx > 0)
  3069. { $xpos .= "+$shiftx" ; }
  3070. if ($shiftx < 0)
  3071. { $xpos .= "$shiftx" ; }
  3072. if ($shifty > 0)
  3073. { $ypos .= "+$shifty" ; }
  3074. if ($shifty < 0)
  3075. { $ypos .= "$shifty" ; }
  3076. }
  3077. &WriteText ("~", $bar, $shiftx, $xpos, $ypos, $text, $textcolor, $fontsize, $align, $link, $hint) ;
  3078. }
  3079. }
  3080. sub PlotBars
  3081. {
  3082. #proc getdata / #proc bars
  3083. while ($#PlotBarsNow >= 0)
  3084. {
  3085. undef @PlotBarsLater ;
  3086. $maxwidth = 0 ;
  3087. foreach $entry (@PlotBarsNow)
  3088. {
  3089. ($width) = split (",", $entry) ;
  3090. if ($width > $maxwidth)
  3091. { $maxwidth = $width ; }
  3092. }
  3093. $script .= "#proc getdata\n" ;
  3094. $script .= " delim: comma\n" ;
  3095. $script .= " data:\n" ;
  3096. foreach $entry (@PlotBarsNow)
  3097. {
  3098. my ($width, $bar, $from, $till, $color, $link, $hint) = split (",", $entry) ;
  3099. if ($width < $maxwidth)
  3100. {
  3101. push @PlotBarsLater, $entry ;
  3102. next ;
  3103. }
  3104. for ($b = 0 ; $b <= $#Bars ; $b++)
  3105. {
  3106. if (lc(@Bars [$b]) eq lc($bar))
  3107. { $bar = ($#Bars - ($b - 1)) ; last ; }
  3108. }
  3109. if (@Axis {"order"} !~ /reverse/i)
  3110. { $entry = "$bar,$from,$till,$color,$link,$hint,\n" ; }
  3111. else
  3112. { $entry = "$bar," . (-$till) . "," . (-$from) . ",$color,$link,$hint,\n" ; }
  3113. $script .= "$entry" ;
  3114. }
  3115. $script .= "\n" ;
  3116. #proc bars
  3117. $script .= "#proc bars\n" ;
  3118. $script .= " axis: " . @Axis {"time"} . "\n" ;
  3119. $script .= " barwidth: $maxwidth\n" ;
  3120. $script .= " outline: no\n" ;
  3121. # $script .= " thinbarline: width=5\n" ;
  3122. if (@Axis {"time"} eq "x")
  3123. { $script .= " horizontalbars: yes\n" ; }
  3124. $script .= " locfield: 1\n" ;
  3125. $script .= " segmentfields: 2 3\n" ;
  3126. $script .= " colorfield: 4\n" ;
  3127. # $script .= " outline: width=1\n" ;
  3128. # $script .= " barwidthfield: 5\n" ;
  3129. # if (@fields [4] ne "")
  3130. # { $script .= " clickmapurl: " . &LinkToUrl ($text) . "\n" ; }
  3131. # if (@fields [5] ne "")
  3132. # { $script .= " clickmaplabel: $text\n" ; }
  3133. $script .= " clickmapurl: \@\@5\n" ;
  3134. $script .= " clickmaplabel: \@\@6\n" ;
  3135. $script .= "\n" ;
  3136. @PlotBarsNow = @PlotBarsLater ;
  3137. }
  3138. }
  3139. sub PlotScale
  3140. {
  3141. my $scale = shift ;
  3142. my $grid = shift ;
  3143. my ($color, $from, $till, $start) ;
  3144. %x = %Period ;
  3145. # if (($DateFormat =~ /\//) && ($grid))
  3146. # { return ; }
  3147. # if (($DateFormat =~ /\//)
  3148. # {
  3149. # }
  3150. # if (! $grid) # redefine area, scale linear for time axis, showl whole years always, Ploticus bug
  3151. # {
  3152. # $from = @Period {"from"} ;
  3153. # $till = @Period {"till"} ;
  3154. $from = &DateToFloat (@Period {"from"}) ;
  3155. $till = &DateToFloat (@Period {"till"}) ;
  3156. # $from =~ s/.*\///g ; # delete dd mm if present
  3157. # $till =~ s/.*\///g ;
  3158. #proc areadef
  3159. $script .= "#proc areadef\n" ;
  3160. $script .= " #clone: A\n" ;
  3161. $script .= " " . @Axis {"time"} . "scaletype: linear\n" ; # date yyyy
  3162. if (@Axis {"order"} !~ /reverse/i)
  3163. { $script .= " " . @Axis {"time"} . "range: $from $till\n" ; }
  3164. else
  3165. { $script .= " " . @Axis {"time"} . "range: " . (-$till) . " " . (-$from) . "\n" ; }
  3166. $script .= "\n" ;
  3167. # }
  3168. $script .= "#proc " . @Axis {"time"} . "axis\n" ;
  3169. if (($scale eq "Major") && (! $grid))
  3170. {
  3171. # $script .= " stubs: incremental " . @Scales {"Major inc"} . " " . @Scales {"Major unit"} . "\n" ;
  3172. # if ($DateFormat =~ /\//)
  3173. # { $script .= " stubformat: " . @Axis {"format"} . "\n" ; }
  3174. # temp always show whole years (Ploticus autorange bug)
  3175. if (@Scales {"Major stubs"} eq "") # ($DateFormat !~ /\//)
  3176. { $script .= " stubs: incremental " . @Scales {"Major inc"} . "\n" ; }
  3177. else
  3178. { $script .= " stubs: list " . @Scales {"Major stubs"} . "\n" ; }
  3179. }
  3180. else
  3181. { $script .= " stubs: none\n" ; }
  3182. if ($DateFormat !~ /\//)
  3183. # { $script .= " ticincrement: " . @Scales {"$scale inc"} . " " . @Scales {"$scale unit"} . "\n" ; }
  3184. { $script .= " ticincrement: " . @Scales {"$scale inc"} . "\n" ; }
  3185. else
  3186. {
  3187. my $unit = 1 ;
  3188. if (@Scales {"$scale unit"} =~ /month/i)
  3189. { $unit = 1/12 ; }
  3190. if (@Scales {"$scale unit"} =~ /day/i)
  3191. { $unit = 1/365 ; }
  3192. $script .= " ticincrement: " . @Scales {"$scale inc"} . " $unit\n" ;
  3193. }
  3194. if (defined (@Scales {"$scale start"}))
  3195. {
  3196. $start = @Scales {"$scale start"} ;
  3197. # $start =~ s/.*\///g ; # delete dd mm if present
  3198. $start = &DateToFloat ($start) ;
  3199. if (@Axis {"order"} =~ /reverse/i)
  3200. {
  3201. $loop = 0 ;
  3202. $start = -$start ;
  3203. while ($start - @Scales {"$scale inc"} >= - @Period {"till"})
  3204. {
  3205. $start -= @Scales {"$scale inc"} ;
  3206. if (++$loop > 1000) { last ; } # precaution
  3207. }
  3208. }
  3209. $script .= " stubrange: $start\n" ;
  3210. }
  3211. if ($scale eq "Major")
  3212. {
  3213. $script .= " ticlen: 0.05\n" ;
  3214. if (@Axis {"time"} eq "y")
  3215. { $script .= " stubdetails: adjust=0.05,0\n" ; }
  3216. if (@Axis {"order"} =~ /reverse/i)
  3217. { $script .= " signreverse: yes\n" ; }
  3218. }
  3219. else
  3220. { $script .= " ticlen: 0.02\n" ; }
  3221. # $script .= " location: 4\n" ; test
  3222. $color .= @Scales {"$scale grid"} ;
  3223. if (defined (@Colors {$color}))
  3224. { $color = @Colors {$color} ; }
  3225. if ($grid)
  3226. { $script .= " grid: color=$color\n" ; }
  3227. $script .= "\n" ;
  3228. if ($grid) # restore areadef
  3229. {
  3230. #proc areadef
  3231. $script .= "#proc areadef\n" ;
  3232. $script .= " #clone: A\n" ;
  3233. $script .= "\n" ;
  3234. }
  3235. }
  3236. sub PlotLines
  3237. {
  3238. my $layer = shift ;
  3239. if ($#DrawLines < 0)
  3240. { return ; }
  3241. undef (@DrawLinesNow) ;
  3242. foreach $line (@DrawLines)
  3243. {
  3244. if ($line =~ /\|$layer\n/)
  3245. { push @DrawLinesNow, $line ; }
  3246. }
  3247. if ($#DrawLinesNow < 0)
  3248. { return ; }
  3249. foreach $entry (@DrawLinesNow)
  3250. {
  3251. chomp ($entry) ;
  3252. $script .= "#proc line\n" ;
  3253. # $script .= " notation: scaled\n" ;
  3254. if ($entry =~ /^[12]/)
  3255. { ($mode, $at, $from, $till, $color, $width) = split ('\|', $entry) ; }
  3256. else
  3257. { ($mode, $points, $color, $width) = split ('\|', $entry) ; }
  3258. $script .= " linedetails: width=$width color=$color style=0\n" ;
  3259. if ($mode == 1) # draw perpendicular to time axis
  3260. {
  3261. if (@Axis {"order"} =~ /reverse/i)
  3262. { $at = -$at ; }
  3263. if (@Axis {"time"} eq "x")
  3264. {
  3265. if ($from eq "")
  3266. { $from = @PlotArea {"bottom"} }
  3267. if ($till eq "")
  3268. { $till = @PlotArea {"bottom"} + @PlotArea {"height"} }
  3269. $from += ($width/200) ; # compensate for overstrechting of thick lines
  3270. $till -= ($width/200) ;
  3271. if ($from > @Image {"height"})
  3272. { $from = @Image {"height"} ; }
  3273. if ($till > @Image {"height"})
  3274. { $till = @Image {"height"} ; }
  3275. $script .= " points: $at(s) $from $at(s) $till\n" ;
  3276. }
  3277. else
  3278. {
  3279. if ($from eq "")
  3280. { $from = @PlotArea {"left"} }
  3281. if ($till eq "")
  3282. { $till = @PlotArea {"left"} + @PlotArea {"width"} }
  3283. $from += ($width/200) ;
  3284. $till -= ($width/200) ;
  3285. if ($from > @Image {"width"})
  3286. { $from = @Image {"width"} ; }
  3287. if ($till > @Image {"width"})
  3288. { $till = @Image {"width"} ; }
  3289. $script .= " points: $from $at(s) $till $at(s)\n" ;
  3290. }
  3291. }
  3292. if ($mode == 2) # draw parralel to time axis
  3293. {
  3294. if (@Axis {"order"} =~ /reverse/i)
  3295. {
  3296. $from = -$from ;
  3297. $till = -$till ;
  3298. }
  3299. $from .= "(s)+" .($width/200) ;
  3300. $till .= "(s)-" .($width/200) ;
  3301. if (@Axis {"time"} eq "x")
  3302. {
  3303. if ($at eq "")
  3304. { $at = @PlotArea {"bottom"} ; }
  3305. if ($at > @Image {"height"})
  3306. { $at = @Image {"height"} ; }
  3307. $script .= " points: $from $at $till $at\n" ;
  3308. }
  3309. else
  3310. {
  3311. if ($at eq "")
  3312. { $at = @PlotArea {"left"} ; }
  3313. if ($at > @Image {"width"})
  3314. { $at = @Image {"width"} ; }
  3315. $script .= " points: $at $from $at $till\n" ;
  3316. }
  3317. }
  3318. if ($mode == 3) # draw free line
  3319. {
  3320. @Points = split (",", $points) ;
  3321. foreach $point (@Points)
  3322. { $point = &Normalize ($point) ; }
  3323. if ((@Points [0] > @Image {"width"}) ||
  3324. (@Points [1] > @Image {"height"}) ||
  3325. (@Points [2] > @Image {"width"}) ||
  3326. (@Points [3] > @Image {"height"}))
  3327. { &Error2 ("Linedata attribute 'points' invalid.\n" .
  3328. sprintf ("(%d,%d)(%d,%d)", @Points[0]*100, @Points[1]*100, @Points[2]*100, @Points[3]*100) . " does not fit in image\n") ;
  3329. return ; }
  3330. $script .= " points: @Points[0] @Points[1] @Points[2] @Points[3]\n" ;
  3331. }
  3332. }
  3333. $script .= "\n" ;
  3334. }
  3335. sub ColorPredefined
  3336. {
  3337. my $color = shift ;
  3338. if ($color =~ /^(?:black|white|tan1|tan2|red|magenta|claret|coral|pink|orange|
  3339. redorange|lightorange|yellow|yellow2|dullyellow|yelloworange|
  3340. brightgreen|green|kelleygreen|teal|drabgreen|yellowgreen|
  3341. limegreen|brightblue|darkblue|blue|oceanblue|skyblue|
  3342. purple|lavender|lightpurple|powderblue|powderblue2)$/xi)
  3343. {
  3344. if (! defined (@Colors {lc ($color)}))
  3345. { &StoreColor ($color, $color, "", $command) ; }
  3346. return ($true) ;
  3347. }
  3348. else
  3349. { return ($false) ; }
  3350. }
  3351. sub ValidAbs
  3352. {
  3353. $value = shift ;
  3354. if ($value =~ /^ \d+ \.? \d* (?:px|in|cm)? $/xi)
  3355. { return ($true) ; }
  3356. else
  3357. { return ($false) ; }
  3358. }
  3359. sub ValidAbsRel
  3360. {
  3361. $value = shift ;
  3362. if ($value =~ /^ \d+ \.? \d* (?:px|in|cm|$hPerc)? $/xi)
  3363. { return ($true) ; }
  3364. else
  3365. { return ($false) ; }
  3366. }
  3367. sub ValidDateFormat
  3368. {
  3369. my $date = shift ;
  3370. my ($day, $month, $year) ;
  3371. # if ($date=~ /^\-?\d+$/) # for now full years are always allowed
  3372. # { return ($true) ; }
  3373. if ($DateFormat eq "yyyy")
  3374. {
  3375. if (! ($date=~ /^\-?\d+$/))
  3376. { return ($false) ; }
  3377. return ($true) ;
  3378. }
  3379. if ($DateFormat eq "x.y")
  3380. {
  3381. if (! ($date=~ /^\-?\d+(?:\.\d+)?$/))
  3382. { return ($false) ; }
  3383. return ($true) ;
  3384. }
  3385. if (! ($date=~ /^\d\d\/\d\d\/\d\d\d\d$/))
  3386. { return ($false) ; }
  3387. if ($DateFormat eq "dd/mm/yyyy")
  3388. {
  3389. $day = substr ($date,0,2) ;
  3390. $month = substr ($date,3,2) ;
  3391. $year = substr ($date,6,4) ;
  3392. }
  3393. else
  3394. {
  3395. $day = substr ($date,3,2) ;
  3396. $month = substr ($date,0,2) ;
  3397. $year = substr ($date,6,4) ;
  3398. }
  3399. if ($month =~ /^(?:01|03|05|07|08|10|12)$/)
  3400. { if ($day > 31) { return ($false) ; }}
  3401. elsif ($month =~ /^(?:04|06|09|11)$/)
  3402. { if ($day > 30) { return ($false) ; }}
  3403. elsif ($month =~ /^02$/)
  3404. {
  3405. if (($year % 4 == 0) && ($year % 100 != 0))
  3406. { if ($day > 29) { return ($false) ; }}
  3407. else
  3408. { if ($day > 28) { return ($false) ; }}
  3409. }
  3410. else { return ($false) ; }
  3411. return ($true) ;
  3412. }
  3413. sub ValidDateRange
  3414. {
  3415. my $date = shift ;
  3416. my ($day, $month, $year,
  3417. $dayf, $monthf, $yearf,
  3418. $dayt, $montht, $yeart) ;
  3419. my $from = @Period {"from"} ;
  3420. my $till = @Period {"till"} ;
  3421. if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y"))
  3422. {
  3423. if (($date < $from) || ($date > $till))
  3424. { return ($false) ; }
  3425. return ($true) ;
  3426. }
  3427. if ($DateFormat eq "dd/mm/yyyy")
  3428. {
  3429. $day = substr ($date,0,2) ;
  3430. $month = substr ($date,3,2) ;
  3431. $year = substr ($date,6,4) ;
  3432. $dayf = substr ($from,0,2) ;
  3433. $monthf = substr ($from,3,2) ;
  3434. $yearf = substr ($from,6,4) ;
  3435. $dayt = substr ($till,0,2) ;
  3436. $montht = substr ($till,3,2) ;
  3437. $yeart = substr ($till,6,4) ;
  3438. }
  3439. if ($DateFormat eq "mm/dd/yyyy")
  3440. {
  3441. $day = substr ($date,3,2) ;
  3442. $month = substr ($date,0,2) ;
  3443. $year = substr ($date,6,4) ;
  3444. $dayf = substr ($from,3,2) ;
  3445. $monthf = substr ($from,0,2) ;
  3446. $yearf = substr ($from,6,4) ;
  3447. $dayt = substr ($till,3,2) ;
  3448. $montht = substr ($till,0,2) ;
  3449. $yeart = substr ($till,6,4) ;
  3450. }
  3451. if (($year < $yearf) ||
  3452. (($year == $yearf) &&
  3453. (($month < $monthf) ||
  3454. (($month == $monthf) && ($day < $dayf))
  3455. )))
  3456. { return ($false) }
  3457. if (($year > $yeart) ||
  3458. (($year == $yeart) &&
  3459. (($month > $montht) ||
  3460. (($month == $montht) && ($day > $dayt))
  3461. )))
  3462. { return ($false) }
  3463. return ($true) ;
  3464. }
  3465. sub DateMedium
  3466. {
  3467. my $from = shift ;
  3468. my $till = shift ;
  3469. if (($DateFormat eq "yyyy") || ($DateFormat eq "x.y"))
  3470. { return (sprintf ("%.3f", ($from + $till) / 2)) ; }
  3471. $from2 = &DaysFrom1800 ($from) ;
  3472. $till2 = &DaysFrom1800 ($till) ;
  3473. my $date = &DateFrom1800 (int (($from2 + $till2) / 2)) ;
  3474. return ($date) ;
  3475. }
  3476. sub DaysFrom1800
  3477. {
  3478. @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) ;
  3479. my $date = shift ;
  3480. if ($DateFormat eq "dd/mm/yyyy")
  3481. {
  3482. $day = substr ($date,0,2) ;
  3483. $month = substr ($date,3,2) ;
  3484. $year = substr ($date,6,4) ;
  3485. }
  3486. else
  3487. {
  3488. $day = substr ($date,3,2) ;
  3489. $month = substr ($date,0,2) ;
  3490. $year = substr ($date,6,4) ;
  3491. }
  3492. if ($year < 1800)
  3493. { &Error2 ("Function 'DaysFrom1800' expects year >= 1800, not '$year'.") ; return ; }
  3494. $days = ($year - 1800) * 365 ;
  3495. $days += int (($year -1 - 1800) / 4) ;
  3496. $days -= int (($year -1 - 1800) / 100) ;
  3497. if ($month > 1)
  3498. {
  3499. for ($m = $month - 2 ; $m >= 0 ; $m--)
  3500. {
  3501. $days += @mmm [$m] ;
  3502. if ($m == 1)
  3503. {
  3504. if ((($year % 4) == 0) && (($year % 100) != 0))
  3505. { $days ++ ; }
  3506. }
  3507. }
  3508. }
  3509. $days += $day ;
  3510. return ($days) ;
  3511. }
  3512. sub DateToFloat
  3513. {
  3514. my $date = shift ;
  3515. if ($DateFormat !~ /\//)
  3516. { return ($date) ; }
  3517. my $year = $date ;
  3518. $year =~ s/.*\///g ; # delete dd mm/mm dd
  3519. my $fraction = (&DaysFrom1800 ($date) - &DaysFrom1800 ("01/01/" . $year)) / 365.25 ;
  3520. return ($year + $fraction) ;
  3521. }
  3522. sub DateFrom1800
  3523. {
  3524. my $days = shift ;
  3525. @mmm = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) ;
  3526. $year = 1800 ;
  3527. while ($days > 365 + (($year % 4) == 0))
  3528. {
  3529. if ((($year % 4) == 0) && (($year % 100) != 0))
  3530. { $days -= 366 ; }
  3531. else
  3532. { $days -= 365 ; }
  3533. $year ++ ;
  3534. }
  3535. $month = 0 ;
  3536. while ($days > @mmm [$month])
  3537. {
  3538. $days -= @mmm [$month] ;
  3539. if ($month == 1)
  3540. {
  3541. if ((($year % 4) == 0) && (($year % 100) != 0))
  3542. { $days -- ; } ;
  3543. }
  3544. $month++ ;
  3545. }
  3546. $day = $days ;
  3547. $month ++ ;
  3548. if ($DateFormat eq "dd/mm/yyyy")
  3549. { $date = sprintf ("%02d/%02d/%04d", $day, $month, $year) ; }
  3550. else
  3551. { $date = sprintf ("%02d/%02d/%04d", $month, $day, $year) ; }
  3552. return ($date) ;
  3553. }
  3554. sub ExtractText
  3555. {
  3556. my $data = shift ;
  3557. my $data2 = $data ;
  3558. my $text = "" ;
  3559. # special case: allow embedded spaces when 'text' is last attribute
  3560. # $data2 =~ s/\:\:/\@\#\!/g ;
  3561. if ($data2 =~ /text\:[^\:]+$/)
  3562. {
  3563. $text = $data2 ;
  3564. $text =~ s/^.*?text\:// ;
  3565. # $text =~ s/^\s(.*?)\s*$/$1/ ; ?? ->
  3566. $text =~ s/^(.*?)\s*$/$1/ ;
  3567. $text =~ s/\\n/\n/g ;
  3568. $text =~ s/\"\"/\@\#\$/g ;
  3569. $text =~ s/\"//g ;
  3570. $text =~ s/\@\#\$/"/g ;
  3571. $data2 =~ s/text\:.*$// ;
  3572. }
  3573. # extract text between double quotes
  3574. $data2 =~ s/\"\"/\@\#\$/g ;
  3575. if ($data2 =~ /text\:\s*\"/)
  3576. {
  3577. $text = $data2 ;
  3578. $text =~ s/^.*?text\:\s*\"// ;
  3579. if (! ($text =~ /\"/))
  3580. { &Error ("PlotData invalid. Attribute 'text': no closing \" found.") ;
  3581. return ("x", "x") ; }
  3582. $text =~ s/\".*$//;
  3583. $text =~ s/\@\#\$/"/g ;
  3584. $text =~ s/\\n/\n/g ;
  3585. }
  3586. $data2 =~ s/text\:\s*\"[^\"]*\"// ;
  3587. $data2 =~ s/\@\#\$/"/g ;
  3588. return ($data2, $text) ;
  3589. }
  3590. sub ParseText
  3591. {
  3592. my $text = shift ;
  3593. $text =~ s/\_\_/\@\#\$/g ;
  3594. $text =~ s/\_/ /g ;
  3595. $text =~ s/\@\#\$/_/g ;
  3596. $text =~ s/\~\~/\@\#\$/g ;
  3597. $text =~ s/\~/\\n/g ;
  3598. $text =~ s/\@\#\$/~/g ;
  3599. return ($text) ;
  3600. }
  3601. sub BarDefined
  3602. {
  3603. my $bar = shift ;
  3604. foreach $bar2 (@Bars)
  3605. {
  3606. if (lc ($bar2) eq lc ($bar))
  3607. { return ($true) ; }
  3608. }
  3609. # not part of barset ? return
  3610. if ($bar != /\#\d+$/)
  3611. { return ($false) ; }
  3612. # find previous bar in barset
  3613. my $barcnt = $bar ;
  3614. my $barid = $bar ;
  3615. $barcnt =~ s/.*\#(\d+$)/$1/ ;
  3616. $barid =~ s/(.*\#)\d+$/$1/ ;
  3617. $barcnt -- ;
  3618. $a = $#Bars ;
  3619. for (my $b = 0 ; $b <= $#Bars ; $b++)
  3620. {
  3621. if (lc (@Bars [$b]) eq lc ($barid . $barcnt))
  3622. {
  3623. $b++ ;
  3624. for (my $b2 = $#Bars + 1 ; $b2 > $b ; $b2--)
  3625. { @Bars [$b2] = @Bars [$b2-1]; }
  3626. @Bars [$b] = lc ($bar) ;
  3627. @BarLegend {lc ($bar)} = " " ;
  3628. return ($true) ;
  3629. }
  3630. }
  3631. return ($false) ;
  3632. }
  3633. sub ValidAttributes
  3634. {
  3635. my $command = shift ;
  3636. if ($command =~ /^BackgroundColors$/i)
  3637. { return (CheckAttributes ($command, "", "canvas,bars")) ; }
  3638. if ($command =~ /^BarData$/i)
  3639. # { return (CheckAttributes ($command, "", "bar,barset,barcount,link,text")) ; }
  3640. { return (CheckAttributes ($command, "", "bar,barset,link,text")) ; }
  3641. if ($command =~ /^Colors$/i)
  3642. { return (CheckAttributes ($command, "id,value", "legend")) ; }
  3643. if ($command =~ /^ImageSize$/i)
  3644. { return (CheckAttributes ($command, "", "width,height,barincrement")) ; }
  3645. if ($command =~ /^Legend$/i)
  3646. { return (CheckAttributes ($command, "", "columns,columnwidth,orientation,position,left,top")) ; }
  3647. if ($command =~ /^LineData$/i)
  3648. { return (CheckAttributes ($command, "", "at,from,till,atpos,frompos,tillpos,points,color,layer,width")) ; }
  3649. if ($command =~ /^Period$/i)
  3650. { return (CheckAttributes ($command, "from,till", "")) ; }
  3651. if ($command =~ /^PlotArea$/i)
  3652. { return (CheckAttributes ($command, "", "left,bottom,width,height,right,top")) ; }
  3653. if ($command =~ /^PlotData$/i)
  3654. { return (CheckAttributes ($command, "", "align,anchor,at,bar,barset,color,fontsize,from,link,mark,shift,text,textcolor,till,width")) ; }
  3655. if ($command =~ /^Scale/i)
  3656. { return (CheckAttributes ($command, "increment,start", "unit,grid,gridcolor,text")) ; }
  3657. if ($command =~ /^TextData$/i)
  3658. { return (CheckAttributes ($command, "", "fontsize,lineheight,link,pos,tabs,text,textcolor")) ; }
  3659. if ($command =~ /^TimeAxis$/i)
  3660. { return (CheckAttributes ($command, "", "orientation,format,order")) ; }
  3661. return ($true) ;
  3662. }
  3663. sub CheckAttributes
  3664. {
  3665. my $name = shift ;
  3666. my @Required = split (",", shift) ;
  3667. my @Allowed = split (",", shift) ;
  3668. my $attribute ;
  3669. my %Attributes2 = %Attributes ;
  3670. $hint = "\nSyntax: '$name =" ;
  3671. foreach $attribute (@Required)
  3672. { $hint .= " $attribute:.." ; }
  3673. foreach $attribute (@Allowed)
  3674. { $hint .= " [$attribute:..]" ; }
  3675. $hint .= "'" ;
  3676. foreach $attribute (@Required)
  3677. {
  3678. if ((! defined (@Attributes {$attribute})) || (@Attributes {$attribute} eq ""))
  3679. { &Error ("$name definition incomplete. $hint") ;
  3680. undef (@Attributes) ; return ($false) ; }
  3681. delete (@Attributes2 {$attribute}) ;
  3682. }
  3683. foreach $attribute (@Allowed)
  3684. { delete (@Attributes2 {$attribute}) ; }
  3685. @AttrKeys = keys %Attributes2 ;
  3686. if ($#AttrKeys >= 0)
  3687. {
  3688. if (@AttrKeys [0] eq "single")
  3689. { &Error ("$name definition invalid. Specify all attributes as name:value pairs.") ; }
  3690. else
  3691. { &Error ("$name definition invalid. Invalid attribute '" . @AttrKeys [0] . "' found. $hint") ; }
  3692. undef (@Attributes) ; return ($false) ; }
  3693. return ($true) ;
  3694. }
  3695. sub CheckPreset
  3696. {
  3697. my $command = shift ;
  3698. my ($preset, $action, $attrname, $attrvalue) ;
  3699. my $newcommand = $true ;
  3700. my $addvalue = $true ;
  3701. if ($command =~ /^$prevcommand$/i)
  3702. { $newcommand = $false ; }
  3703. if ((! $newcommand) && ($command =~ /^(?:DrawLines|PlotData|TextData)$/i))
  3704. { $addvalue = $false ; }
  3705. $prevcommand = $command ;
  3706. foreach $preset (@PresetList)
  3707. {
  3708. if ($preset =~ /^$command\|/i)
  3709. {
  3710. ($command, $action, $attrname, $attrpreset) = split ('\|', $preset) ;
  3711. if ($attrname eq "")
  3712. { $attrname = "single" ; }
  3713. $attrvalue = @Attributes {$attrname} ;
  3714. if (($action eq "-") && ($attrvalue ne ""))
  3715. {
  3716. if ($attrname eq "single")
  3717. { &Error ("Chosen preset makes this command redundant.\n" .
  3718. " Please remove this command.") ; }
  3719. else
  3720. { &Error ("Chosen preset conflicts with '$attrname:...'.\n" .
  3721. " Please remove this attribute.") ; }
  3722. @Attributes {$attrname} = "" ;
  3723. }
  3724. if (($action eq "+") && ($attrvalue eq ""))
  3725. {
  3726. if ($addvalue)
  3727. { @Attributes {$attrname} = $attrpreset ; }
  3728. }
  3729. if (($action eq "=") && ($attrvalue eq ""))
  3730. { @Attributes {$attrname} = $attrpreset ; }
  3731. if (($action eq "=") && ($attrvalue ne "") &&
  3732. ($attrvalue !~ /$attrpreset/i))
  3733. {
  3734. if ($attrname eq "single")
  3735. { &Error ("Conflicting settings.\nPreset defines '$attrpreset'.") ; }
  3736. else
  3737. { &Error ("Conflicting settings.\nPreset defines '$attrname:$attrpreset'.") ; }
  3738. @Attributes {$attrname} = $attrpreset ;
  3739. }
  3740. }
  3741. }
  3742. }
  3743. sub ShiftOnePixelForSVG
  3744. {
  3745. my $line = shift ;
  3746. $line =~ s/location:\s*// ;
  3747. my ($posx, $posy) = split (" ", $line) ;
  3748. if ($posy =~ /\+/)
  3749. { ($posy1, $posy2) = split ('\+', $posy) ; }
  3750. elsif ($posy =~ /.+\-/)
  3751. {
  3752. if ($posy =~ /^\-/)
  3753. {
  3754. ($sign, $posy1, $posy2) = split ('\-', $posy) ; $posy2 = - $posy2 ;
  3755. $posy1 = "-" . $posy1 ;
  3756. }
  3757. else
  3758. { ($posy1, $posy2) = split ('\-', $posy) ; $posy2 = - $posy2 }
  3759. }
  3760. else
  3761. { $posy1 = $posy ; $posy2 = 0 ; }
  3762. if ($posy1 !~ /(s)/)
  3763. { $posy += 0.01 ; }
  3764. else
  3765. {
  3766. $posy2 += 0.01 ;
  3767. if ($posy2 == 0)
  3768. { $posy = $posy1 ; }
  3769. elsif ($posy2 < 0)
  3770. { $posy = $posy1 . "$posy2" ; }
  3771. else
  3772. { $posy = $posy1 . "+" . $posy2 ; }
  3773. }
  3774. $line = "\n location: $posx $posy" ;
  3775. return ($line) ;
  3776. }
  3777. sub NormalizeURL
  3778. {
  3779. my $url = shift ;
  3780. $url =~ s/(https?)\:?\/?\/?/$1:\/\// ; # add possibly missing special characters
  3781. $url =~ s/ /%20/g ;
  3782. return ($url) ;
  3783. }
  3784. # wiki style link may include linebreak characters -> split into several wiki links
  3785. sub NormalizeWikiLink
  3786. {
  3787. my $text = shift ;
  3788. my $brdouble = $false ;
  3789. if ($text =~ /\[\[.*\]\]/)
  3790. { $brdouble = $true ; }
  3791. $text =~ s/\[\[?// ;
  3792. $text =~ s/\]?\]// ;
  3793. my ($hide,$show) = split ('\|', $text) ;
  3794. if ($show eq "")
  3795. { $show = $hide ; }
  3796. $hide =~ s/\s*\n\s*/ /g ;
  3797. my @Show = split ("\n", $show) ;
  3798. $text = "" ;
  3799. foreach $part (@Show)
  3800. {
  3801. if ($brdouble)
  3802. { $part = "[[" . $hide . "|" . $part . "]]" ; }
  3803. else
  3804. { $part = "[" . $hide . "|" . $part . "]" ; }
  3805. }
  3806. $text = join ("\n", @Show) ;
  3807. return ($text) ;
  3808. }
  3809. sub ProcessWikiLink
  3810. {
  3811. my $text = shift ;
  3812. my $link = shift ;
  3813. my $hint = shift ;
  3814. my $wikilink = $false ;
  3815. chomp ($text) ;
  3816. chomp ($link) ;
  3817. chomp ($hint) ;
  3818. my ($wiki, $title) ;
  3819. if ($link ne "") # ignore wiki brackets in text when explicit link is specified
  3820. {
  3821. $text =~ s/\[\[ [^\|]+ \| (.*) \]\]/$1/gx ;
  3822. $text =~ s/\[\[ [^\:]+ \: (.*) \]\]/$1/gx ;
  3823. # $text =~ s/\[\[ (.*) \]\]/$1/gx ;
  3824. }
  3825. else
  3826. {
  3827. if ($text =~ /\[.+\]/) # keep first link in text segment, remove others
  3828. {
  3829. $link = $text ;
  3830. $link =~ s/\n//g ;
  3831. $link =~ s/^[^\[\]]*\[/[/x ;
  3832. if ($link =~ /^\[\[/)
  3833. { $wikilink = $true ; }
  3834. $link =~ s/^ [^\[]* \[+ ([^\[\]]*) \].*$/$1/x ;
  3835. $link =~ s/\|.*$// ;
  3836. if ($wikilink)
  3837. { $link = "[[" . $link . "]]" ; }
  3838. $text =~ s/(\[+) [^\|\]]+ \| ([^\]]*) (\]+)/$1$2$3/gx ;
  3839. $text =~ s/(https?)\:/$1colon/gx ;
  3840. # $text =~ s/(\[+) [^\:\]]+ \: ([^\]]*) (\]+)/$1$2$3/gx ; #???
  3841. # remove interwiki link prefix
  3842. $text =~ s/(\[+) (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: ([^\]]*) (\]+)/$1$2$3/gxi ; #???
  3843. $text =~ s/\[+ ([^\]]+) \]+/{{{$1}}}/x ;
  3844. $text =~ s/\[+ ([^\]]+) \]+/$1/gx ;
  3845. $text =~ s/\{\{\{ ([^\}]*) \}\}\}/[[$1]]/x ;
  3846. }
  3847. # if ($text =~ /\[\[.+\]\]/)
  3848. # {
  3849. # $wikilink = $true ;
  3850. # $link = $text ;
  3851. # $link =~ s/\n//g ;
  3852. # $link =~ s/^.*?\[\[/[[/x ;
  3853. # $link =~ s/\| .*? \]\].*$/]]/x ;
  3854. # $link =~ s/\]\].*$/]]/x ;
  3855. # $text =~ s/\[\[ [^\|\]]+ \| (.*?) \]\]/[[$1]]/x ;
  3856. # $text =~ s/\[\[ [^\:\]]+ \: (.*?) \]\]/[[$1]]/x ;
  3857. # # remove remaining links
  3858. # $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ;
  3859. # $text =~ s/\[+ ([^\]]+) \]+/$1/gx ;
  3860. # $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ;
  3861. # }
  3862. # elsif ($text =~ /\[.+\]/)
  3863. # {
  3864. # $link = $text ;
  3865. # $link =~ s/\n//g ;
  3866. # $link =~ s/^.*?\[/[/x ;
  3867. # $link =~ s/\| .*? \].*$/]/x ;
  3868. # $link =~ s/\].*$/]/x ;
  3869. # $link =~ s/\[ ([^\]]+) \]/$1/x ;
  3870. # $text =~ s/\[ [^\|\]]+ \| (.*?) \]/[[$1]]/x ;
  3871. # # remove remaining links
  3872. # $text =~ s/\[\[ ([^\]]+) \]\]/^%#$1#%^/x ;
  3873. # $text =~ s/\[+ ([^\]]+) \]+/$1/gx ;
  3874. # $text =~ s/\^$hPerc\# (.*?) \#$hPerc\^/[[$1]]/x ;
  3875. ## $text =~ s/\[\[ (.*) \]\]/$1/gx ;
  3876. # }
  3877. }
  3878. if ($wikilink)
  3879. {
  3880. # if ($link =~ /^\[\[.+\:.+\]\]$/) # has a colon in its name
  3881. if ($link =~ /^\[\[ (?:.{2,3}|(?:zh\-.*)|simple|minnan|tokipona) \: .+\]\]$/xi) # has a interwiki link prefix
  3882. {
  3883. # This will fail for all interwiki links other than Wikipedia.
  3884. $wiki = lc ($link) ;
  3885. $title = $link ;
  3886. $wiki =~ s/\[\[([^\:]+)\:.*$/$1/x ;
  3887. $title =~ s/^[^\:]+\:(.*)\]\]$/$1/x ;
  3888. $title =~ s/ /_/g ;
  3889. $link = "http://$wiki.wikipedia.org/wiki/$title" ;
  3890. $link = &EncodeURL ($title) ;
  3891. if (($hint eq "") && ($title ne ""))
  3892. { $hint = "$wiki: $title" ; }
  3893. }
  3894. else
  3895. {
  3896. # $wiki = "en" ;
  3897. $title = $link ;
  3898. $title =~ s/^\[\[(.*)\]\]$/$1/x ;
  3899. $title =~ s/ /_/g ;
  3900. $link = $articlepath ;
  3901. $urlpart = &EncodeURL ($title) ;
  3902. $link =~ s/\$1/$urlpart/ ;
  3903. if (($hint eq "") && ($title ne ""))
  3904. { $hint = "$title" ; }
  3905. }
  3906. $hint =~ s/_/ /g ;
  3907. }
  3908. else
  3909. {
  3910. if ($link ne "")
  3911. { $hint = &ExternalLinkToHint ($link) ; }
  3912. }
  3913. if (($link ne "") && ($text !~ /\[\[/) && ($text !~ /\]\]/))
  3914. { $text = "[[" . $text . "]]" ; }
  3915. $hint = &EncodeHtml ($hint) ;
  3916. return ($text, $link, $hint) ;
  3917. }
  3918. sub ExternalLinkToHint
  3919. {
  3920. my $hint = shift ;
  3921. $hint =~ s/^https?\:?\/?\/?// ;
  3922. $hint =~ s/\/.*$// ;
  3923. return (&EncodeHtml ($hint . "/..")) ;
  3924. }
  3925. sub EncodeInput
  3926. {
  3927. my $text = shift ;
  3928. # revert encoding of '<' & '>' by MediaWiki
  3929. $text =~ s/\&lt\;/\</g ;
  3930. $text =~ s/\&gt\;/\>/g ;
  3931. $text =~ s/([\`\{\}\%\&\@\$\(\)\;\=])/"%" . sprintf ("%X", ord($1)) . "%";/ge ;
  3932. return ($text) ;
  3933. }
  3934. sub DecodeInput
  3935. {
  3936. my $text = shift ;
  3937. $text =~ s/\%([0-9A-F]{2})\%/chr(hex($1))/ge ;
  3938. return ($text) ;
  3939. }
  3940. sub EncodeHtml
  3941. {
  3942. my $text = shift ;
  3943. $text =~ s/([\<\>\&\'\"])/"\&\#" . ord($1) . "\;"/ge ;
  3944. $text =~ s/\n/<br>/g ;
  3945. return ($text) ;
  3946. }
  3947. sub EncodeURL
  3948. {
  3949. my $url = shift ;
  3950. # For some reason everything gets run through this weird internal
  3951. # encoding that's similar to URL-encoding. Armor against this as well,
  3952. # or else adjacent encoded bytes will be corrupted.
  3953. $url =~ s/([^0-9a-zA-Z\%\:\/\._])/"%25%".sprintf ("%02X",ord($1))/ge ;
  3954. return ($url) ;
  3955. }
  3956. sub Error
  3957. {
  3958. my $msg = &DecodeInput(shift) ;
  3959. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  3960. $CntErrors++ ;
  3961. if (! $listinput)
  3962. { push @Errors, "Line $LineNo: " . &DecodeInput($Line) . "\n" ; }
  3963. push @Errors, "- $msg\n\n" ;
  3964. if ($CntErrors > 10)
  3965. { &Abort ("More than 10 errors found") ; }
  3966. }
  3967. sub Error2
  3968. {
  3969. my $msg = &DecodeInput(shift) ;
  3970. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  3971. $CntErrors++ ;
  3972. push @Errors, "- $msg\n" ;
  3973. }
  3974. sub Warning
  3975. {
  3976. my $msg = &DecodeInput(shift) ;
  3977. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  3978. if (! $listinput)
  3979. { push @Warnings, "Line $LineNo: " . &DecodeInput ($Line) . "\n" ; }
  3980. push @Warnings, "- $msg\n\n" ;
  3981. }
  3982. sub Warning2
  3983. {
  3984. my $msg = &DecodeInput(shift) ;
  3985. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  3986. push @Warnings, "- $msg\n" ;
  3987. }
  3988. sub Info
  3989. {
  3990. my $msg = &DecodeInput(shift) ;
  3991. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  3992. if (! $listinput)
  3993. { push @Info, "Line $LineNo: " . &DecodeInput ($Line) . "\n" ; }
  3994. push @Info, "- $msg\n\n" ;
  3995. }
  3996. sub Info2
  3997. {
  3998. my $msg = &DecodeInput(shift) ;
  3999. $msg =~ s/\n\s*/\n /g ; # indent consecutive lines
  4000. push @Info, "- $msg\n" ;
  4001. }
  4002. sub Abort
  4003. {
  4004. my $msg = &DecodeInput(shift) ;
  4005. print "\n\n***** " . $msg . " *****\n\n" ;
  4006. print @Errors ;
  4007. print "Execution aborted.\n" ;
  4008. open "FILE_OUT", ">", $file_errors ;
  4009. print FILE_OUT "<p>EasyTimeline $version</p><p><b>Timeline generation failed: " . &EncodeHtml ($msg) ."</b></p>\n" ;
  4010. foreach $line (@Errors)
  4011. { print FILE_OUT &EncodeHtml ($line) . "\n" ; }
  4012. close "FILE_OUT" ;
  4013. if ($makehtml) # generate html test file, which would normally contain png + svg (+ image map)
  4014. {
  4015. open "FILE_IN", "<", $file_errors ;
  4016. open "FILE_OUT", ">", $file_html ;
  4017. print FILE_OUT "<html><head>\n<title>Graphical Timelines - HTML test file</title>\n</head>\n" .
  4018. "<body><h1><font color='green'>EasyTimeline</font> - Test Page</h1>\n\n" .
  4019. "<code>\n" ;
  4020. print FILE_OUT <FILE_IN> ;
  4021. print FILE_OUT "</code>\n\n</body>\n</html>" ;
  4022. close "FILE_IN" ;
  4023. close "FILE_OUT" ;
  4024. }
  4025. exit ;
  4026. }
  4027. sub EscapeShellArg
  4028. {
  4029. my $arg = shift;
  4030. if ($env eq "Linux") {
  4031. $arg =~ s/'/\\'/;
  4032. $arg = "'$arg'";
  4033. } else {
  4034. $arg =~ s/"/\\"/;
  4035. $arg = "\"$arg\"";
  4036. }
  4037. return $arg;
  4038. }
  4039. # vim: set sts=2 ts=2 sw=2 et :
  4040. sub UnicodeToAscii {
  4041. my $unicode = shift ;
  4042. my $char = substr ($unicode,0,1) ;
  4043. my $ord = ord ($char) ;
  4044. if ($ord < 128) # plain ascii character
  4045. { return ($unicode) ; } # (will not occur in this script)
  4046. else
  4047. {
  4048. # for completeness sake complete routine, only 2 byte unicodes sent here
  4049. if ($ord >= 252)
  4050. { $value = $ord - 252 ; }
  4051. elsif ($ord >= 248)
  4052. { $value = $ord - 248 ; }
  4053. elsif ($ord >= 240)
  4054. { $value = $ord - 240 ; }
  4055. elsif ($ord >= 224)
  4056. { $value = $ord - 224 ; }
  4057. else
  4058. { $value = $ord - 192 ; }
  4059. for ($c = 1 ; $c < length ($unicode) ; $c++)
  4060. { $value = $value * 64 + ord (substr ($unicode, $c,1)) - 128 ; }
  4061. # $html = "\&\#" . $value . ";" ; any unicode can be specified as html char
  4062. if (($value >= 128) && ($value <= 255))
  4063. { return (chr ($value)) ; }
  4064. else
  4065. { return "?" ; }
  4066. }
  4067. }