#!/usr/bin/perl -w

#
# ZLIB Perl Function Library
# Written by Zsolt Nagy-Perge, Pensacola, Fla. 2021
#
##################################################

use strict;
use warnings;

my $PAUSE = 0;       # Require user to press enter before script ends.

my $OS   = GetOS();
my @TIME;
my $X64  = is64bitOS();
my @TERM = GetConsoleSize();

my $B64  = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.$';
my $NUM  = '0123456789';
my @RND  = (1, 170, 125.92057732, 416.71870025, 193.23450510);
#UseTimer();

my $SEED     = 67;
##################################################
# DO NOT MODIFY ANY NUMBERS IN THIS LIST
# or it will break Str2Txt() and Txt2Str() functions:
my $RANDOM = '47696F3164497142674F626534726153486E43636B3875456D57554E54684D767C746C70463641373220392F782E7752664479507330334C35595E0A804B3B277E860D882D60897A584A295D243A237B847D2C8B8540268E82515A216A005B5C1B223E2881833F875F2A093D252B568C8A3C04A98D8F08A71D129593A3A29A0B989F1A0E9E1C1F160F9611170119079997A69B101505A09C7F0C1E90181406139DA59194AA0302A1A492A8BDB2E3C7B7D4DFC8ADD0ACCBCDC9D7D9CAC5BCD6B4CCB9BEE0DAB8D5C0BBB5E2C1CED1ABDED3BFDBB3CFAFD8BADCAEB0C3C4C2D2C6DDE1B6B1F7F6FFFCE9E8EEEDEFF4F3E4F5E5EAFAECF2F8F0E7FBFEEBE6FDF1F95D8CA6A572959E8E766A3B7F99428388938A799F9D94878B9C8D826085789A86295B614E4C6C563F634A696D52442D2B350328360C382527152A4D3E716B626655260712311724001005493D371E1B0933592F0F1C1A6E1948395A5E5F4B3A68450E0A13040B30081D015C142218110223060D3421161F2E2C32474F205140983C64586550544167434670536F7457759BA2A97BA37A8990808F7E9297A0848196A77D7CA8A19177AA73A4CEB5B3D9D5DAE3ACD3BFC9E2AFC5C1D7C8BDABC2D1C7CBDDDBDCBCDFAEB2B8BBB6C0B7CCD4B4CDDED0B0C6BEB9D6BAC4D2D8E0CFB1C3E1CAADEFF1FCF8E9E8F2FBF4EBEAECF7FEF5EEEDF0E5E4F6FFF3F9E7FDFAE6000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000263706110C0F3102072500000000000000130E3C1D011A031C050A2F172B142718152100293A302D0820320000000000001028193D0D16342E380B3912232C2A1F332236041B0924353B1E0000000000534537477449323858764A6A3465423561336C414E51664C5063467548447A705952726D7739304F62546F4D6E57684B56365A7167787331696B55794364';
my $TX = pack('H*', $RANDOM);

# The following string contains 78000 prime numbers from 1 to 1 million.
# Since prime numbers are very frequent, we can easily encode the
# difference between two consecutive primes in one byte, and
# that way we store one number per byte.
my $PDIFF = '001131313515313551531535731313=351915535519131;;31351955515319=313=591357553573791915357313;73735;1A59551595515531;913551;357979755375373=9;191319=313=313C3797355=35575;35191591915A31355755E1979557;35515;9A13515313;15Q557A9=31357315;913135;;7;5357373=35135159C531G319;197555A531;9;7?=531319;55A1?1E57531375919=95;1319;1?153197AG357?137?137553;1E51535=531535;55=35;753IA973515E;1?73;=9137553135731591973=9;1531?=35753A795579;=3551K1973=37;5;35C91?I31;53;5737E131;K1555351;3;191?1?5C?73131E7;591351591;919=535755?;13=5379755E519=35A19=319=37A351351;3CE;135515E15?5;15;?135=31AG951919195191957M919759A5;;1A5355A19=5313G1;5?755A?13515595;;A153A7G31351;3=M95;=59;13575913=5535191?;7A35;1555K5=3797;A313G;51?55=9=3M5557531;5315E513A13;153I55379O?1531319=53795C315M3795575;351535191?5C3;=K5C3A7535=55919;79197;9G137537A955159;195557595155597G5E1A379M7A3195153A7;A?51;5919159=3G1?1919C3137?551;?735M1915355753;57;3=;9G5;51E7A95=31597535M=91;91?1AGA5?A51A35197955735191;3551;3=A35C375373=53=;31M3G55;;=5313A5;753;1;M?15E=59;5137955G=537;A919135C53=313=5;G95791M351;3=5Q;75913C97?19=31;5?573735755;53557A3C3;19519;13C5M5379;51K1531?;1597G;5A53=53;75;35;5;1?C319A73=315E5=559519131E1355;5=9;573S=;5351;5;?197E1;535A1;53;75;35;51;;3=5?5197A5Q1K1E519;1537E51973573;A;C355731?;1979135=;E7K13C313=9;1;?1K7E7355=37;553C3A1;535=A979O595515?51;5K197?5759GC9191;35C31;A91913C?I3753;57;;537E1?=95;;=53C3;5155?7E1K753C3;GC3791?1;;Q135;5575315G3C955=3551;59195C3I315E1G35135G5731Q57?;19195737;E5=3I31;9737;3=5?57355759;155?755;915A3555;A7597A3=5A979;15;;S3573513A;57553A131G355=M535;5C3737553M19;797G5;3=351K=?1;53C955579;=9=?=9=5?575?C915313;1915E513A797E19A=313A135791M3M191A3A5=913CS535=3C9=E51M;9A13=5EA1;53737591;A9=?=3551531K1K5135=3;=?=357535557373=?753;7?19735I59735;=M3=E7;35795=9519;;=55A957A351591975591A91;3579;=;37955C3=?=979;1A5;9;131;5373[31319;55=355575SA351;5553=E;1A95IG31313=3557?;1Y313G551A3=5KA=59;15;M5355=31G355I9A5755M3;;1?153;A153I;5;3GG;51;K735;1A5355C?155A9513755G?5795=E7?51;31E7AQ15A355797A53137?1;;5A355515;9C;A351?19=3M19;1G5?791;E51?C91;;A9;519159A1;5351GK13191?;7E153195C;97;5553A13;A1;531?;;=37A3;=553753C;9=31?1;M35GCG97;9;5;;57?=535SC9M;131K;=5E73A5=A3515QA1?5A1G315;5;975?;79=W5153;=31313759551555;5G9195;55=55cC591979;;153=?7;5E1975E1E579;;195;13=915A3;7A;55355=31;;35AA;1?;7A9I35755319C3573C91Q13G1;;951;M5;?;1EA;=91;;3135;1?A1W7?57913A797;3A1A913137K15E;5=A357559731A95CE75M313A5M137535;=Q=53153=315K13579191913M1;;9A;=91;595=;3=3A197379;AA75A?=559=351;;355;1?1;53=531;A3SA;;13137;3S5A1;95;G755?;1A9C915A31W51?137A9;519735;19A753C35S5195G5=?5A19C97535191;313795;A=;?75?7315AGA9;13=9555A;1KA=?;=G;E5197313=;535=313M51591ME135755?;;5731G;35755915;K=53;75;35=5;9557553137;3=A91?5C5973MS;7E;15;?551A3I37A9795=3CEA;7K;5575;G?=3=;59;C537A;A913C9=3519GA13C?=9=535C5951;5M975357W131;A35795AA1;?753551c=3C?135;15;;53=955=9=?75;37E51AE51A5?=95;1537A;?13=37;;M?7315E;79555=5A9;1913I3;73A79=?5579575;9C973;IA3;A5M575E;135519135515EA5A;7;59;1?1919A5C315E55A5=;?1553=;31A?S;5=K1;5;531?M7G5M91A35;7E15EA1919M1K5=?5C?153O31351;355;1535753C3O97?1E13575?=3A73C5;;59191;K;A1A979_1357919M1S5951A357?=?5=3C3519;15;553;153;57315A957;5E15;A3=53C5?737E7;55?;AM73135I3=GE51595=55;951;9;7AA957?557?C31919;5759C9AI35M1375;;A37E51;Q5A;51K=?=3=;3551S35C;G5E1?A;;A155535=31E7;5957;A;591E=553A5CE1;G3AA1E13;7;9=31A?U555;95;7535=M597E57;91915919;AC537E55M5=5;;5919M1?7315A3153I3759135735M;1553CE7313w737E13=913C59A5C?5753C;E131;9A1E5AM19=97?a5979;5A1E51357559A1E1?=951;9C3=53S135;13=;535153C9195;1G;;553G13G15357?519;=5Q5=531ME735731K153IAE15?51?;1;355=957;3A197?55M19A19737;GW1;95;1;3135A=;53=M379759A73=?5735191;3135735OG97A915913A5;1?1E557A3A;753C5ME;15A3m31;591;;K13=E51559=319579=951;EA79A;1;3;1915A55Q51;35AA1?55759A797913AI;E131E55=?5C9;1AY3G159;159735;;735;MC5G59;19C553;=9A;75;3=91;M?1;53135I3A135=e5c1?55;I315E51;;59A1;;9A;575957313CG559=91E5=9I3A7;;9;57?5755E19C95[A59135=3I31;9737;3;7E759A5575;37A9;5;1531?;;=9=59;1;5351;3I5A5951A973I9C5?C;9791?5C9C3M137?1A3159A;=A5?C537535;791;531591?;=9575K15AMQ1?;1A?5797979[553C313=K75?=M5M3=95573A;51E;75;3=3513AC5?U?1351WY=351G951A9;1?15?573195791A?7;A;5;955A;=319C5;5?I3A13O975355=5A31A9797913519Y7;35A1?7319=;9C379U3519C9;5;I;37K737G5975?;79;7E51915955753=K7?A735C3A51GG55;;31E1957;3CA53;G55e753IS313I;;3557;91;?A575;A91e319M;737?=;535;513=;3=5G559;;CA55?735C3O3=915;?135;1975319=55;AQ795G519;1M9=;;?551A35M=3551535=5379;5O97E195G73M51;?75357?=55319;1?=313CA9195;M7A;91553;;13;AG1957?75;9=5;5531G35753135=379GG;15;EM15A955731597957?5=53G791;53S1E575975;9=95A;1;3I9=?A7A;;5?=G9;7E519k5137?=95G5;AG1M31;5913=5?197EC53O5A313137c=E1EC979153=35C351;;5;?1;97351K;79;13=K7531351;i5=915KO3M7535;;1355=?7M3197535I3;19A;;A13;7;9C37?;75?79;=537;3C5W7?5S15351EA195S=;3A73=919731A?;=9=55Y955C97;3;A19=A9A753=59M=553;U31357;95A5a535;79O5E19;A153M755A913;C97G915E51A9;1MA;K1535=5;973;I975?19A=535=?153;C3C35;1S35191E759;;A=GS3CG951K5A7357531;KA=?=A9753557E;19A51A91;9AO53557559C5;979=59=31EA1913C31Q1;5919A5=;;E75?573;573S55CG5;A919I5?753GA7;;9A;1G3;A;=913G;=951535I3551E7A3A73G1;;31c1A535;15;9731G9191;5AW5C?1;59;135=;;E5731?A;15?5153;M7?1A9G15G31E1?15;3A73=3AG515919U59=55G31;?=?;159I31;53;7;9A5=K15913=Q15E19=31?795797351?55AM=53M19=3C9737A3=53G55AA1S59=;351M5315KC3C;G?A;=53;O;59795A1?=5E5;1A37M;3;19UE13=5;G313=;91?5C3CE;131;EG55153519;;515?753A;;=3;575A59;=537E51KA1A95=919=591E575?;7E13=A;5G591;EA5C59=315;E=;357E19;7W15973YC3O;95;;1975373IA37K5A5;1955=9;=G53CE1A35;1?A=55357A3=M3A79137;3;A1;91?73M15K191A9=3I5A3C537A3;IG3CE1AE13;155535=3G;5A1;K=357E5;A73C5351A53;;7K5791G;9G79C;5;;3=;GQA795A737?=535G15351?55CG313=3A15;3=31A?551?C55M375G?557;M3AA73I91E79=53A7;K153;5G579C?7M55319=59OEA13137E7A;K1?;A=9A;5O9=591915E135795=53;MG55753135755EA731A531?AC955M1;K5551;97AA37A91K19=31M;EI97597?=559=5319;1597319IE51;A3I3795=91A59C553G1375?=?A13;1915;955C535U35;=3;79;;735=95;19A1A9791;3=K1?1A5957?=M9C59G1K1;?57S373=;97;35735=E753195C9755EA1?5C3I3=E=3;57355I91AA31?1A35735;155KU37?I319;19759;191G3MI55A55E19AI3A755;?57?57?1Yi735137?5C3;;5;1915E195759=553A797?=9191;53C97c795197955791E135=31G;3IA35=M5351E7351E57?5=35A7;5;GM?7Q7E5=9A=3;73S551913C559;51W75K51;A3G=559C9=?=?57S3;;5;a;5355759191A9=?753C3195=A9U9A191;313=597W5C3;75Q7E7;91?Y;7E7E75Q153=5?1E57GE51;35=37G3551EC53=355759575?=55E5GO5A5A97MA5?;5;153;75E753=9AC91531KA19555=WG137;3C3OA?5S7535=35I59=A955=955=5G3=E7;97;A9A7G973G5A519M19131W1K755A59=3AMA1;M5M3A;13=595759;15;91A3C35=55E557AA9191535;A1973A15559795A;7;535=?1;35U55?CKC955=3I3=9A=K13=?1K575Q73A1?75W7A3M5;1M59=W=91;973755K13;=?7M?A19A5O3A51;9A159=AK57?13C97A919735;5C3153C9IA91A5?=3I3=9;=553=91MAE1?13755?15;97;3=35C9;1553191M?;CA35137?=AE51E55A19S735C3;5=31KG735;MAOE7S53;1;35C9AA753G79=537;?1?57?;=9M=3;7;591;K5;;C919=55M37;319=3IA;9573;5GA791;3;;51E131;?=91?AO35CE7919513=5G3735;;759;7919;5;;CKC9=979513=55;5;9=9=?79I3153=35;75MA;5;?;;1K5=9S1357;EA1MAECA9U531G355195=973G=?=E5C9=3;;1?755A35=E51Y?19513579C?M79791M55S97?51;K135A;57913a3C3M735;1G37A53579131WASMM7?=5;K1E13;M;513=91AE;A19AO53159C;95;C;531?1?5=31?15?5737EA7;375GE51;M59;51E51;5E7;E195A;15;A53CE7;G?=9MA153=91;9;51?;15;91951;;?C9;7M9=35753CAG3;731G5G913515553G19;159759A153CG9;1;5G3S=?7E57315EC?;A1;?55;5;15;97?75?7;355C;;35C3;1915ME513U9131E1?159C5G3;=;3U9M51;;35M=37AS35C31;9159;5;755G3MC5S91;53753;75;35=3C;35A13A1?;M557W7_5?A=;5A3C91597M3;C5;55Q55A579;57913G57E51;59;5G5=;S3G19795=9O379;IA35C3C5?51M;59159;73159;IE753=55M35=31K15E73AAA1;53C955=9;1;MQ;753191?;197AG53;=373=355C537Ac13;73U3IG?;51;;?1553;=?7;A?5795=9;1913G5YG795551;3=55K519;;5C35=31;9;G57553G;C?=MA53I;351531K7W1973C5A913[5A;5351E5=M9G197?A1AE7955=37A31AAA53GA1?55AC?C3=53CA9159G19G55G5;1K;=55;5E;;7S3;=3C9;G135;1319;I5?737975Q1;?G5191A375?515553=3C53C5;E519;1537;3=;9=3;I9=3I5M3AA75?79=979CEC?1A5355;19I37AA5A535G5CQI91K;79;15E1;?1559=?C53U5957?Y153555=?=3C9137A9;S19Y73CG?7E57315E557K19A=53A79=3;79;=31;;35AM;U5;91A9;737531G;A3131i;7G91355;13=55?;13O3G55791EA;C5M3M513=53=?1;915;;957E7;;5?5ACEA1E1?1E=9C9O37951E5;15313=;G91;?135=59;1?=Q;15553C9I;;31379131E55=3A;I597?13C95Y1957G;535;1K7;AA5]795=31535Y79791A35;;13C9;;73IAE75?=?1A91559=31M3137951;?5g91;97;53=913753C5;E5O919;=5KS551;3557E1A9153C9735=A5YE131K13A555;1G9S51;9IGA?55=G;375;37?CWI3;15319=913I;K1?I59159575559;5CWC31?;5;73A1;9I;?1AG;3=EC9=;3A;79;5M=3G5M5515EO5355C?197;91597?S7531K1K;195=9555753=A35;19A7MW1A35=A53;5;5=9I5?1?M191Y5K=591;A;59;;C53195;;=;Q51;95753;U59A1K15;M?19731?AI357AE5C35;15;3A51E;75?AM;G1915535S=5E1i7;591W75K13=55A973=37M35755A313=;A913;1979=9A;759=97E15E;57;K1_;3A79=9=3;MG57537e319;79;;A1G37E;C3;1;?1K15G91K13C3;5=35=EGC3=559M79A155?15531G31G951915E73753A1A37?I357EC?735G5=;?1;3=913;AO9=G;W7Q;=3A1K;C591WA=;3S51E5=9GY1?1Q75313=W7;5GA35153131G97559=5?A=AG35573C95;1;3=5553=?S=53=35G73C9=;Q79555=3=;59A=9;5155K13G5137?5C319197o57;3=;91;59AG51975?C3=55;535137E5731?A=5E=9=3513=9;7?797GW5;15A313M1M37A;;313=S?A1;95;A1A55EAU59A1975?G=535=?G5;7;9=]1?1E51919153C95M7553M7555ES137553=;9C313M5=?;M1357M97QA;7EC3=9C5319=3I5S;A375351K55G79I5G37G9C319=?155357AK=5?=53557313;1;5;K15;9=3[591;;M3;159;19195795=?75;9197;9A7313I5E5=951K57]55A55759A15;A97;M919135A13C;357Q55G;7S?153135C5G313AC5E7]A1?CE1GE1?GC?137919=37A373=91G?75?C9153M1?O5;9G7;A?1;53;51KA1E55515?=5M?1913;1;9=597K1S5?=3CG5373A73=351G?=3I?19O535;5S7;313753C;9G;1;95;15A35557G59;M=97;59;1A5373GC379;7;?5=373Aa5535759I9519195U;379C555A91;?1;;3I95CAW;79;1A;919I35;73M515?GGA;;75379753C9I3G51;YA53I5K5197559791E13C35S=3CE5=597313=AQ7E=9G519159IA9AGA1GW135159I5;;53S19;G1379513G13S1E=GAY591G?;13191973S73;A55=E15G59GCE5=SK575G5;K1A313CE791A379=95755;?;=9A19GG5;1E5CE13;15S5E51K;A13=53191?19759A;5=35A;I35=59;1319G79O97951A;KM1A35=537E7MA9I31E73753I3;CA5;9A1351;K5C5?75535C;53C5?5O9A1;?G57;Q5CE1?=53=5GM37;5?C9=31?;1975M;9=979513=919OA37KC3C53M75EA;19;5A5e5=355=G5;9;5G;A7A3131E791;9=531;]55155M975;3=5?;79CA955;19=313G;7A37?=;9A;7A3=351EA79I31G535;I379A5=9;1;537;?1951E13=A9;C9513=;37915Q51?;7E7M91G3=9C?13C957373G5=3O35=531Ek15G3=A;A;53M1?1E=?A5S5A197315GAM55Q=5c1?;=?7M3159;1K5=;KAC3755357E5G75;;5;3C]A=91G31GE=95O;319191355;;=55K1A553G1;;53GG153U59;1;3CE;195AY;15;E=95519A=3I?;7A319753555=?1;59;1G3A1A9;C5?=55;?;C375QI9M5G5I;?19;1957Y3753A15559735M;AG73579137?5U555M3=5979I5A951_;Q7;?75?=9=355=?5;1e?5;15QA51A531GA;31;553;19A7535A5=595791Q=M531_K159;7315;;53A5;7315E13=EM51535I3=?;731?=K;C3;15;91A3=Q;=37A?7A35M=?735Co73=5Q1eAA35;C5G?55=31E5=;3=S913=957?5C3=9C9A7319=3CA9A1A37EA73197559=?7?137Y3;A1E;7AA31Q13=;37;3=?[555KM1A;;97E153A5S573135=955=319153C9;G;=9G579;515;91K19AG=;A5979I53;735I9791?19I91A35C;357;91AE19[3C9U3=;9191319=975595A5AIM5?;735=S9OEU;3=97379C91?Ck;53AA1;91G59=531375955=5;53MMA1A3A5M551K=?1A973135573A7;W1;53U;5915?5U3C591G951M?5=35ISA373GC313;;;5U3;5;;=3;57MG91A?55197E513=9551EC5M35=3CE;M51A957979=9AA759=35137A9155G3519;1Q5IMEC5S?;1355;1AE=5G3a?1;?;7G;?AG73515;;?;A=5313;19;A153A557;313515313;C3=5]7W1;?13791QC?=E73;G1A9GM1G9IQ137A91?13=;9A5_735;;=955=5;;A91G5355GM=35I313=37M973A;79=K5M;O?5575e5A5?51;3G15919791EM573737?19A5=;G5;;KI5G3;51S35;CA535A19CA9;=;9CE15915355A1SE7M91K=9G579A7319A5C5?=Q57955515319=3;75;351;313791K1M?15EA=5Y9155A9A79;19U3=;35=S;97;95G;=53=9;7?G1319M=]A5A51A;;95Y155?75?A=E7;313C59;73G5=319AM7975M3G195=?1979;I;91E791?G=355e1375;91E75W1G?;15E15;53C559579;1E519I3159;5CE=3191Y35753C;QC?51AE15K135=3C]A73=;91;5G357ES=5E;5=?1;K73753A7E735M;1A;;A;A53135=3S5e5579;=31915E1K=537S535GG131;9U3IK19AY=9C?1555EC595C31;59191E=9;;19=;3=3791A;9M15G97919A5G51A91;55AS53=;59=9=M595C;AE;753;=3YM7K;55579C;3A5=95;1A37?19=3;O5553=3;75;979197313MC35551AE13=Y?;5;197WM73;7A37559515919GAA155?A575?7?55;51;?1;913GI9=95SG1e9=?5C;95;1;3I3=95135191?;AA=?1A5K1319;C;355CE13C?G1351Y53A5;7315A5G3AA191W19M7AE197?;M7559;51A3M79=357M59=A9A57E75?IE;57;9C9CA3;AO31A35;75597E;153=9C31K197A;5?759G5;7313CM3;=373C9GG;79;C53573C]C9G19575A9195=A?1K=5315K1351;3k13=;;5;3C?;1A59GO9I35=53=3A=59153195C3G5[919OK153;=;G9M75531;97Q=35;19;A7A;37A9=A;3;7?5;;AI91A;;W5C35;1979=35=35=559G;1;97YG91E5137A3U91537535C;A9C3;7EI;;3137?=S355=379UG;9=3;75315AG53OA91A9;M7;95=53753CY3;;51e9C5;5EY13=K1EC95A5IA91E51;95;153C9;C9I3CG5K55=E;7M375351K55755919;5159557?AI91A559753S79CE5AG;=5];15K55=?;197?1A?=3C95;153I;35;1A5;;55355C91K1;K73A7K135759GM1;5]5;13C3;5GC?19791913579;=;;E57?515YA53;;15Q=3513CK5=AE1?C35737E51979135=K513=E191KS;=3;755G9U;Q57?1A?573OA5?75;357;E5CG;?19;A;515;G3M55=319C91;?79;755G357?5I9M19153515G555MW=3C35;;1?=eM;375E1;AA37M91?=5EO979A1?I35753S579OA5351K19735;GAC9C59;1M?=531A;59;513=W19;M159A5515;9OAK19;O53G=5;3IM37595C3;=?1?=53;C5;?1ME7;;31375YA373759=5;97351;A91531e?A513G5AAA13753AGC5;A3=95573O3;=3=;K;79513C?159;1K73;=E73M;5CE1?;;=Q1?7;3A5;1559S;C91A;9C3YM=3;1;5Q5755A3513SG795=?557?=55A31Q551;5351K1?C5KA=35s5313;MM731?7G9;G;AM1;595=E731G3U97919=59A;;A;CE7;3;19C?=531AA9A13=E1;5A31?;1319A=EI;973515535=91;9I3A153;=G5;M;97K55;1?7W1Q=59=91G5;E5G=;3=95=9=;3I59753579;5=313=37A59791A9737535;=K13=K15Q1?1?55;1?7Q1K791A357]51;957315M_91K1;;35G575379C;E5GAA1;535=355=G535G57?;AM5=53I95=5W759=5K5=;G3AA13S1?5759I957Q;5;51E55I3=5?195;M153O5E73=;E1?;13C5?197G3=5M;351535;A;735=A3[37GM31E7;E5=535A5=E79[;Q;;A;19S79;1WI5A53153C53A51A53;=59A1G3579I9GA15;97Q1A?55;79755K=;A5G9;795=A3G1;5379[3;1W;C?735=59=59;=5;?C3;5;;AC53513C53C3[55?15M5975919C3=315K;19A1;5A?=351G31E13;C9U55QAC555E5=9I3A1A9;197?5575A537Q5;I59I3AC?191A9;S=;5357;3=35197919;M513C97A3A197S9=53A19C?;;79735M1;;K519=53A5575QIE7M;;9;A55C?OK7535575?19519U?G1;EG1;?19;I3I31G53O9=5351;k9M=31G3AACY35731A53U3GM=;5GA5955;153579=?13C?7;E1?79;;79=S;5957531W51KU5A53A=A5G91MSE1313MCA555;A973;A7M3G13=;;9A1?=K1E57553AAM73M79;5=5595;I;97S319A=9C559G1;955C5EA;;5U?=55Q57?5=3Y;C97A597973759=913=;31K;;1M35AA15?5;1M31;5E7;35OAA5K1?=31A3A1919A513=?5AGC;A5597A9GA51975G;9;15A95=;KS515;3CAE57E7E731AAG5A9G5;=3557Q1G3;7;G531EA1?I9579M1;;?A;1951G9C535;7;955G=5379M15G5?=G535=;G53;A=91?=5A;3A735755;?I53AUA;KC?7W195;O?7313=E515E=5ME1K7E5=5;37A9A;1;A;3=5;G5MA55G31E1A913C?A19G;G5155AE7531?73M5=955C31979;1915G951;9=?I915;A9;=979C53;5;513AAM155?1919791?GC31kE13;1A973C;G91E55C5919A=?1E79M;75955159GCAG3551531?7W;1E5=M313A55=37QG5=59A7;;31A35O9U9=EG19;5M5=E;15375;9M15;91?13=E15QMC;3551A;;G3135C59=Q13=E195I53AC55?79575;37;5A531E557?57559=;3S1;3;=3G51E;=315K1K1Q=9191E=319A;GS57595;79AC53=c=373=9135;1?1WA;15G3M1A5591?=9S55G=957A91;31375EA19M1555E737i7313;A5C3=Wg;91535I5A595;7K1;59557;A;919153G5IA3;A7W;A=53575eGM591E1?;513U53I?=3555159=?I31E1K1?=3C91;;97;5;A3=E75?CK57ECK1591E51EG1;97G35=5?A197?A7E135=M535U9;579CE;13OA?753C9159;CAE73=95U5313;=9C97;K7;?1A;91;59;5I357A357913795I35=37;;?191G31K…37EA19AC9737;5k91;;319U;9A579_1?MC31A9AU;37A379A;5137;3;75?O?1A597];1;K1G37K55A;153CE5A57E=37A35191;355;131;;3=5E1;MA?13GC55G53C?197_919A19Y;57E1E5=9753I9;735G1AW7357;AG5S?;1AK;7A319A7G9I;95137E=;9=5WA;79=;35795=53;=95SO?19195=;W5=3=K=3=AE;C35S=5A?5U3519;159=35e5A7A91;K=3=95C553A73AA1;951AK551S319=35=?1G5357315;E5=3;1K;C5W1E79;1?G51531GGA35=A59=;9g35G=95=955=A;K1?7Q;I37;?159191;5;59;1;?;13G7A53;;C?13C3IQ1;?;7?5755;?5M=3797QC;3I3=E5=951E=9C3Y519O3=53;A153A7;?;1AGQ;191979153GG7M351M91G9;155?735S5C;A9Gq;7E5557913a?M1E5C;5?C5A531G35=?79;5;7E557;53=3791K73M159755E7;59C9G1?75?15Q1]791A3A19;5;;C59_1;59=;3I9515?S7313MIA55K;75535A;5AO37;A97E7E55519;A7A]515313=;?;5=A3C3M1G9797E1591?;;79;C?5759I591;31E5I9AU;5;A313I9=5A5E=G3AC;951Y;AY9G;1S3519C35=MK;7E7A3=W5A13=;5A;375W557559O;3579159A1;95S=5K131351KMC;5;3GC53=M95=EM753;CAA_35;=5A;A9;=?731?M155M5357;K=?eC53I3153573;=919=9C?1W1?7?A1313753U9;AA557E7319573C535;7531M9=3=5?7K;51W15;91W;=5957315E;7M?5a3=91357E=5KAA;;51E7c195737;5SA?I9575G3;5CA?7Y3=?C59573;M7?5UAG?155A97G357AW1?;1;M3C?5;55A7;E_;5A551;G5Q=;319M=319=3=AE7A3AA1E159GG5515;3A73I9AM=;537E7E=?7?C559735=91?GA1?755K5755?M1A35=3575M3;A7A95AA19;AI;9795=3735=3;=5K=531951;53CK5I9=55K1;5EG5A575EC;53M791553G73=9575?75;E5I3=S?5=313G1;;KM1319GMA197E5A;;YA1G;9A1379I;91;5;;Q;73;5;15A955=G31M537;3G;5737K5579e7;53AC9=3MC53;19A=313C?C3=9579;75?I;913551_A91E;7;95753;=9575975E73C97K=5EC357355aS37555E1?=5E5;U37K551?19M=35A13;U91u1Y9753M735;;IA;A3791;3;75?;1M313G;7;;95G5;759S73;=91K1;5351;9C?557;KGC?13A79;A159CEA5A;=91;53S5S1;?=3=5;35=5GA?;;135IE7E7A?759;1;?M1;9IE5191EI;uAO59=;5A5?;M197E=59A;5C3CMKC91?=9=379=3I31E1KA7595=A5;9A19;1?;1G31A5319A51Q5G51A;9557595AU3=3513=53;=5;;31;K15E7531;95;15?A5191A;9IE;1K55G1915919M7M;3A135AI55A315G_973=3S5S155?A;=AA3=9O3I;531Q5755AE5=S;EGM1;_3A1G35=;?1Y313=53;=53=;EC?1K1E19=9=9A=3C?7?191K;5C5?19O35=E15E;51;;A5E153I315375;3U913g3G;57531;E5=3;7531;915;E=Q73795I59737GA55M53C9A7;5M35G5;;19=3A73;7973=E75?=951919C9A51;?13G1A55ME555155?_13575?7313;;7915?C9A13CWGA1M9;515;3A51A35=59=97;E5AI9A557E515?5_55AC;EMA1E5=31;SG;GY9Y1?;7E1A5SA?I951915G9C35=31iI919;AA1W1;9=;3a319CK1GA5379;513=91GGQ1?1;9573;=9=?;1?1;591M9153;519A791E7G53AAA;G51;Q1K57;9=31?=59A;;A7553=9;1;31E5=91QI59=97A;59C55E513C3;;AG=35;7E1KO?G;[;3C5915919=5;;3557W1;9;5791351;3Y15355AIGE75913_1Q;=5Y53I91G59;15G35A73=?75G5?C3G519;C9A;15;A;;3=AW7G5?=91E55M5735M1A31?1AA597955CG]5155?CE19S791G31E5G55515;9G75;375955O;9GG735=3O351MK;I957K731537591G5EC9I319573;=913=E7?5191?C3C35=5G351;?5=553=37EI5355M731G3C?19755;;?195IQ1;5EA=A91uA;13=A9A13A79;51A59=319C5YA91555KM;[5A?5A1379C;31351E75373A513=S3IQ19;55575?7597E515M5A?;=GQ131;97A;;9M;G5MCA955=91;53C;9=G537}M53;;797c;;79737559A79C;59=55?=97K75M?G5;;CG35575379G=;;9I319=315EC?551;3I?;51E1A5k;91AA;G59;13=S3I9137?;195=;31G355;1?755A;G95=31G979C53;C9=9M1A5K15A35=;?A1;59557M3C;M3G7A;EIS5;9;=3;797A91A3;5mS?575M3137?5C59791M915S535=35=3;575KA19737iAG55579=A9C3=31A;?U35;1M?1W1;kK5135155A5919;13=91?CE5M;15;3579M1G9791G313GU37AG?7E75?7535U5597;?;;=31S35;737S913A13I357?GM1Q1M9753=913=913;15M9CW5579=97;5?=55A531K57A;951;;53A;75?CW5759A15;Y3=EAI9C955155M9753;5G=5K79=3C313;M=?GC3=9557A35;1K5;191357]1375E=9=9M;1;357;5E7A;A5SG31W=MA5SA;K73G=5?I;9AU55;913C5355CA3U357;E131E7;5?M=37Q5=313A5;=A535C31M35I;;5;53M79;195M;55=?=;9=3=?;1W;5kA=5;E131379C53A7]5=35=5591S313=55M537E75G5EC9153557]G51;;3G5Y7Y9=5AE1A3A15;A3=?M=31A5;979;;A1KA=5?A15E5;7QM195=9I3=55;?5=9;1Y3=;9=3735=31;K15;91915M3A;IK=A;?13G19;C53I559;1K;5755G3G5a31?;55=91351Y3=;3I975;A;Q5=3G1A951A3C;9=91K=5;3=91E159;;I3CAA35=9=35;=?;A=K7Y553135197W1K73195735CG;319OE5Y1K;=3S=5EG7?5=?5C375;A53I3191ES7?A1A?C;3579G79191G5?7315;EC3;C;91K5O3575537EGM=E5;5579I35C?C3I5;955791A5M5A5?Mg35735;MA=A9=97W7979SA51;9735A1Y;31A3C5;GK5;1A;;3I951E=3M5CE7EM;19G;1EA131;5M9C379;;5G7559A7E;=91;535;;1313=Q73=373=957;5A3C9A;13C;9;51e3=A;;Q;1AA;3=3C5595OM9;I9CA9=E7591E5;=G;3=313CEA5AAA19A=91?A575;;55?;5kGO9G13755?M=?1531?1919A135G191A91uA=59;I9=;3135[_531?A1;E=;3G;19I5?15;97553G;7Q5I357919kA_19791E51535CM3513AC5E153S5C3;1;9AI;K;=?1M9135AS1;?I357?I53S;19C5;?57A3795=?=919=?=M9;7;AQ51A31357;9=535=;97;35M=3;75A531WAU3CQ5=9O3MG;1553=91?;55573A731WMG137555;;3;1;951973U53A=?7315K=5955;A7?7Y35C3;19_aM3C35515c79;15595;1WC3;73C;5Q75;MA351K;1?;A575E191G35G7G9=559195;1531A53;5C3I9=97915M91EC5K1;9;=E7]7955=31G315K;795I;97915YA5357E7?137A9=3M;731?G7?135C3519159GG;1AA3I95=91E79CK;7M5Q;1?C31K1K13G79G7AQG;=59;19755?7531M;595=531;9;7M979;5CE=95=3191?G1?7;9A=591GG3A;7351?=53IM919=5;553G7;5?AI373=373=;3=31?C37595=5?A13G;1M913=?G5=537G35GY1A;;?;U35;7E;M51;3;=3;O53195=A5WO919135C3OE1G955=319195G;75?5=59C3MG57?;G515S?;19=EC3=31A91A;3=5M37;95Y753191S3195C9AO9AGAA579C5?C31A;3U;3g?=K73=9575;E5a3;575Q5AA155A{=9I957?137?5575];5;C35=G;;5E;159G7;95755A59A51A;97;91E759Y;5=9O95=3O9;19=379e759=W7E55=;E5=A9=313C3;=31;9197;5A3U375?=;E15A5?G=;Y;9797Q5;555;1?791;9A1K=3G7;5535AO537A37;31A35=A3=?7EI3GC5i;=9SA197A375Y9;;5A;7;E15E735AI3;19;=53=9O9=MS5E513M=?=3I3I59755M59;5;=5E1W=G9C;35575?7?5O5?I3IK19AG15A3C9CM;?=K1?15M9G5137AG?;;753A153;I;97AE1951KC5A91G5G;;M53S55M15;35;;AS135=31;9131A9;1979A5I9A1W1;31WGA5=535C9557G9;M5C9Y51G3O91EAIE7313C35=555ECE=5?M7u5797;?13=9551AM3753A1K;7;;31;95C3M513=;;E=;9=5357?=SA5?51?137?1;9;5;;755?=9IAM5KI3;791W795;A1G3=;3G;=553=M9;7559A1K135A=53A7313C919=5973C97E5=53195;513I351S5kA53;57;KIS;95C5A5373A7379IE1W1?7595=59Ga3575;9;I9=;53=3MA1;3197313;;15Q_I;9155357i;1G3159755;9CE759q5191Q5795;7;K19A=5?A1M31;5M5313579IG95=3AGAAO913M1973;5;1?75Q13=9;191M31_EC3A555791;5;9=?AGO5;?5C3M=;5G3;CK5AY57315G?1?5=5M5;955=91;?19A;191G;3I3Ag3519;1355=357;95;51E5=EC591E5;;=E=31K;O;3M;1?=S531EY515315e?1AG5M;?5759;1M;?1A3A5C37;;5;95G73579G73UE5=5;55A9;=S59;;75;3S75?;5;75?;I?AO5;95;197A3A7?M=G5919C9=957313a313=?5G197Q1313A19[3I3A=535=31W;1A91597Q;57G;?1?191K;79C;AM;915;?55;55=SG;3C537K=591?=9I?G5GC9;1?;A5A19C3GC?13AM7;9555755E5[;?7559=313CKM135G5_C?IK73A1A?5579;1?;;1A59=A3k759557;;E5731?73A;13G51;;3551?1E197E57;9=]7MEC3Ce3I;3C9I;?C59=37Y?137;9A5GA153C53;5GI915?75379M1531?CA3557951A9MM5A13=5?C31M;5559;13=9195G51E5=G9[;M355=3=979=35=91375?I;E7EC535=9I9A;7;9A137E519;=351Y;53759;;1535153A=5A351_5Q19;1?1E=M;3=37;595=55W=97555A?79;51?;1;3;=313UA3=37E5O;913M=S59C9I9=A5315K;75?;19AU351A97E1?1;9;=;K1EUKIAK15;35A57?197;M9;19A1?1;9I3=3737A9731A;A?G79kC9;13;1A;5?7A3C3=5S35S1E519;57;GA?1A9Y[3IG53=9A15?5;51K;=9IA3C59=;9C5;A91M91GG973G5795=95;AG1GQ_1;M3G1?1;9AC97;?;=3I31;553=S913=W;CW15Q7973CE5=313CM3;Ak=9A1M531?1K=9=E=G?5=A979;5=5313575EC;955G13791AE_I3135I;?1915G?19=?G5=9M75595C;97351E=3;5G=9=?;15919=313M75;E7;5Y;53A;C91M?A1K;CKY15S53C53=3;5A=95=W195CGG3O313A1SE5;19A7G?;AC3O9579C3A=9=W19;MI53I535U35;7EC;951G3;7E=9SA=;5EA155957;E153G5e191913;7MQ19A7G9=31?1]5753195G=?G=553=;5;;A;5E7iCEU?79I;;Y95195I3;=3=9MM51A5A9AM7313C379;51W1;535O951379C559579=5G?5797E153GC5?;;753AC91?IAS;97?79;5=31A;E7;K73;5A13=E1A35AGI53I?;5OA9C37EM1357;9=9O3=9I31K5519CKC;5373=9;79=;97MA9;1A5?I3C3G;515?5=S3=95=E735G1319=?;73A7;A3G55_137;3OE513A7Y;3S5;;57QC?197?79AAG5;7553C5K=A;;59;195=M957M?=9;19519=G9=K75GEC3519C;975535A1K1K7;;95CE13C5?15E731S37;3;73C?;O919=355G=5535C3;197;;951;?_19=97A9A=91G3I?=3;5MCK=5?5=5E513=;37A91;AW;=37357;A37G?1?I597955[35=G;3[A9;CY3=9791?;735M55A55C3U9OGG91A913G7357M3555=G531G97;3G1K131k;5;9C9;557AE5=EC?=5;;9[3A;7;591AEA1G357M5319C5;59;1;537;5E5579;=EA575?575?=31K1A3;79;=55E5IG31?1;3;73U3=WI535O;3CE1AE135IY5379;7A3A[5A351AQ13G;5155K1G31K519=A91K73A555;;5OK1;A?191ME=315E5OGGE191A?5=59575A53C5;K19=5;9C;SM3G;1;3;A;7E731G31AE5A13A7M37559515?5a9755351535G7E5GS13=;YY97E5;79CE7K13C5;91?;;5;;UA91?5I;91313C?1W13=5;9C919A;1?A5C59;;I3=Q131E;795575;9A1A3C5919;1K;=9G15975K5=A;5G95=;35IG35I9753;;5;1?IA5;3=;3I357?75;;951973195m95MCEC9753C319U5;;5;3C3MG5;;I95=E155319=Q13=3;51EC53=W;;5IA59;=?A=?5C31379M;C3C31?A5=355515?AA=G5?Me57;E5SAY5=979U91YWSGM75595;5;191G95575?73;=3AMM1;319=9MA513795;AI59;51;531?191G31G35IG55K5G;155G53579;57553A5Y191?=9=G5MGK1AE19=3A7535=E15E1;A;3;7YEU3755537;?=9CG553C53AAG7979;;575AKG7AG5A35GIGA3=35G5;U531W73555;15A;E73C9S=AE5GC31u=3IQ=E5;51;5M53557E;;75G559=5K513C31;9A1E=?79;5791;973M=37E519A;1AA553A5;155A;SE5=AA913S7E197MW755A5G9=K1KACSM3C;3S=?1955C357;G31G;357;;?1;A37595=;3C53A55=9=553;G51913;7E7315e?C;9;M5G=913=;3755KC?1G3C37357;M3C9=53SS1537979C913G=913;M191?7E=G373=?5;519;7kE55G;=5E1MAK1;535AGC5919=5M379I;E1Q=K1;AY3;;1K7A9=E=S?7?57?AC95;M1A9=97553=9A;1A9A15M53;=?731?CEMC?;A=?1A313=c75WC31319=9AI5K513I37M5Q513573;=3;G=E7;G5?A1915?C?=357?55CA37E5;;;5;I313575E=3=553=;35C?7?5ACG?M1M973557979=qE1K513575A9159Y5O;AW159=97E15W79=59M5C?15373=9=95C59AC91A;9573IWI355AG195155GQ7EIQ7919513AO5_;9GG;;131E;75?5U;351A375ECA3C5S35G57;A?1W73195=KC979=3;;13=;?195;;IW1e5;9C9CE5795I9AC315;;3Y=5K5=3557A;531MG957AA3;=37GGQ5MY;135GCE1A9G519555731Q5G=5?79O9795;1AA37;EI9C;915E19=?=G5?515G;3;=9515Q1G;QG5=37K;7GK=G?7555;979U3;7973=;A913=59C]=3;19;575]1;951;3G55A5;19I35C]57E1Y?15?5=31;A91?57913IG5?1E5;;79;=531K19O9Y5=5;E7;535;C;Q5CGW1G5A3A1A;55?UQ7357559731A?19O9735C;A91?=553=?Y;1G55;9555G=G951;913SC31YA3=53G7;;9A1K13=537K551�515;979G5C55;95=9197MS3I?5=31A315E1535;5;7?5A5UAE7;913SA159;C95M1K191MKU;3M75?753131;97W7M3C?1G3G519;55=53=5595AC;_Q153GC553=913I;5E159G;C?19195;15;A91;3=531A95;;55791?7531;5351Q515919=A9557A3G5=955155?;A1Y9M5=5EO9CAA973I?=3;75]kSCK575919159IQ5G5AOK73=91;5315E1313A1AE=;3759O35=31G591?55CK=9I9135;79195=5GS9579I5313C5919C;W57;3A;5AC5A9;CA;53A7;A37kK735I?75K5=K15E;1GG919=53GA75591K1?;73;575K7K=?5791M?A;7319=5357A;E57;9;79A;;1K51E;7AW=975?755M975?=9;A;A1Q573M5=9;7;319[A553I?CE;7;591?O3A1G5?A1;5S9C5G?1?C3A;7375;A5?7;K1;E51A9=5QU9M735191G3A7531A;A;3753159;1?7355I3GMI319=3=EAM7G9G1AE195M13a?7?7595I;91591K=3;1559G5=3A7G55WC?1915E19I97qG?M=35GAO;3;;19[;97;Q=95A5MGA1;59;1G37A9;=K7;;9=31?7?759;1;9=5?;55AO?73YCA913=AK;a37AAQ5;=3;1;?;I53G5;15535753ACE;753;C9G;755G3Y1?5515?A5CG;5M9;1?A=A35C3G1351K1;A9;5G51915GA95;7E;79;I59M=9[?=531591E5;5;737A3131M37EG=E753AC9735C?I3=53;;1?;U35;5C;3=9I3G5135G57Q1Q=AG3;1S313557E=A5919C37?I3=M;9=91i5575M357?;1;5A37EO9U951e95=A?1A91A31Q13=5G3;U535M13C?A;G5155?YO5A;;9;7?G73C31K=?19753G79Y7A59G5CGEC91531W5731A9A1553;;C?1;?G19=Q51357?5A;19;515MQC5?5AIS915355M57?79_Y5;7?[9579;7K1M;A913=559=55A379C9A1EC95;U5G95CM5E7A9=973A5G7K13A79[3;7;35=53GC5A591;ES1W;G;75G351;E515535=;Q7?1375;E791W5C5?;73=;375559753;AI9C95;S=E57E1?C5951E5;5C35;=35AU351}A379155?1K;13=53195=Q1A9=5957553I31979C5K135=;;A3797Q5;A1531G?=9e791;K5;731SK551?13=;EC55q375;9A[951375535e13G;A5=3A;7A313Y=3=951AGK=31;53;5C3A19=3g9;=qK57S?G1;97E;A153A51E51MA9GCE51E5753=5E1;SK;73AGCA951G9A5;1A351;A9I3135A51GAM?;79C595AC955A1;5;;9;=31M9A51E7;5?51531319A5C355;15AG?1A9M;CA?7AE7;9;51A;9A;7E5GM131;?IQ[;A5553GC3;5=319M;1?191A55G91;9A75357Y3;1Mq;3G13=379G5;19MIQ7K[5W;OQ1;;3=95I31975355=5E135S1A35=AE=9579;A1975;;;AK=e]75;3[91K5579C379755;K=31;5;9195G5575S35[;Y91Q;7EA=AW197;M?S5;;7K15535=Q;5UM?I37?;CKY19735A=59I9=53O91E5=9=5K5=;5K19;7;55o137A357Q1A?5M=595;1GM5?1?I59153A19159=3O351?1919A1973CK153C975;9G5;7;?C5?=957;EO?=3;=3M5=;_3557A37A_31355;A7W=595=;;91355159IG55A3CE5;79=95s9C379=95C9;13G1?7;A315AS3=5313M13515G53IG5G;A591E79AIS37?5575G31Q;;135MG13A797S3=?55O5;97313YA13=G9;5;A7;35aK1;?;19C5?7K;I;3C3;79;1E_73=G59C;9191W759G1W797A?A79G7;3=;Q=A915553G=97;;3GI3M555=95159I5A?75;A37A;M;;S35=Ka95557?5A1G31E557S315YA9;5Y=A9;5759GSg3=3;5;7A3C?55CA5A;G3M1M5Y?I591;95=957SG3A79191A;;3=53A7;3A131A355M755K7E5;C9=5E;q;519=MKC53;755535;7M9A5A73G13I9159I319G51M;5GQ;1AA9;;557E5=G5GG5;351Ae3G;=3C9mM53GG7979O;553579131E15K5519;CA59=5G;?A;7EGA;7?551A357;_5957k3O319=319O531?153SG;5=35C591973=31G3A7319q197;K1913O3I;5;3=?CA97EY=355IKY;5=55AAA91;5?5=9_7;55355;AG7?;7ME=3;1E7;K73=3CE=3A1E79;5=G55e3191?=919=9=EC3C;35C3I91?GI5M]C35;5=9C?;1531?=9G1AE1?1E557SW5a5;591G53G;75G9G7;5?IEC5G5;3G137A37?1KG131E;75;K1Q=5MA91?19;7;5E5MS=3C9;5G79A759=95CM?C9A;1;G31K7357ME1?137;3CM?=37GA9131;];;153M7?1;5597K1;53573A7;9;1K5;7;3S1E7553C?=;;5?5[3=;5A31K7A313CS?;1?;1AE5=5A;37?137M]1379A7?57;37E7S315M3CA91G9C355=595M;1319[i;CG31?1E75Q;5791A;u;5;=?GG5U;3551553;CA?AM;G;7;;9M13575?A;5;5=A91555973159C3C?15EC375MMW=;355759=3C53519C;9O53A13O9731A955C31G31M351;9=3AA=E=9;C;AA9=5EG=;37;59=31;97KG195GA55M5CE1KA759A1A5;35A1A37;955=3;51S;E;7;GE=59;55797A5A?1A;3=313I355;A1S3153=EG7915;;3m9;55G=?O9;1957G53153A7E51357G;A;A;3579;5Ge1E15919;CAA97355[95=GK;;5;7Q7M;59791E1?M7553UK1?1979;A;195C595;;75;37E=91e97K;13C;9=AK;51A53=5595=5E513UA9;1Q;;19A7A?51?1;Y95155355;S1E5=?19=KC9M;575Q55CA315;AA31AEIi57;?;1A;?CMQ=9=9M;759;7373k5M=K19515535IGK;=9CE19519159=A3=9GA1EAC;9U;K73=E15M;G3135;U97315;5EC37?1;95C95CMA97915;3A13Y73C;M3C3791;9A1?1A;55?G57M35M5A5O91?=;K13CEM15W;M15?5O53C591W;5S5155M97ECG31?AI957;3A7;53S55735=S?CM3=951375G97;A351M5?5;I3ACA9;;557i;;=?C35575QY;153C5;5;;E=;K5Ck31;5351Q5[5A313G1G531Y;3=5W1;?e55AI?51;3G195;5=WS13515;3791?;15E1A;53A;=355=GAW79G19A15;?13CM31E15A95=?5CW1?5G;M1531G379=5E5[5EA13=319[37E7A5?735=9197E75;9m5M9I53753;57595A1E79C;535;1E=5]C3I357;;91?;79153135AU3=M53;7E1;?G57553=313OM9;51W15?A;=G5?=?5C;9513C3=9Y=373G=951K5=GKG=95C3I5E1G9;7?=55Ac1;5GG35;;OS;;3;A1;?;195=;G351A379C35=3=;K5=531S37KG7AE5G1957M;;59IK13=?5=9;G5=G;37;53A1?;C53CA3C9A;C59=?1E515GS355U;3;;1A9513=S597597?1K551A;;3;A=53M;797A?7591QS;797;AM5319Y135A197K;7;5?5G51;SA5G315973M;7E795;191K13557M37AM?A1Q1351;3=5?eI3C9G;519;51A3=;;95191;53=91KI3;;;=95MCQ19;7;K;;A51379;G551M;?15597EA15A351MMEI35;737G3C913=;9=A9;=EC9G75;375M37;?551;?7559;7E5C9;195OQ51537K13=95_5191AQ=3A735M57;?1?;1;35A1A555E153IM35A1K13A19=;9U91;?=AE55M7;5E1KA1?C919A55=KA7GM;53795O;;3;1;e9=595C3=AQC5A553A5;7Y;9153519A73;=59=?5A1WU5?15?A51;?=AK1;;975ECA3153=3U;9S1;E7973G1;5955=3;1KM1EC?7531;9_7;91]557;3I3U;53=;9;1951?5=31?CWAC9;191GY9;5=9A1A;;5K135AIG5357E75;c5I951Ek51A91531M5E1G31Q1K;A;1951GA53_735Y7E731?AYC3C35A5MGCE=5?73;5;;79AC9155?;Y51A9;CM55?735191A3A55=55KM13G1A35=;?79I9=5979791K7E1A37M973G137537915?7;?1;WC9A51;?191AEM519=95MO9A7553=9I3C31KI9C3;G57913;=5A31?731G5S;?5519CA375M55GQ5C3;1;5E13135;A=?O5c=K1?s37A;A5Q19;13=;3;15?G13A5575M3O5cO3137EC?153O9515355S;7_5M?=951S3;=;A351;553e5191;9C535;15;5;G31;91?C9A=55?A=?1AEA19=319;1?197K5A;=;3GM57913I95;51Y5SM5E557;G319=?51?=979YM15GS91K1;31;?CE;OG351G?791Q753A19MCKAI5E15;9;CG9=951G9=91;;31973;=W57A;W1?=?=A5M355=919A57553G555O;59;1k35A7Y535;7?5A1A35575M5K159AO3=91375G?1E1?1?;G5C3=315MW_55AC3;A197A3575?19AAC31K1?=31A9;79IW=?=3;CAAK=555;;G53=979A5A5;=319A1E7GG3U;973=5313G19=53U;K13=K=?73CAE1K;5791;?5=95G191K=?;A=3M;1A37913;1M;9=?57{5;5G5=5313;C3_513U55A];;A=5A;;;Q=E75?A;=3S13I35197EI313G7EI9;A5C?1;3;G7537A?=E755915E;135=?5GA7Q7?C55;9;51?C;97319AS=W;5;A=?7G9;57;G5K5G=5559O?=K7E;1?=?759A131AW5=31K51;Y?A5795=;5A35G15;5535aA?;15QO9=31?;73=35C37A5357A;91Q57K;;7AGA5Q1K5;C35=3M;7;A9;;AG7;95;73I9=3GS137;9=E=3CG;3YM19ACE1537E755AA;913;7319[9S7;G5?AIK73A513A;75955=A;53=3;5=GM3513C53C31K57?;19AO?557?7979C;95GOS;;313U?1379;=;35;51K=?I3M1E5;731WG1A55;97;95GC97E;GC?51531A913;M7;3IA95…A3;5153;=535A5=;319753;;1?15E=5A3197A;;3CQ;C3551Ka9=3C9=?57;3=;S;59I?AOQ5GIA3C;3=591;9;=G;?795IA?79O?GCQGI9;AI5;;3=5;35;15KCE197M;535;1EGCS?O?C35;73195G75351W=A9IG5?=G?1M;553;CA31G3UEA=31379A=9573I5?=QC913797M9A;7553573131AECA9=?13C3SAM7;;?75S375597919579qC3;1?=95=E=;A95=55;5;E5=K=5E13S75;;;?O?C3153C9[9191913G5G;S73557E51?G1?CA313;;159G7K1?1;?G5C5?G57W55=5;5SG3M73A;75?51A9MCEAMA=9;75W=;957?5CA5975E=313=53S5191A;9_7K;1;3;1A3519I379;5CEAY1?;1;3551k53;C537;QC3A=MK5S75313;A137955515553A1K5C597]55GI3=]GC;;979=A919IM35O535;1E=59=5?73C?135A=951E5CECG53U;K51M37S3AaQAC91957G5?=3C53A15M53;=59;5C31597;3A;755M?;51A?=?IA?I37K;5=5?515EA=595S1?I5;95;;73A131A3735155?OK=3551K;5C;91591M;9A;;MUAA53=;M53A1WM7951351KM191A5535=37A55;5M91A;;AY9I5]C35=5E1?73A;7ECS9;1?;;15E;7KG=37M3A519;1313795=;9G5=c=A9A73A15559AC?M=E;5;191357531GWC5537;3M;75A9UE7A559O?55;O5E513=;W1?O37K1;59;;U553;73Ma;9A55=;351591351;_55957;9G=;9=QI3M;7;G5K57;591537EO35573159=3=EI35_13=3IEC;E5A;7G;e3I3M;5155355[AK;1G5G37K5=E;791535C3;5=5Q7A;537Y5?7915E;7535551?1AG;A5EU55K19A1379M13;1E753;=9C;9A5=;E;G;[975G?C31?1;95A57AA373GI591K;C?=E57;37?;1;9_;7?;7;A31K7A5?7351;A35191AA3A153A;C5M9;5;=3GMCK1;3=Y31;53;=?G1E791EAC9I53;;AA5=91;;5E1QIMG3737AM;9A=95;1?;I3I9S7951;;3C35;;I9C95=955=Q19;5=5379GU59575313IA5GA35=5;KU3131;M553557?A13579CA379159e5;1K5OG3=59;;1G957;?;7M357E731KY79153=91A3519759=5591?;OEAaS9=973A1?U9=?5C?155319;79;1AAG97A9AC31M9=5?;7E55=GA3C31;?1e?U?7;95731K1GEGA1G;;?5AS;Y153=;E7G?;13;;MI?M7M5;;Y?19UA5Q13=;97379O?I53C31E7M9A1;A91E7919IK135A;O95SM57Q7351;35A15M35153555=G531K;155?7559CGMe9557QCA35G5[31EC;535=M319153;=3AG[91;5;;;3;O9M1A5355GM1;9557;35=5?=9AAA;1591E131ECE57553=9=E5O9A7535=3S1E;C3;;51;;3I3C;A91E7K13A7M9;1A5;E;7?5U;5;?575?e=AK=Ac5C?=;3AA1w31;553I53G=5913=95=e?=AA3S;1M9U3AI;3�C91E=313G195O5W135=319;19CSE1A_GK1313=3M7Q759;1559S19;753;5;A73;797;?k551;?7S3C?5A1357SK13G1597?A555=9GG159;;57M53=?=;97;3[9195G57535753;=;91;59=_W7;AM3GS=95A1535Ya;3M57?=91?753M1A53;15cM153;5C;5W;15S3;=?15315A31K51GA95I5379555737E7WA57K;C5355I9C37M?1;95G51979;U3U35GG1;M;35C9AI3A1;97;3;G5=A559=37;K=9=31K;A5=5?=;A37AE7315YKGC537A91?5AA=35=3AG5CA;979;=5E;AA15Q135G5G;7Q153AC53159A13=35C91A3C?;1K=59_19=5;5;K1;cI37K=A;591EGC5G55E5137;5;535;C9795=5?;13S=;9=31E13;A=53I]57G]5=319755e3CA;9159;7;595A;=59=35;155?CKG13;GA7;5;91;?1;3M137S;E5MI3;OA;95;1;G597?;1;9=;;9;5;C537M37973=;35CW7o7A;A559735;;73AA7M319M575M3O35M;O35AC?5797;K=3;G=31SK;75M95191MG?7A;K79a595U351AE=35I;95=S595=97A;E7]19aA3_=3Gg9;1;M5E7;W1K51379I?C3M;1A37555;;G35=9;A;=;9G5753G5=Ÿ=;;913;19;7559AA79=9I5535;M19575MSQ7;GQ15375EM}1K;1;3;O919G1;E=53;15G97379;51;5G31KM5A7;A3S;;=M955G5MCAYAQ5575;3GM19195=9A=9=;915W=95;A55[AE515;35;1W=35C373M79;7?=;?s31?7?759;A19=5;;53G557;357;;53C?G1K15G3;M=9ASG5=91355731?1YA53I;35731?=e553G1;?S75]79A737GG3O3C5W=E1Y5K57;5;5;9C915?5=53A55=;9=3;=?C_315A3;=37M9Y13=EAM5CM?S1;?7313=;59;;79;579;A19M7595C9=G3513G19=59G75319515E755Q5=35=3131E1KMA731A?5M5159=K1;35C535G=?7;3C5M31Q=3;57;Q7?Y1E7S373=315;A9=A?1K5=5A;?O53Y759[EC5A]5155A9A1?I355=5A315AE7;9;7K19A575373=355S15G531?=5Y9M7;KG579G19=E;I5G35M1975?1?5q;5=E7595=31A;5A59CK5G5C;;979;7A3;7E=GcAA;73AM;5;I9;1;3;=M591;?755KS7AE5O9=3I95=9A791;97A9O53;7EC5A3A=?731]=97A9;73=9C913C5Q7595C9=95=9197q355A;=9IA351A?5197W1;A97E15A9I?=3;1;53A13GI9G5C;35A;=53=3O?=31Y5;;];195O97313GC?1A3791?13M=5Q5A5551ECMG5KM15;95a5?GGC5?A13G191K7;E5=55A97A9=95C5o1;K;195=Q1;A3C3G1355;;5C3A5=5E=3137A9UE15E=G95G1973M1GG;5c5C55K;191A?G73=?=]7AW19;=3OKC559AS1K5M=37E73=;35;C9;5;1M95A1A3;57G55M3=5319S=5EAC;;5;9A731?155M35A7W1W5=955AIGE5A19MG5M155?7?=E1;35A51E19M5G579=5957;31MEA75A9;5=3=?;C;5;9A5C975?=59GC531A9191?=;?7?C3MO35159;G=M379;73AOA53A=3=5?5U35=53UA55EC;K;=;A;915EA191;5;E5GI;5;91M53CK;135=?U9;7A;5E;159159=97A31]M1M;9A5=55?AC35C;3GG5CE153O9G191;5351;]753;=?A13I35G5191A91?15QA;C?55CAE197;53I;3C537?MOM;S3M5S=913=9=?G555CK=973=913GI95;I5?;MI5M3;=M95CEI9I979AA13G=5?5=A97W=3e13S=313OY59=A915?I357313GC5?5=3G;5O;53A;g;53159C9;I5_M5?A131;?MC373C9=EC;531K13G1K;C31;59I59;5G7;531?M73U3=913e;;A1S9=A3G5=315E1319;M7E73G;=9C5;;975EC9AG557;3=553=9791YG95=35135O53M1591;WA7A?C35575?1?551;3;=?73153G;=Kq5A1M3=59137;A9A;7EA7553k515E1A919A7535M=?A73=EA1;?1G979M5=?5575313U91QOA?IQ5737EA;1A5?5;13O;?5G=;591;3=AE5C;;EC59A;191A;535AG737;5;913191?1E;573;C5Q=5G53;=?;;5CG5;AA?5MG=3A15S31A35;15E=A;31K55;1G53=K=313=55;?5=3C53;5O59=?;19CM;35A19UE57M3A195=53135AA7;A355=;375;9;AAa53137MA91?=?;79;C9=9IG5G3;A=9;A79;CK7M531G?1YK7;5?5CE51EA;135MIA351357;KG13197GAAQ;C31;55M3;7EC3=315A35;=?19M;79;=595;1e5GE1;535OA3C35U?=95M=59=AA37AS]1E=35;;O5;MK191AA;;3;U?7?13=E7;9G519;I3C31Q=955MM=3575?=3CA35159C;G535=“U913O;5535A;=?=9=559C5KG1K1K55=?5G5731Q=53;5_13I9C3G1E131AE15S9M=9G15E1313S73ACAM9=A;;97M;535=53=9I319=5ES557E;55=?7;?1553;G=95AA7313=AM357;;9A195Y;19AA1K;Y51;G5G?=3;7K7;Q7;?737A35G5;1;97?G5;1E7531uI91915G5Q7915G3=?=553=;3I3C9;1K737A37;55i1A?;;1G3;I35CE1A?1A5?=K5M;79C531;?=595797Y9A7;;?=9YSCA35;G75E1E791?=5o=;35;OG3;5=QC;9=3;79=;5Y;5E7E55S7E197;5G9;=35g3M;A1;?C5Q1EA1AA3OK1S3=;E5C?57E=31E55M57553AA1?G131iG1?=9=E75?191?1973C?G[?7591;97E1357;Ak5Y;53131K5=5G3735;YC31Y91Q55731?A5M7A3AUE1975E;7A37G5A3Y5[?;I913=9=;3=K;A15?=37KI3M;1A;59;;OA5;91;?1537EMA=53U59;15?7K1?13AA;1QG519C351A;E5795=315AWyE5=k53S79551‰979731A9A791E1?1c=EC;95;155?79;GA13IK55G1Q=351E51;;GE73MA79135;159;A=3=AA91K551E7?M197E15?=9M5CG5]155GW5=3U3=379;C?5CGQA1553=?;1;3137W1?;;G1A;9aA35CE=9G[A;;MG;GSA;3G1;;3;1;?759=37;53I91975ASQ;5;15;5W557;E;5;5;M7535A5S5195=;9=3A=5A5G;915?A7E7E5=S35O3G551555;9;7;KI35=A9=9=313G79;5S5=9[?755?A;19195GC53=?57G?;Y19C95;7A9=559C5;AEO9=9MCE153A1S53;1A9;5O37E755?A55=M597;MAQ1?1;53C?73O3579C5;91537G9795C559CQG5G1E15E1MK153=E1AA5?1;5G35791W7?;15955O9IM315E7;?=?=9519G5;5;=GY3IGM?1531A97A3;A;57?=9I3=E7915KGI9=97M;E5C35;;G1K55755E13C3I;3C31;59137KC9;197YS3=35CG95;;131;?57A9=35=9=?137915M3C3;=M53[9=]5A55[G53A1;59791;;3aEOE=GA9O91S35ACEA5C?19513A1?;1?7?=35I97;3I5ei5;=A?[553=5E79OGK15E15A?5C3GCE=3197G;KMO31;A37?5=351EIEC3573CA975K1?1?=5?57?A1A535C?AA=5;5M3A;19G1375531;95I3135=95GG=A35=95C9;5=EA7E73=9;1E7555;?1;;AEA1]GS19AACE7;A95C9579I31A3;7973=35C37MG3;1A3U;5EM5;15559=5;;_5;AW1357QAC3575A9YIK13515531E1?=3=5319A;M5=K15MA?IYSG;591E75k95IA913=c7?575K73753;=9;;C;9A5=5Q513SA=5E;1?1;A;5A31Q57;5ECK15313=;9CA9AG5;1?O95551E=91A3;7A357ECK;73797;W=59=A9513515?79O3C;;EAY5U31K13C9O9;A;;7;355;15A55;53;5C;555EC553a3131Ke5=9;519MA;C955=;EOA?55=5975357E=9C313;;5135=KS579O9G;191A53YCK513C5W1K735IG5]=K1KC;951E=5313797375?=E1AA9;1A3AM5;1E5=i557W55=;91A351W131WC9;I9C;9=3;M1;9A19=;3=37AQO5G9A79;C?;759C591;97?Y_1;;53=3M5135159;1YA5G?[?5MM=9O;?5575319191?73YC5E735AC3A19A=957?=GE5Ci;155357W5MO;53U351K75GM35191;31;;3YA=;5G975?7555;55W5;A;73A51A35197?A5Y=9=37A315;?55O591E5=?OAM95=E1;5919;CG559=3[A;?;1913;79Y;19=3797955A;G7;3=531WA737]I53AC9;IA919=3C3UE5;75?A1K;15Q519;15;5E1;53IE5M5G;A1;;A5?G1W79I3=E5195;7;3M=95G13A1K1?;A1;?=K;5O;KC;q379;5A1;5379C37KCA91A3a;3;1;KM1M3=A3CQ=97;EM5;5=5YAW=919CKC53CM591E513=31957;YA37A3C31;9M1G3;I3G1351E=QA;OG3131M3G1A5AA91E=31535735CS355;U;5E1kM5535AM51GS9A13M5C91591E135C35515S9[531;553[53A1EG13S=?O9AY1?=5E7;55319a35A57559U9AAC351G97;9Ic5CM9IWA79791EC?=553=A;531]A1;5E7;3=3A=31A955197A3;A519O;?1;313AA731WA5C53G1K5191535;1559A1A?135U3C91KA7]q7919=?=9=SA?5CQ;;13I9A79;1]=K519=?1531?=59;73A5=;537591;K7E15;A37A3;=5?7Q55CA;95A=591A9=A9G573AG5;51MQ7;Q=?5753S137E=E1KAC313G1G531;53;7A3=S975?7559575GG?135;13O3G=9I35=?5=559=?19;C3;7E;737?;A19791GA5E1c75955O;31Q=9;G=?7K1A35=M?19;5755A5A9S575E;735153CA9A=5373C5E79=?1M55SE5MC55;91951EC5A;A35I3M;1?55Y;C3=K1A9Y5C313GI;;97;?55;5I357;G59=531A3C5E197E7;W19C3=S;G59A1GAEC35753797957K;1355795=37_3A[31E7379A153M1G95=53C9I59;I31?791;MEI;;5351559I3=35137AME15;;59UE791E73=59G1G9=59=QC535MC35=9S=EC537?13M=YA9;C3=31G?51?1EC?=5E1E=5G9191?[97;9;AAG[5355=5;EU559A1G3735O9AA5C9575KM55G1;;e31G3797553=MY;91G355I9=9AU9A;;5=K=G55AG?;A1YW19IQ7;97;5;95=;?;S=979C3G;CA3135AAC;9;75G53M5=;K7GQ13=5?79;=G3;75;35A1eAY97?57;?ASC59=S979=K;51;A37EA7EA7535A;A7E5C53;=5G53795;;;I375?7;?M;7379A=?7W57MK;513C3=5;E7;E7A357G;535O91KI351A9551?191k91?731K557E7;Q1;9A=M97K1;5G31EA;19C5E51375M;9731SA355AI;M91YAE5;ACA53C955AC55;?CM59G=S91;?191S9C59=?AO319731K7K;;A735=53;759;75K;7K75M3M1W79;A191?=5Q131E79=i73A;=595737A955155AAG?Y195735=5E1?13=;K55A55153A=A53555=9791_5595CA55375?=E;O97913C3;5CMK1;9CA35195=]=?1351;597E1;M3;15E=3O9C3753C?5515E[A9513=Q131c1AE5;153=M5319753;CA?=37E5G;IKG1975?7A3575357K7?=37EA191SA355U?;=3;MO973=9=AGo5=59=E7M3I5957E;1?7Q73U5E1A97EA5A557W55G1Q5O;K5G;5;U915G53M195=?=9C9G191?G5=;3IM?;7K55U9g3=E575]7;GA91?19;AA=A97Q=;E5;=3S5=3=53;=913_737E_7A;351;3=K;5=K1W5C3S5A1W57E;1G531;AA5975SAE7;9=3I95CA9A1?1979557Q7e537M;35579GMs;MS9C31QC95G57KG75E=9573153GC;MG3137WI59=9;1A3791K15A?5;15A;379;=59AA;51A3A=u57531EA;7G9753735YA759=9=;AKY7;9737?1;979U355A19=9G7G59753;A1A95519O5;5957;979CE51559I3G5A5;1?G15K=?;7Q5C913515;915;E1355=3;=5EC5?I;5;G355aA31A5YK1E153A55AI9=K1WAC3A55IE7;?C53191979=G5A;95G75E=5A315;;31E5CE7957S53[K19C9;=55M9=3OQ=?7Y9[E191319M79=A3U?1;MK=G9579I;3aM3I5Q5GCQ;=35=3C?1979;7EC3795;AC351YM9qI591K1?=531?73;C31KCW1G9=3I;A597A;?57A;915E1?MO97G?;1591?5GC59AC53A7E7Q1MA55K13M1G5A9S5M191S3=EGC319M1?;19;G13A;7E=5W5GI9735GA753G15EA73;51;K;75;;55A91591E=35C?5A13GC;E13=95CGE5CA3A=AAE;7;?7;35759=9=M?19M1?IM97Y9SC3=9I5A;;53U3=559=31;95C319A513I3=M9I31EA19a53A1EI9C;9197E57M351AE;1M5;;?;;=351K;=5G3=;31379;I9U35M55;S1;E7973579=KAO9=3;7QA=9MS15EA;75355a3a59159;Cu7535G5=E15YK5AM19G13C5;979;;5=AA9AY159;M=?;5C37A91375355=595159Y1E=W1;K=53G=E7;3C319C35=G5?C319M;1u=3737?1E5=;]=K;=;;5SM957GcI;;951537;?C9=97E5=?CE73S;G575957Q;=e;A9AC97535=?G;19a595C?;1KC;355A;1A35153A15Q15Q7AG3G;7?I5A;3G197535IE;=31G31G;K=W7;A35A;=G913=9ƒ1?GAI3I3;G=55MKI55A553AAO97EAG7S3C5G;3G791?5G=915M;59;15;AE;195753C?5755Qe=9;795;19I95MCK1k9eG7A55;591;E755951A3CG;Q=3131GA91975;MQ=595=?=A5G559A5C?51A;55?1?;1K=9=5979;=E;7M91531K1G3;G=55?19A1?GC91M5A9;7;3U?1973I3;=3I?G;Y513=313G1535G=EA;753;1919C957315EC53519A;=A91313=E1_;53;5A1;5S53G;=M5e5;9M5GC;59CECA3AC?19;;7]57?;1?M;C9759A73573MA=A91AY3=559CA97A;3S=A9OQC957555G?A;1E[553=3I9=AQ5U;35O5W5573YA1AA3A5G;=;3G1EO3C;3CAKA=59G131;553C3;57M3C5913795;1979=?755G9M=5Q191;313G=;9=G979C9737K137;3=5?=37W1;A5;M3M5;AOA;;9A159AG5C3;5=53A5575?75559A1E;7E=3C979=3135=W=59IE5OME5=;?G=;973;=;3CA9C;319A=A9AM=K;1AE5G=3A7?=3I5G53;A579;A7K1;?;CA;9=KACA3131YA375;E51357?7;?A13=?=;M9;13;=35791?;;797;K=319;5C3195CE7;AM37K;5I3=53;G57591Q57QC;?19S1E;575?7G;5A31?1;WS1;3O;?=5?5;;5=AA3=91E79;135=5?1KC;9;=G55AE75?51;59UE7G553S7;355;73I3e137;?;79;1?CE15;9S;7]A1?1;GQ73IA35;19C9;M5A=59;GG1;?1GM?;5m;?G5;75A531?7ME75A95G1G31K7E19A51A5355731?MA=5?=;k35;1AK[5A35C;;;319;1A95;A;7559=3GA7957;5K=;AEIA37A53;C91EC35S;513M759;191S9A;73S1K=5;97E1K79Y735575379A5e=E79195O5379U;9=K19573I31A?191E=351;?;=K;5CQ=?51?19C91913G7E153=;3=?753AA19753=55G?A5;=3191AE51;53I5G?S=355MCAM3;5;C5;35U91K55k73737E57;E1A;5A595GCKA1;5A3C97_37E131;?I3=WA=];7MA?C3;;A1EIME7K=55?;13=5?I3=Q5[537K1E5;191?795AA=K5I3=9UG31A;;A9A;1A975K195;1_A37W73753557915E19M7W159=G35=KA=?1915?5A=9197;9797A3;=355C3G7G31;Wa595S197;973C3C;979M=59O919C;?7;3C9A7;;5G59m_37955=?7;5EA19;5M;13=Y313C31919C955C9=91Q5};A;;15A5537A97E191S3573557;95=3k=]5A5;;;=?G;=KM7973A7;9;15;E7?5=53;=97553=53A73CA_313SC957E7?=EC;;AAE5;M=5;?57;31EM1?A=55G531;5;3IMGQC3735;CE51?5g9=9=319CAK=G37;?551559=3YA51357;MG3G557A3C31A351;;9575?=?79G19G1AG59=]=M9IM;G3;M1973573M7K5=9C9;791G9G=973CA955=Q79=5EI;975A5355=E1?19=95=GE7?ACK79G5;;C555E1A9;75E=?GA1G;E73G=5E791K13U;QC9137A3_;G5A;579YG=kGS;E7;;53AC;975G53M51e_S3;7;5E55=9OA;9GGC595U9=A;?;1EGY731k59=AAA?M=31979C;?=5G?1;9A1GQ;=595197K19159I95O9;51?;C9=5;?C319=3513=?7S91;?C3;5MU?5=31E5=?57K15?5=5;E[53G15K=EC35S=A535I31A9551537AeK;13M;15G9;57957?;=53A791;M?15S9M5A5519M5;aG5379I531A3159;1G?515373575KA1591EA=M9IK5M7595519S1;9555=59C;5G55KA=3;;I;E;797G97W73=5G3A;5CE1?5C?M75A5EA1A3797E75S9;13=YAE5=3191Y9AM153=59=3A1?=91K1?1?;;1?;1GW5753M79=A5?A51A355I3IKIG3O53A;5CA3159;131;K73;A1QS7K1;]7;9A=E759;1591E19S1AE1]7;973M;5O9;5A1K1351;3=5W55OE5731G351Y91A?55;1?7M;;59I957E=3=595IGKA75G53;A551595C9¡G13G;5Ci;755379O3C3C;K;G=?19195;;1Q;19I315;AW=A;979g;E;75?5AI?1913557;97?7951;;5K1;9;CAAG313M=95AY79I553G=5?=S?1973=M?=313S5=3CE;51K55=M5;9A75975E;5CGEG=591;5M9=;59;13C5K1KIE1AE13C3A73A73C5955=53755591E5=W5GI3=955CKMC31G3U35=5919CA;9CK7;;5?=53;195;;;7;3;73MC?M1351?1E131979C;E55S15;3=351E51EI?5G7?55759G;C;;95[3SG5AA1KG51559C53UAK;=5;53555;UM3IEU;5?7E=?IG3G7E5;153;5M=Q1;5G53AGA13C3;A5CYA37919555=?;UE55I;;5;951;?=53A795MI375;;97973M1K;A7;?13IMK557;35=W7;?;1?GC3=KAM1;MM;A5G5315ME51G3G13G5C5?;1M35I91Y59;5;153;MG1EI?759=;3;O555G3OA91351951E15EAG=95I;5E;1K55C?CE19=;3I9;C95=;3;;1535731A5;97Q5=AQI3=5G?=;35MC;?;=G315Q=531A;E13197M;A3;7E5C3C3=;?;19A797W;7?IY5?5=535;S=?1E7E;753A1919=53CG;59155Q;=A915A?=35557553G=?;AG1G?A797G;M97c=?7?5=EO913;;U9G=351;EIEC?5=3I3;I3=5?155K;7M9SC9;1?GCAe?;7;9S;159I53U5?A197AA;3=;W195C;9;5=ES1?G;M=E=G]759;U95=31?AC95=E;79;15A5979;MAY51;M59191G59[9I9A51;;?15G5;9O?197;35=5;95M=;MAA3515G59;;IEC973;=;35A19=e3;5Y13C?M5791;M5355[WC91A3M13=5?7K7535=?51S31?1955A5=5559A1E5=;A5W13A;515;A91M91AA;9;;7919=E=K555=53=55E1?1?O3=3M73[35M;7E;79sG;A;5;?G19A;U;5;9S135735G;G5I91A;95G13=;9A159CA?C319M1;M975;K5A;=5537A;EC95MCE51G535A191;M3Cw;;3;A1919;AC9MM513CQ=A357G9I5A5?5G=E1?55;5;[A591A?797M91;3S=355IM;?I9575?;1G3I3A=35CW5;C5;9=3=A97913S1?5AO?A[A9;5G5CQ1535;;75373=S3I97?=E=91eA5;GA553C;M3I3C3;;7KS7E5755379;C9=55E5135G753I?=3O35C3;M19A7;3IAG?1;55319;C59CEC3=95755A?;;7;MA3A1]155A_E1?;15E131i57?1Y?5C9=53CYA;;91];;5=5A3IE1;K19515?7919=5AA97M53=9I3A7E7535=9C;3A79=537;G31SE;7;QM579C;?75A5;G5E1K5;19I;Q7S9CWY1AAG9;CSM9=GM53=955I351913;;C?57;K13G5=5;A5?1E5Y73=351MA;91;3=95557?A15E5C913MSA;75G315E55=3I9;737Q51K1A3kU97G5375E7379;51;_91M9AA5=5Q=9737K153A1;9=53CM9=A9=31E5;C3C9=3ACA;3C]=5351;A9a?1351A;ME51535;=9I37955575?=M59Ay]1EO53CAS313Y=A;K5;153CK_M;CG?79=9A;19=3557S3C9135C9I3=3;=M55;9AGG5I3G=SG53159=59=35=31G59I3I9195=?=913;7;G5A3A1EG19;513C9C59;7375MSA9797G55G3C?19=31;;WA555153UEA755A35;;15;59;=Q5G57;5375W19195;1531Q13A5;75535A1w537357u57M;3GA73AA=97AM91G?1;9515?5;7;?1G319;M7;?=]1E5;1?C31S;;9S79=9SO9A;7313;15;E1313AO3IAECK15EC5M?5159;19C9OG91A9;=3=5Y35;197E=5GM;9;13;;1G35G7G3C?7;9C3OA535=]A7A9137;3GA7E19;C35M7;5EYCKU;5913I9731591;?1;35=3}A1A3AA1;91?M;73=3I;3GIG3;=EG7E=531;K;1?153;[;A?75531EM;7?=A97;K1357?51KAG;755?7531;59=EU?191E=?C53=9;1A35;M791595C5c;5AC9;1;53M=M35G7;?135;7E15K5=Q197A3I9C9AC31A;?OE=E1;319=3;A;731GG?19=3=913OG3;1KA=9A[3;CW7M55YS9I?15M?=95I3G13A7E19A13C5K51A9137S;;A375?7KAC9I3C9;CA9a535795;=53IEA731?19;=37AEO531?A1E1?G[9191u15QS;1A5G;];1G3I553C5E;5159135191?1;3;=iI95=53G159;C553Y=W51;31;5;E15A35G1G;37M;957Q7E5C;35737M37K7EM1?5C9=9137A3[9;1;313=M3AA1M35=97AE;5159k57535I5;;5G?19C;K19AA753;159;1E57?51A3=3_15?5;U3A55755M3g35519AG5=?1;5G31K=E79S5=5G3;5737E55SAIG5A973C35UK1K;73S=59G7A;?;;7;W1357;K19U59C35I3G5C5G?I9=3;[979195=SA3A1?Oc;51K755;?19[?;7;919M=31KAAC31A;3C53551]5=351G3G1M?73A;1K55=?57G;A91_AG31;?M1G?A;7?7531?=A53g3159AGg55A3;515;A35=9;G5S75Q5=55A9;195;=35I35=5M37K=3e55=3159AM135O;59G791A919=5G9I357537K=SE755K5CK7E1A;9C53G5I9=9A5;O55355GyG?GI3A197E1975M5?;Mm5E135759575G97i55737A5K7G5Y;53C355Y7;595G5=31?G5;;=3A731S;E5159=W13;1;5G5A3AG5;5=915;9;I3=W;M1M;5351EA19=;EACA9;1E579;731Q5=35I97A9=Q55aQ5G7;W7MEA153=9MG7;95CE75?;5O351A357559=319=3=9;GM5I37A;;MA53;5;I3O3G7QACAGA53C59;1591919I9Ok;?;195I5G97;5EY5=3GU3C9A79;;=;975MM?=?19I37�519;;5AG1?A1A9I535A;A=95=;9AU91AWA13=95A7A5K519A;19M51W1;95759G55155A;M3CE7?A131375;;A3A1K1M?;;AC59;A19=5E131;91S9791EA7553=5AA9153;573I37;S59=;;95G;7K;5CG;3I5E19ƒMCE=3;;IG;5G5M35C3755AM55G5?=5Ea9AM1E5=G313C3513S1]197?=315E1G9M1;;Q=95G1535G75;97GK1];191?;;75;91?55;M5[5373[?5M7Y37531?;;573S;=3G51G95191?73U;]1ME131GW_7351;9=9G195=AE=W135=A?1EI]_CAEA1A9795515?=?AA1;A5S31A53551Y3G7W15E1?1A9;;159_191559UA351E5=K;75G5eK;5CE;I9O37;K;7?=5;A3;A7M9;15;9IE7E=G3;515531E519GAI37G5;95O3753AA=5EM;IG?C315E13I97919A5137973=?579;A=91A;5G_MW5=5?57E=31;59;7;335C53G=9;75G95SAC919573M5;A19OS?A735731G?=5357;5E519731K735C3GCSQ55M;1W7535CE1979=35g3=313=?=;31;5531;9AU3I351379q19=535O55?GS=31‡5I3IEC59=;3I5c;=3C?OA313M1;9;=5GG?13575?79G1?[53G5G13G=91AK=9A7A9GUY?Y755G35=G55951KC973C53;_;7?19=?1S?C9C5;5;357;Y?1;?5=3I315K;1E5A=E51;9C5K5A73755Au5;M=GE=3;=31;;A9557A9;7YkA35;;IA53=59M=?GI535A;5Oc5737E1A9CS3153=91;M;A;3551;?7E795A797;3A1AKA=5595AM137A3AA;7Y5Y3SC9=59A5C9S;;75;3CKA=G3;7E5795A;51K;1?1;9=9;;O5K=595=;M379;7S3135797G355AI35U9153=QA15GA9;131G9A7A91EO537_;;A9;5OE515?=31?A1A?A15A?79555=3191?a?5G=5KI55K1K1AE;19U5919G5737E1KI;35CK=A9_;159;1AG5;9;GM1;95=531?;;=3;G5I;91A91?1Y5K1;973C35=9;C35G575?=SA9;;1S;?=9A7?A5C?CAE5=?C357;;59e15;A3C3551;9=5K73M5;_1595A73AC9A1?55M1;35=9Y=GE1A37;A?G;IA31q3791A;3IK15EU9AI31EA15M31?;;75;G3;=3e;7EG57595C313C?1;A9;=3AC3G1MY;5Y5?579579I53;=5;;95195C?5A=5;3G5=919CEI;A5G3A1;K1A9;75QI91K557M379A1G3I5G53=MM5Q1;?5=SG3U3G=?551E57E73C?557;9155A;3135U315G3G797c;19C3575;9GGY;M13C9575M;;E7K1AEI3M1QO3[G955759O3A5g31G3=k9;=W=5957?1G9CSA3M79=9753159G753;7EI3UAA53I5AE=53A513=;;K7313;=3=;95;735;513A7915?7W73=9=5;A3557?19A5k5U3k737E5;79M15]C5;E5M1;3=?5ACE5G7EG;1913;1A9;1KI31K73Ge5C9;G=?7A37A9A;A55=A91Q1A;Gi;753I;35;51E7351EC3;;A=AECA9I;;531Q1Q5;;CA59I5A3_1?=;5G9GC5A9131;;?AC?5G=91KGM79=K195;51;95575Q159A557?5M7M3A75A979A5A55IK5AI5597Q153=535=;9;15;?57553135O;31;5G;WAI9;;519191K;79SC3A1;?=5;AA?753;=5G9I53=313O91K7YK551A375315c;797MEIM5M3;753;C9CEk7E15W7kS9CK5C9;C9s957;3=;9=9;1E_;IAE;;7MK;1975355C3;153U35735;CA?7?1AW191?5791A;53A15379A=53A7GA9MI37E;5=35579;19A153I3A=31;A3M=EM=GWG51AG9131K1AE;1W79I55GQ5kC3MO3795=A;59O3=G?;=3G791K75G5?=9A5M13A5;1K1559M5731A9519A;753G5I9k=9I9=37E153_A=3M[9AA13=E=5357?I97;W1?S7555AM35;1;95=?=35AA1531Q1;9;5=5A351M3573;5759G=95g3Y1?5CSAE1?191?S5A=;G9C;;5GA;;53A;=31WU;GW5C3;15319s?1351553a?5=5A3;75913=E7GM;A5EOK7?759;;1AE57M35=ES15E_5=Y3[955;5O91?C55K13SO5GA35155?MA=95;=AA;?57531?U531;A;5E75?CE5;GA197591375G53O59=]=3C3Y51;A9;MA7KO97?=;9;79=KO3C?7EG=;357Y?737379I53=531K5C3A1K7373G551;31c1]_137?=AA9IW51A3575S37;K13;1?;;1G;35;73797A535G;AIA;?;131E5137?13A7E;79I3;C{M=591;3551W13C35191?1975?A=;G5597355=E=35UW5;1915E5=AA;915G9A;5;CG5;E=95S19;51M5;GA97M;?19GCA5e9U35;1MG?5C973C97A55919M5575313IM5M3a3=91535A5=MG?13GI5;A;E79153GM;A13=;;97;5E1KA575919C35;131G3;73UK=9557559G;1E5A551E5G=G?e519GA1?Aa59=;9A;;1K73IK=5?51553;1;3M;1q9I5;KA1A31G3A7;A3;7;3;1K;;=53IK1A9CA9AM135;1AAYA35791e35CM535U;375E=3aE153;=9C;37;357_91;3Y_5C59=31WA5C9=9O3515?C3I95;;5153Y=Y91M?;19O59=9U5?5191A;G3A7;35;55G5G=M?;753I9A1A?13G=;59197W;A;C95;=975313k55=5ES1;M537E73C?=535;1G3O3C919;555;1A537357;A3‰159[5A9M1G9C31;?=;G31?7?IM9;7KC31?1;G91KI357;M355159;=?;;=91KeA;5GA79=AA55A379;51AE1W7;5?=?G=S?7;53U?M19159I97K15;E;=955755G3I975955;I;K137A9;S19=?15;3=3CS5Q1;K;55MI3G55=]A1W;73=313GCEIK1A5AEG13=37351E51;3G1?7319CK557?C595MCEA7319=W1;559AM1]1;WM5=3=;5;KO91K73=3;51K7e59I?C37?MC315G9=31A5?=913G5=5G5?;A19;57;M;?O;5E1A91S55E135=3I91E1M97;9791?7?=3A=3;=AM5E15?G1AEA5C3;1K1;9=5G;;E=553AA;C55K1K13=5M?SA1A3557E5;13C3_A1cCA975A5;M91M9;G=EC5K;1K1535G1357;?;M15K;O5;;919G5519UAW;75?197A5?7;A55;9S1;?G55573I;9;;7973=5QI9519C5;3GM5C?755;W;51;5G5KO;95=?5C35AAY;=?C];A1E[91A955;5;AG1SEI3I5535;5O3=?57553=M9;1AW=535A=55K;79;5C375315;913M55;A=SAQA1;5G3C3I?7EG5A5I9=M3A73557AG9A5=M553557E;7W15535=3159;131QS7;K=595=G915975SGGS3=979M;13C?I3G137E51W1G35;;15A31Q;=A;AKA57915A37EI5591;5;9;51S3;A135G=5957555G59;A[31;595UM95I3;73A75G?575591;?C3=319I9795AC5913A1?G=5?=G35M5=;91?19;7A5A;53=?79C?13A7M91?C?AS;1E575M3IA;95737W1_;951A59CM35G55O?;O53;AI3513G[5E=]1;?C3A51A55;91M?15M3A7MEM;1A9;=E1_37951M3UM5Q153C9=3AA;1;3IA;k3G557M5EC35153;AM5S7;319M;13M5=5597G5c_5G5C59A=5919[31E;AI;35=5KOE15M3C3SM75;91E=35G1A;WI;?1;?1ES=;3=9;=;M9=M5EA19;I35=AAM3515E;S=5?A557SE=]7E73;=;E735AYA13=GK=31;?57591A31SE195=5A9=?=?;737;A35;1A;M3=5;3Ma537;3C5?;7K5=59I;97;91K7E15E73G13=31A9;A13G1MK5;15EA1G5;53555;7Q=95G13753UA3g95g;;5M3MAA795M=9[;3;A=531?=97?=M913;;1?M7;A31A5E791M;919A;515WC3;=;A;;A91ECK131KO9;5;1E51?;=Q13=;37553C5591?1E1A5EA57535=;95=5;;951MW1KO53G1E51Q=k?515?7k59IM3a;3515313=K;5C559;19G1G3;CMA3;753;5;1GGE5MC3UK=3MO35755;;9C951E=M37A;9=A97;531?CA9137E=53[A35=e313OW;A=951M5Y375?7;319=3=EGG1?;7A3735=G5?;13197k351;EC35C59C91E5UM9Y15E=5G3=973G13I9OY3IM597;E5;795G1;S3MYM515;;53C951_559AG;=957;K1M3575;35;1]AMI313UEA;7E7E5;C;5;;3;7559_1;E5A=9M557;5K5A;51;5EAC3CK;=;E7K551AG95;O9A1A97i1Q=3;515E=53=351AE153M13=;?1;5AM;K;7GE79A=?731GGWO357?C3153U?191;53U9513A5;=QCW1375;;95;7?75;35=5AEA=;?;5MCQ1]1?GCAA9CM3737M55537AG9575W5;7;_3579G1355;I319IA3C55G919A;153;79I5A9CE7?19;;7E7Y35A5;7M91E13;=95=5EC97K5=3ACA3C55?;19GM=91K1?GA;579MIK7MW19M;=9C?A15;;355U59AI;9M;79;7;91G3;=315E;51553137591W;55AI553‘AQ=559A=A35C35;79A=?57S3S;A;C9=535M19S1;?13C5E5=97357E15?GG797?G;;1?;A1Y35GC53=M;31973_=53=EG791MK5C55E197EC31357;91]C;k9CK;;55575?;;=5G95G;15379A137E79Y7YA53_1919AU3MC95[35A5;C9;51AS535=_9135=QCA35795S=5G?153I313M55=3=913;A1A3135AA=5M37W1319;51975e31_EG=AG9S7W1;?5A13=K[53=5AE5C;915;95G1AA3e19A551?=?=?5g3G13S79191;5379;51K;;=E15e91?1EC597?7S5597EM;;7559=913U55G919[3C37E55M5=95C9;557;?755A5GE1;5;553=?5AI?57957MA3515531EO9A7Q75E1E5;UA9C3195a915QOAYQ5G55A19=K79;I37cA7;979;OEA1957;3S=5;95=A3A;51EA13=?557531A91;E51;G;GA?5G;19C91A59YA5[5?=3I9g3A7E7357?=Q;5153I?AC?=E=EGU91G531Q57?A5;;13;7?5;;=315;53;G13C3;C37;G55M3U591;97E135A5OY?=YM5E1G55E7Q579=;K5;155A55?7;Q5AC35M13S;S1Y;957379=591;35=;97WC53=W5;153;51E57?I9=3C91G3=955IQ75;3[53;;7;E5=e91;;5Y9;7E7;?=35=913S_;;13G;[9I3CW5CG3;A15W15595A1;;357?;;1535=e?51;A;?79SA1S;?5=Q13M=9IY3C59C9=G31G;9;19=35;G5;13;;AACE795U?1M;97351955C5E513S=3C;E7EI5GGA35G75;91;3;19I3735=A?;A575Q5C31?1E5C3A7;5553579O97Y3I3M=55;?;=3135M;15E5C;G979M51;?;;15A9C;91?57K1W13;7;3CA?551A35A=9AA5=315M;95Y7k35C373579137K159=979G=?57MQ737;]1973MS;M;IK1G3;1?=9;5791;?M57?1G];I;;53513IA5K7G3;G975919=M?;M7;591975G35;O5EC9;51AW57;31G53AO9A5y5QI5A;95=357S;;55AK1;97E=315;97AM;;];15;3I3A_;5Y19;=3I531;9S575;E73=597;?73C5G?;;A;519GC?7957A3G=;?;13S753ACAE1A3=9GA753;1;?G=?C53y53;1AM;?C5355;AM73;79;_5=YK51919M7A31AA97;9CE;S1;9C9=3Y=;9G51?5A;5=53A51A91c131KG;A13=?M1Ge319C59A1;95I3551?1G5W=5EI3;CS;A9;I?=9C95575A?1;SoU;W1591973A5=91M357?575W[95IKI3;7;?1531?A135=?73OS;?191;M53=95=55AG591AE7E=59=K735C3797;5Q1591?[9AG7?1979;73A1S?515S5A?G1;535I5A3555C9737i[;35=9IG5G?51A3S195;=A5?=;3G;G7?1K;YI55A9;=]1A;5355=31Q1o=;E7;5G9;I3=;3I9A;1EA;a3M;=3;195O;9g5975?=;3aQ;M=5Y?19153131QC357919A7;9;=;G3GIM37A553GMGA;19519A;7G5E5C9G5;1E7KC3G137Y?M19CM5;QA51A5?155S;;?G=351;MAY97G357;W7?;155M3M;O;53=531;M5E;AU595;7G3CM955_=E7kE515;9;O31E13;197EC?O37?1QC3551;5MEOG5K5IW5=AMK19C91A95;CA?7A3GM1E1?155MM31;9;=53C55G3;G=3;A513A519G=91K55=GQ5CG;31;;3OA?AA7;M3UYA?57;K15MA5313=5]A;;735=3k5C3=E7E51537EIM59IEk;5;13=95S5A19;1A?OA3I379CG3191;3C5?15;9=35=?5GG;1M5595;1SK1G35515E;19=35Y731S;;K131;?5A55SC;53C595G1E131A3197973e;=9=31AS3MA=31AE75?=3I3I3SI375G?=;?1M5957;G?=;;YA9I9;;O357?C9CEA13A5CE;1313=9m91;?=95C3=w;59=91313C9[5W755975G;9AMA;55U?19735;;;=35=555E55=3;G5GGCM;95;7379I53C55Q51K15?579=591Q=9G;519C91G913I9GAA;5MOK1_53Y1;3;731?7?573153G1G9797;9;G;75M3O3=E=5MA3A15WG737?;A;;1?75?C97315K5C?191Q1G3;[A5G595=53=;5;;95[31;_3IQ515595[5;ECGE1979;197K737E;=W1;?5=?=31o55AO9A57K1K=K5575;915919C9M;1G;37A9=591;MG313CM;E7915531EC913M;19O9IG31ƒG373AS5G;1951EOM5Q=9C;;c75?57E;IW=5Q73M5C9A1_QACA3OM9I;5?573O53M7]57591;MY3135M73A7G9CY5;S31A5?=?75;91M59G51973195;7A{5;13a3I379G=9197;35;7M9;5;;19MI351?1915;G3IM5Y9S5=5?M1_35G79A=31A3S57M5?[955=A95;=957535Ci5C5537K1;GM59=;EA7;A9[?G15A3;=37;E51K1K1Y95YC;Q1;K1;951559C35795;=5M9;M1SE51Q7;?155Q1;559755K}1;M3;7MMM913=95AO9a9AS1M9;519GC?153A7G595C3C;;97379;75;E7e3;=3=;MK1q3MA79=355G=?G5=?5M=5919C9135C5EMq19=535M7E737EACA313O;595519195=A53I;A3M5M=;53=31A9C;3Y1?55;A755G31A;A5?1?=?;1?5=?573S5=531;A91;9AIE;153=37A9575Q5;M7]Gg?A5=?=;9;19G=;313A51Y531?;A;51;E7;9=91;;G?M5;5C;375M3O5G9=;K5I3[919;1535U?5731A951MWA57919Cq3=55E13O9;55IAQS=9Y755?=5357;3=9CE191AE579;;A;13=?=K;79Y1M9A557?137K1?;;;G;=5A3C5E75?79=973G5I3A135A;5C;?1;9M1?7Q19GC;9;5;1;5A35;=W797;5;9A19=53G=91K5137Y3;OKe[9191A3A5;C9;O?GUA37?1E5=5?79I35OG535155MA535IQ[;3137?=WA1EA13M;1;3;153A;A753S5;153753S;7E;A1553551;?=5A351A9=?O;9C5Y;9A7w35G=Q7;9I91A;K=;SK13SA55=3=979=3YOi1AQ755A9153U595CA?M19=G3I55A;3I9191K1?735=973M7?=S3S1E;75?57uMG51A?57M31Q1G9519A1;35573C;MKIE=5G?15M3OSA9;731AA37K1973=3737M5;A31W57Q159753=951;5G59OG3551555KGC5;3AO5379135=;E51QGIK13I9[531QG57M9AA5sM;A913;A1E1?=G31A537K5=31M5;?;73A;_1;53G1;9;57?79735A5=EACE;131A3A;153GS75?C5EI?75;c79A191;A?579195Y7A3I;35A;1A3=35;=G;K57;GG9197;35IA?79SGM735;1A5595;M5=5?57;W=AAA35=95;1A3=3S5515M5G53MaW19GA73=?AIS?G=S59;55Aa?I35A5579153=G5;A?5M;73S7QI9135Y5=913=5M373A;7A9=5cI5?;7A;3G;A1;9791E753g53SG;;79;19G=EC9A7;A3A131G59AG15A9O351Y3;GS=?A=EMAA1?;=9AY75;9O553;=59A;;7K57?1G5915E1?;;;=?=5G9CW1G591955C535=AE_1MG9=53M19=955GA159;5=;G;357GSE;13;O95=KCA95CA_3=?=5G3;797G5E5;1979=3;1A3C9AA1ES;;5=97AAG53;C?1;?A57531G5?;5C9=?1A9=9C53AM791A91;;5W[95;7A913I351591G?1ES731G;A37915?A1Q551?5A7G9I97E;M1313573A[31;?=5?57e5?A;CG3ACA31M3G55a357Y95AGCK7]IG31357;E7919I59A7A;3CG3M15KIG3C95=5E=3;;13;O5S5K57E=351;?GIE79=973C5GK1?7E=53GM1AE15313Y15G5;3AIME;13G;5M1E5;1AA;A9;S1KIe;9159551913191ME51EI3GIG9G13I3;;;=ME15531375;9GA5G79731979I?5;O9A1?M;I;91EA5=A;S3A7;;973575951;K1319731AKA=5;35[31M;Y?A5G=5;9731?CE13579;G1E557;5;?;=537W79;5O9AOE13CE7553A;=;3IAS53G=;95;19M=WG1G5K19C5379I5591A9C3G5=3;I3S7GKGaG3131E5IA?1;?1W7M531A3;=9C53;1A3U915K=A;K7EC35G51k9;C31;M9MA;1M9I;;A913;U313=E=9=5;;?1351?e;57?=351K=;?;C?197E15?CAK=G379C3=3AC3AM;5CE15;EMM[k9eU3=3153G;1A9155_59;=5A35=M;97M?135GI97;3I9G5CK;1?5755Q57k5G;31;9AM;51;9;5=3=;?1]GIM3I;9155319;5IMG3_753135A=;97553GA;M5191]1M97M?5;5575;;AA5A;95=?C9U9=?13=35G1?A5=?57;M3CA?19G=3M;I3=9C5?;C;G3;=;9C3A55M79A1K;A=?737A;3C?=3;=A?=;G35GA=3CG9;5G=3MC?;=9G1;W5=S59753;515E19AC9;1?=5A53C3557?1;;?=31EC;53A55A7K1k3MC5ESC95S;19=SW=9;15;37553S51;A;G553=95SCG53A1?1537KS515?A5G1A5?=;9O95137?1;53519A;=?C3=55M35A135A1}E;55795CY;ME79A;IW1;;?A57K1;95U379=53IEI957EI;A;EAO3=;W[E75951951;979153AG=313=59;GI;;3C9YU373=;3A1A919579GA73197K=5E5[?55M75AMK19159;;7535;=uI37M?C53;1A3=37Q51K=31K1E557537M37AAGW51E;5C97W19=9=3A195S5GMa?73_;AG=355=3;7SEM1E7;597355A5;155A97;?C3I315KC9S=315u1919G=?SA5;191i153A1GW;79G13MCM;37E=MQSC55GW=9=?G1MG;9;737537GS9M;1G3;A5137?=;?1;5Q7;9=3;573C535135k1979731355M=53I;;A5Q159;A[31;?CG;3I3;1;G;35CK1A;9=K1537E5759A;G=?1;5GS53I5M;979G7531K;=?575?7;375919=A537;;53G;CA31G?5M1?;=53G;=K131E5=55G9;195=919S=31E7K1A9=;9A5GIY97?C5EI3;51S;M;?13797E51;5E1E=9=?;Y7E131;EAI3C53O3197E1M553G1?A5IA597?I3;M73O975E=951Y?=A;5E513=37K;=59m531MG;979;A;1;3=553G;U535;7?7;5E7;?a9MC?5A1G535;;=;E7�O97?SAC5G;3O9=59YMC5?I3=5A95C3C5M95795135=9eG55_1K5551;5;59;A55A;1919=319=;91;95AIG9C?UA3515M5KI3AMA13AA791G5K;7597A3CQC919;5;AC53SM=3C5913A159C;?;CQI;;3;;A;7;5597;535=AK7EO?1EI3AA1E51;;G91G5;EA15A35[A3795;C9AC595755E;IM9_OG53=3;51?19195M19A=915G3C37i1GG3;5=53e5=;3C5G95O;MAKM1?S515G;?73S5C?;13=S?515;3=531379C;9A51;97;91?[9[;9735=91?G5759A135=3;7AA31A97E;M=35O37?=?;A557E=597]7?57A;?I9=3O35=9=E57;K=?5I3GC;G5AE=357;9=31GQC;A;AM535C379AC;37595=5?=_53AAO;5;9CE;7E75373=5A9IQA=3C35;;A73C?;=53AC9A15YY9C5913A7;c5=9U979753C3C?135;19=37E513A5aE=?=?7;3CG]I919;MAI9C9;7559AG1?1E7;M5A3AO;?M1SM5GE1K1?1M9G[3S=;?M197A31K1535O9IE7;G355=AA9GA;I9OEC951W5=9C553;;1319C3G;=?731K5=553;19AG5;5;7Q737A9AG51;MMA9C375919A5=5A?19155979;57]7?13G=9MC53;IA35;=97979OM;MG913G55=SA3CA975G9;7919[QIQ5=?5=G315;95a59C313S1M5;9M1?55153I3153=E=59A1E7;53mA5EM=5E79153Oq375?S1913S575597355753AAM=913G19A7973C5;9=?1q3I?A15W1S315EAO5E7913=3I;9;519;5=9MSO3=55;;3;=31AE15;A3M5C9=;5c557;53A5=A3=91;AG5E5=97M3G551AA9;kCQ75913G19MOi=3579O35C591;5G9=5GG955=59=EU3555G5C;K1?5=5M?1;35A1Q13=E7GK1A35=?=5975A9557?GC95Y153OGGE515919=A553GI3153MI3791Q5M75319G13G1KO;]=5;3G=?55=5A3A;1G5Kk;g91919=53=A9C;?5C31A9G;7?=5373=9Ga;?O;95[5Y5EY73C?U5A5M?5=3;G5=A5;A35=53C;A?19C3CG553AI955=5GA95191?=9S=97_;9=G35G1G5Ws;3575QIM9;15;35A1YK19;573S1G3;;7E13C31M53I;KG=G913=5M553M7E=Q7E7;9C5;E55=9;=3;=M?1;9=YKM;A1M915ME;7M;?1A5?1;31G35C59791A3AM1;?1951G?19A;7;9CE7KAIAE_555U35a9G;=351Q5=537KA;;1K19573513I;?5A15;AK575559;5M19759_73A5=919M=?579C31?;55CG]7EC5YS313;1KGA5551;5A9G7;53A7E=AM5;37A9O5E1u;=595;7919;C9IMA;;;9=53S57G9;57531M9A=95=9;7?55G5=97A915;35;SS5CE5137?M=5E1?191;9=M95A5I5;?=9513=35;=597313MO3=S535;13=;9C5A?579G131;95;U;97?=9w=5;59GM15E;IeA;]GG=;5915Q5137E7;?CA;A5?;159=591?O97?7951G9755?G=?75373GC;3M=9SA5;7?G=S59791K79G5C3=3135G57K735S=9551EA;=;;?1GAK;5=;95A=5EM;A=5ECAGGE15E7QI?A19e5=5?1555E55G5=E73;=3A7;3=G;535;13;;1G355795137MA9;51E1?CE15EA=35AA=35519OQC?51;3C9O35=951W5CE=MAcC?A1Q5759=5?C915]=WC5?1913[95=5Q153G=?;1MK73;=31?U;;59=K=31W1;95;19I91K7;9A57;35797E7375M53=9A=3G1K7MuA;1S3;C5E13=9C5559Y159=97;9573I373I35;13=EC9Co1;EG191;35=?515;3A7;591;?13A7W7G919C975E=SK;79;GAI;A9I?A1975?G=55K;C3I;9513=3A15SA5;97;A;9=9579;759G=M?I?;;G;1;?CAY9;1?197Ac7913=M553573CM91K1KCA;553=5EYI;A313S51A3=;;9557WACAM9;A19;5551S553A5=5E1AA313G79735a9=537GM5K1;?I9Ag535ASC31K19A;=9;1?G5Y7G;Q5I37;5MG3C9Ii7;?qC?15?5737E5557GAe3=KC;E759;A;191?;55=37G31ECK;A=53=E=K131;A3M57559M;19IA3;GC5?1;3O9G=;A351Q7A375E1AK;=G;;955C5975319=597?A153A73MMGM5=5A91{7E;7EMO59;1Q135A1379M;5=A9M73I37?5=5A913S5C97M37K1A;E15E5=9SY1;53=55919MUM;A3G579g?57?5=KC?135;7E73UE57;3=EO]575G9O3M13[;9AS51S5KAG51;3eA;OA95557E153C;35C35MA1K5;CGA;G3M;=5A5;Y55K5GI3A;55MI91?=?57MAG53=913575G91K=?SA1G?C5E5SCMG913G1Q5C;9159=357A3C5;9;7;5e97M537E7A;3M5M19I5AE5=3=97;;3G159197W155G535IY95MCE1S351Q7?5=5WC355;1SA9;79;1;A;3=9;7559G575E7E15;91A3573A75535=A5?7?;1;3=;?159Y;MAMA=95C?519M1G955G5[9a59G7A;M9A;5=;3C?57?I3G13575WG5=?=37;53;7;957;E5=K7;9C;?1GAA;E5G5[9=;Q759;=?OA3A;M755]1;53=3A;153575G351;;?;5M1351?5IA?7A;?137A;?55;1SE153G1;595Uk5;EM513C59;51Q75535I9753C35=i=5;531MQG7W79=;53Am9M75559;5;=31;?5=59=37;53737u153=3A731G5G95IE1S9;5G1?O?=5E;15K191K;7oC9=313=?1;9;5G=91MK;;5Y795S=97?S75;W;5CQ13G5;C9=K195759CKC5351K19755;9Mq1;5G5M351;E5;I55A9G55IM919735;5;C9735[K79;1K1;W5;55A;M51;591K;1?Y1Q19=5;9M51;531?7?=?7AM9AG7;;3;1WC?;G7;Q5A;75;3=;3=3A795C3M1;Y59O?5=9CEAI?1YA?1c51;;9=?S;1Q5=Q5;O59=53;5_;7;E5;1;951;3GU3A5137?13797;951;55?1EI3=3A=q3M=373=W;1E7K1K731?=9U5?C357?G519159=55G55;979G5A;;A73MMC5M55;913M1;;A;?CECKAM;AC?G5=GAGQ1EI379Aa?5731?1;?=3I59_C53C3159;73=59=;9;73MI3C5Q7553g3GO951979=951535C;K5I35CGQSA15E7KC5357;?;M1K15973C5;G3=537;A;;?1919GGAG5;O31A3OG;;535;15;35A=;355;;7Yq9;5G13;;;7k?=EC?=53AA;7MA9137E=;E;C?73I55iM1;;35759;7;_3O355;5=915;E=3159A5IA;E51W1MKC;S9[913S=595;51A373S1?19=979;=3I9MIA;?;5;753=;M35A;IAQ7;9;51;K131AW5579kC553G5=9;75?;O355A;C979=E7;31;MAGA5319G13I3=;3755?1K7?7;G3C53A75?1K197379555;U3G=]O35=?7E;15;MK;7GA55AAA;3I3=95=91;91K13=9I;E5g319=31}3131;5;35C375E1WqMOAE;7A3C]5G5C3C3A=A59=9;=5GE1555G5E791?;C3C3[;?1531?A;;1i197_3=351E13I35A1G;;?5C3M19A5=5G379G=3;=9G51W;A;A=9A;G1;M;9G=55G?U;31E7G53791AE=;A;9=?7Q15QCQM57E=G95=?;73;=;K13=?7?;=A53C97A;3753O97;3;1?G;C9A13C35=;535;131Q5G5G=319I3IE1A913;[5GK7;59;=?A551_E;7591Y91A;5K;GA1979A1S9Y7?A15E7;?S5O;35M755?;C973_15;955A13C;c_Y135C?;AC;53C;97951EA1535IG5Q13CMe313IK73AI9135;1?O5?5G5YC59137A;k5?5A5=91975M?;I5AAE5C;3U59G1W519159;19G55AC5AA;;?MAY755;5379C;?;U597?1;55Q1G5;?y5;3M5A=915KC;9CE;5155?15531G5;M;535AG;5G=GEGkY1E5;A_;1A3AC?M1;;?=3;1M9I319=W1MGK55M=9Y7;3AA;1MA;WA5;1591ECY97K7;W7M3791?G5=5;E5GC5553IQA5G79AG;=53=?S=?7W51;M;31GK5M5=;9;5y5W;1;G5K7;9AGG191?575313kCE=MK15;E7;5A5975EM159;G=3557555A319GC?5CG97W1?_13=531E1K1Qg5;5]=531G3=595I3I3A73S;519;7_;3CQ5IA3U3C?CA53O3CA?=95=5E155M31E7A95C3;;7KI5QA55CAM?1351;951AK1E;G1;;?1AAQ1WS=?7351ME19AM513AA7e;9795;=9AIE7553C31MA3;7555Q=;;591351A;9555O;M975G?GA;19S7553=3;=;9A;79;A1G?73O97E51;53753w=Me;5AG9A;5=;5G31Q7;K159=3;1MEIAEA5=E1913=53195G5=5iG1WMA;5AC?=E73OAK=K;75;;?551KCA35557;G35e;=A?5A5=5M3I?C95153M153579CE=3=535;15?7553;O;G59AY5CA;M3=3135A7EC59;7553G;=9A;=37E737E=;A9;=9CM9=35C;K557313[;9753153_7GMA?19G5=957Y;;9G;;M1?15WGA7559191K5=9;7A3[?75;37_;S553AI35OKaE;;=59I;591E1Q1KCE=31E51;?;A191?;1?57EC5379A7;w535;C3CG95=957;591919C3G1G355A7A;3573O35G551AA35G;C5GAAG35=M;;c5155?;C9MAO?=;3=951K135191?GG=535CM53G1M9C5A95S15;3A5=?551;G37G9IM;951G3C9SAI91AE73A1A3_159C3g97Q;C9[3I379A;;7KC31A973I37YM?1;9C3k57E7E75E;7A595=597;QIM9=?;5O3U53_CG3Y1W5=9CW13;;C59;73;CA5?57;3GG5C53I9G13GIA9O591?G19M=379aG5A957Y35I;;A;?19I3AC9;1G355G135CG?1?5C9AC973U91?1M9;5CA;3U?;731?1919=?5M79=?C55M;?551?=A9795S=9AAA551;M5QG57;?M;5C3M1G53G;CG53191979A5753;5=A53797;A5Q1E;_;A;5A551;QSC?=9=;;5595=3GA153C55?73CEG5U;9=53C;9;7;5;375;K;1?;7SM5M9=G5K13GC53;=55;9O355=KAAI59G7?13C35=E191K5a355=373579;731?;555O919A5G557;9S197E1AY31K1GK159AM;G=59759=5;37WCqG?551;3CY9U31597351u;7M9795755?_557e?5AA;A;1GG5?51;31W75?;;=373G5CA;A?1GAE=G53O3O9C;9;5755A9=9;C9I9=53=3;515E=9IW;13=?=9;C?C3=3557595=9O3753C915E7EC;5EACG?19;CG35;1K;AO?;;MCA;;G31A;31KI5K13k5CK197M3153[E15;357G913;O555E5137A;A351?1;95I35=559GI35CK1E5C95A;5U35I53I9=QCE=357Y3C351E73575AA3A;7MA9A;;5;1?S579G;5159=;3G;7;G373=55EA=3=59=9C9195GIK1;K7QAA55G=313[553=95M13=9OA;ECA379C?575SWS75?731?A1EAGCKAC3759191S95=59=M3IEA191;9M=3;=531;KY5g?;79=K5C55E51E1313ACA3UA35=355;13;;79;5C3A;;UE7AG951919AgG?5=55;M913;;Y79;I3C3;=5A?79I5G379UG;3;1;?7;9CAMG915G535Ae135G1915E7Q19=S535;M797MQO?7?A19=91K;155319O9195U9137?C55EC9A1Y5K=?C919[?753=5?5735=K15955wC53A;;G13C357?;A1EC9;A15;591G5;AQC?1K795S=5351_9M;1G351E;7A3579I?=3C;35759I;55SG5;K[9=919AC3C91G31?Y;795M;7;9;IE1Y5A?C59A;1919S197A?GCM31AK;A7315E55AS=Ae3557S3137K=G3M1319A5A19GM55_1E791E=;AGE7?5=9M5CA53O3G519C351]1E19C53[91GA95;=319A;G5;1Q191?5GG19G;73195;;7AA5535[5G3C5Qa;G3GC;A9I5537K=A537;;MG?5;51379;C35UA91KU9M5=5?735GI535I3[3A75SQ5;13IGG9IM53=ECK19=55E7;MA91?C9C3;U9AM=319=G?IA91AEA1A5?=313AA1;?79CM9MO;KC3=3;=957M5315MKGO9I9C35Y;5A=9797;EIE753=91A9MI55K57?1375379;C53A7S3O3C951K1913=;95m9C;5K1E1A955_55A7;5MEA1375G97i19G=E19A195;191M9G=;9=35e555=G31K5557EMU319573;57;AS9C3=;319795I357?I;?G15G35=5A;?=979AG5;C9C5E=?O979Ak1;5313CSo;A=9;A195;15973S13M57G?1;53C5M9O357;K;O919S7351;i7S95;1A;9C3MSC3G73573C;G;MGMM3=;AAA373=9;1;q35759791?791K=E791A;3=E7;5AG5919G7K;5;=3G;A51;5G591A919=35CK19A1537K7E;5;;1K;7W;7MK1?1Q75?57EO9513=91351Y3=;3C5957351Q51A9;C;3M=A9O9513S=A;?73ACYMMA91?1A3;e57_9;MC9CEA19=373CQ;M195551W13MC919=Q557E1;5K57c=W13C3;1K=5E5=?;1913;1;355=3;153153IW7eEgMEC59557;GA91K159=5QG1375E1?557E1;G355797;;K13=;35CGE;I9C53IS9O53A7M?5CA3CE=?CW75;35=957S3;15ECA553797375535=S97K1EA1G9;C35;5I3=9CEG=5?C31E15MA3AGA1G3;U;3=?551?OAG?55A=;A9CS3797;ES;;1?CEg31Q1G?M1;A5313;CGWC53IE51;M5379;73UE75919;7G?=K5C9IA?;CE13C3q1357E755G319735IK7;A9AM=S35;1559=355=Y3C3OQ7;59=357M5913=EG575?C3AM5CE73M135575355=59CA;AG535;;15QAM7A9=AYA9G5M=313A55G575;;E51?;1S9=537;;3;C;W5Gk;7;G9;1?;GMA1A?5G=591E;7EA195C37979[M5A35IiA1591GA;9755G55E_1A91AEC95;1S31AA9A5=37E7EC;535AC?5A5C3;1Y355G575K;G1;;A973=MM351E5557;A5K;5;5CEO97A5A53MA153I?=9G7;;3I?MGA153IK1K5=Ey95731GE1S3519A13AA1EM7537;55K519;C;?[31;595=595159Y;55=?MAA15Q7E153A;7;?7313C;915553ACAG3Ga9;=;9;A=951cIM3C59CE51AEGIA3I535SCW75Q13A51A957M95=55S3A7;53;5A;791GK19=E;I37A9;1A91;951E75;E15A3737;5;913=979}=EC5975SE1357AE5575;975_;319GAM15Mc_15Q1M3S515?_513=31A5;9;I?75?5;1]7?5755}E;5;=9=955;M7;Y313515;G53=9G1K1313G1Y5S3=5313O3=37e3GMA19C5373GM;7G;3M1E19573AU37K5G=9;753;7K=G?=5591W7973A1;5K13=35;O913=?1;E5;735;135=Y;;A9M5q75E1EC5G59A;[G91M9153519191A?5=Q7;9A=3C5WCAAA9=5?=9C9SC?737973C9737E5;51E13G557EI;Y9=55Q79C5?=355SM=K51AG53;=9=5?7AG_?G;575AYA9M1K19[3C]13SO9135C9A15_9=;A915A?5=9CS351;3=53A[3;1;5M;59C?5=AMK;A;15;AG3C55G3137;?19U37955U53CA3A5Y791E5I35=;91;3197?=55E1G3735795=3A191?=9Ak;5A55=M5;5?51537AG?1G3C9Y79CMM;37M537E7G3;1W7A?=E;5;1S35=9S5A51GKMA15?7AGo19=?A;735SMA51375;3=315YEI3=Q7AMQC;97K;;7Y95755Q5195Y;73A7A5355;A1YS3CAA97W=;31K5IEMAAC9=A3=G;9=;M35AG131;A3=3;5MU3A1;5E79AM;197o5M79I3=95;G=91A9=;?=3=?557M3A;557KCE1M3;73I3;IQ5GC3=91A;A537A315QS755Q7535SC53=9C;37;59;1W57E7313G557?1919O5A9I53A7A3797;3=315M;?5AM;7?;159575E=95[5_?7;5;?O973O95753=9;CQGA15535797KC3A7?5AI9CG315E5C;Q51915i5=?C97E5M1KMA=_AGE5195=SS9=;;53IE;5e5557?57GM5535=3C97EAUQ73C3197S95731?1;?C;S5?79YAG1?7M9;7c1M5?7915GGE1AY?=S5?79G5;7G5W1Q519153A7A3A1AES5M5C9731G9=K1;5E;573C5;3[?=cAC3C91MA9;G57W13I3;;19A73A73G;=?A1A5?15?=5357M?=5S5915?Iw5;973519;7A31A5553IE;57;c19C9I35;7;AK;1W1?=?=59;I;G53759191979795=?=59=?5155A913g95;IWC55EAM=A9;=59A7;55?_1K=AG3C957;957G9;5=3;7W=K7GA;?;G7973M7EG;79;1?G555CA53575ECY97AE;1G3C95=E=35GCK7M5537E7;?79=?19O53153A557M;G53=91?7k91K551M979195=K1]Y7;cAG5[35A7;E5159=;G9O35735GA753;19OA595AA7?a537A;AA5A;9GMC9=KAM=5;3=?7E=GM9C55355;;5;131;?M19O;95;1G31SMA9M;1;53CGE7?7M55?A1E15E19[;AG5?7;59G5;A=95;1G9135YU3=59kA79=G;EC53;5;I?79U;913=E5;C9A7553IA;E13I951955C?919CAE5I95=9=;MA53M=;9791G315E;5753;;C];;;=9GI?7AMEA7;E513g3=E1;5QC59O53A15919=3;;519;5=9Y=;91E755A;3C3195=KIS31;;?195CEG5GG5CS9C;5SQ=A9A;1913M;7535M=3I35;15955=AK7G53w51;9CK1?M;79O53;5A;1555;;95=?GCSc791EAUG31A95‰5159a9a;357E1?;15G;9AMA795=Y919197AA351_5?1?19;555759=31535=WC9=919A55=A9AA1E7375;;;31G];1G5Q;1]=?5C?7;3M=9=;97913G15W19195;5O91?1;AE7_3AAC;979557E19C;9=553I3[SA951;5M;E55G;=355;791;A;35=5Q1eA95=A3[5KM791591979;OEMU53;=o555;M15975A5379A=K1ME5731G;A;QA7E131E5G153C5A?5=355=3=A351?G1ƒE1913=951973CS31975?75;3A1A919A1?=K15375YE1?;19CAq91G?75AA;531A9;IK;15?IEI35G159CE55CA9A1?57;?G573131;5;A919C9191QI9_51;;3C;9G573AG=9O351S31S;5ce51;5A5?A;73;A7GKAO53A1;?1EA73C31EC;9AO5;9;573I31A59;A1975K51EMM153I;5;A313=K75357K7597A3G;;AA5=31G?A1G9=A9737G59=?;M51KI5MK;19;75EA1;97A53OE1?1E79k;5=9C591;?19197YG?5Y7919;C357Y3137?1;555G5G?73CAA;3G=5;A53;A;=?1EGY1;3=c=3CAG97?CECK55=3=;KC?19O97Q5U3;5CA3I;;;5;;357595I3C31;KA1A31?=?73M79731SM9;AUw;973=91EAs5G9C9=S55G3=531A9;=M9;1;53I;9791?5A;=9G;[55G3=91K7A95A;57;A5?MMae355O97A9=W;=913=M5?;1313GOE15;951A95qA;759=G9_;5=;9C3=Y3C9;=?1?191;53C3G15E51K5=59S195;735CEAC?I9;1Q;;I559;;=37;;?AG7Q755G31AAME13GI3A=Q=E5O531Q1E135AYI91555G3;A1;;3551A3=913A7;5;;A;97A3;A735;13a?Ck?1E5;15;951ME5SU5;A37E5135C;95G5C5355Co759575315Q515595737A957?=S3CA35G5759=553=E=9=9Y1?e51;53AOA;;59U59=;WC37591;AKC5M3C?I9CE131A9;GACA3=?=53I35=ME759S_G13551MAES19753;;MIq5MA957;3Y1E573;5;19AO5;W;759;1AK1QCK5191E79;5=5i1A5?1q53O3AY515Y9;7E5=9159CECE5O;31G9A19=M3;5CME513795;U;A35=5?5753a?7S9=5;351E51;?=53GG7A9C3A79ISE5=537i13S1;Q5=5?155?A137KA=;5E1951S3A;C]I3;;131K5I97Q;e=;9=5]7531M3I;95M55;;aA97;K7531Y95S5AC?=5QS5155SGA?13C5E15Q51;3;1E=W1“1;3;;153A7;5;37;QM579;57373A1G9C5AW5;153I5G?S7;3573791;5E1?CEC?M=MY3=5Q7QC3G1?;O?73;5;1975EC;;S35153;A1?GM7S3C97E5S5791379S13AAGM75?IK19=?159I?1;?7;9C;955…;5955;OG9=A;9OAEC53=59=35a31?1A3[3;5;1G;91;951Y591955[9O3=553753A=35579C5?CE5=?C91�79=G3S=91K5M=9Y7_9=59G7531]7?AC5?75351E1K5;1559C5WA;;1A91?191A;957913G1G35579;19CM5;A53M[KA;73C9;5U;97S?;5;7355aG;;;9=35S51K1AG3O915G?=9513=]573;=95G;=5K1A5?=5K1ESC5?1;3=;97W15;53‰;MA7A5A535;1;35C3;1Y35I97;;MAc513575355=5973135I3_15919737i7?G5515o5=5G559=MY3=35=K=?;A7M;3=559;5GA7?5G=95795[95;M1WSOGM31GQ55C3A5OG?=?1;?;5=9A;131_E15]G;;A7M;3=;;cA1951E57313=59CM55MQ=;i=55?O;5915E[A9A15S31;;537;35=;E557A35A55C9;555G7;5A9G513I;AE55CMMG?57;;555K;;5=S597595G1;]1G3SA;AA=3;A1E13CQS=A37;5GK19=GA3GGU3C3;A55=A55?Y5C9;;15;A3=3C9A75G9=A91553O3515E=?;1357AG9IK1;E=5?73;AAA5=31A;AM9S13M7K7Q5=Y95O95551_Y91A5319C35g35A;=Q57;G5A5;;5595;1A;K;57M37A3A=35791K1K5;1E=535=955=3G_7M3YA5S5;C?IKI?I3I;5S97E5M7?795M5C3=E5;5C55E7;955C35A5G73A557;53IEC?;A;C3G5C957;;5;Q7A;S3197973CA97e3=W1A5YECA351?;;51;E5=53G1;EGCGAA9C5iS135;15G35AC91?k1555G59A13=35=973CG?5M79G1?7E;;C9IK1E5GY51KCAM?G19U3;S=3G5CWI31A59=?5C3M57553=5M?;19C?C;AA?5155M535;;5;79;Y[5S3C35A19C3C9137;?15;_5SA55A37ASM?AGM5YC;?1E131E55M5OK15;9M;;[373A7;K15?=35=K=3=53A73M5O;95eC5;EI3;=;35153131Y5QM55G1;A3=9S57GE=3;7A;5?575?;5IG37K1E7G97A;91A53CA9=3C;9A13=3g9;[313753;IK19;1A955[315A;35CG?1?1975?;1?7MG5Q1AKA575E;;759;U37;E5;YI;?1351_G951?C319=315k;5;;?5G5IE1313=3CK=M9A19=E;5a5951979;;7535gGM5G53;A5GS=;Q7YA9513S755AM3;7AA5?;7;;97K75K5;15G91?;k7G9I97531AGW197;M9=;A?CW5159G159=G9191?;YO3;1EA737ME5755Q75E1AE737591A53I�A9G5;1559795;;195=35AUE55C9I91;59=A5?I;]55C91A35GAI3C535191?;1M;5;5595C35C;97G3G7EAe5AM57MY31c15Y53737A9=3M;O91?=53AS13C5G3=53A15E735M1A;3A1K5MC559A1;535C;919791;9579;;;IA91975A5G91357W;57319GC5?1AQG;M755E7YAK1351E=?=355=MQ5O37;9IAQCK7;9=W=?…;5;;?1EO?G7MA3AA=5A3;A1M97?19791973UGG31?7913G1;;3;195=?1E;791KI;915;3AA1AK;7;9Y;51E79M13I9519O5;?I3CG;975q3=95M557;9;1W5737A3;AO5AG913=?551W5575;3575?M_C3195;IW=5;9A13AC5M37;535;1;A5919A;735;[3CE=951AE13G1357A3UE=?79_=?1AGS9A=;A95S5e7Y591;M53=53C5?A5SG515;W7957;95O53;=E7;;M9;79;M7?5C31379CAA5KA7373A;=53CE1M55975;K1379;G19;A=9M7;9=91K=?IM3;OK=5;A37E791K5=5E;ACA35=E=35;C91?;=K15K13S15E1?5C9IG5E5M;1M;3551?G7A5357AK1375S31A3A=59;U;5?C5GM?15?A153=3AM19A=5A5A53A;CE7;?791i5C5A9M5C31K19M=?7559AG7G5A5A?19G=;A35=973G=;591;A;AE5;IG;35A13GA;5C?=M;37;?;1S;;K73M=E1;9=5AA;535;1E=95=3C59GY[;3=3_1A9;A=Q;[]C3=S3=EAA7?7A357E15WS7AK5=M?AA;I59=5G597?=5;97E;1591;3;=G35575;;S5K1?;135A7973;A51e?;13CE191G91;?[591;K1cCkG315WAI5G537A37;5AcU3;MG1;;59[3;159G15KM191;?1]1E1?73AA1;5;K575{=S]C9197KIG3735735GYC3;CA35G1K557E=955AM1A9a53C?=EA1;9;7;3=9159G75E7597?;=591KU9CG?5gA53;;YA73C53A131K1A53551E=;3G19=3M=;5351ES;1G351A;3A15;95=9A1;53CA?=YM53=E;1K1313AI91A53=95;O9153I3G5G=53A197E1i19S1?I5W;;=37G357?Y19A197A35C59A1AEC?AGOG?=?AA15?S;5;=9=MG53;7;9795;A137;W5m;G53G791M9UWO;Q5=59=3153G1K19_=91?1S55975A?55759753CAW7379aA9G15G9=EGI;?5C3;;7;973=3ACA55K557G913=;53CS9=3M1;5?7MK7595=9G1;AK;7;91;3;O919AC9;S7SM95=K1G955C375559195137Ee1A3AC3AS1E;7;5E5=53;=91E5;A5A1];73G19GA1K555;5Y;13g3I5;9195;1?=i5575;35=31EY51;53M79;C31M919C;957;K=5ECE13;;1A59;=?C3U595A5;G=35C;E131MA531c5=ME5;I3A=SQC?_1;5E=9C3M191?=53;CSA;357;W15319IG]79;1Y5919C9I;EC5955A=E5U31?75AE5[K;=31G59C975;QS;;=5?153YG5C3;15351G5KC373=Q5;1;53AC;5KC;K1Q75;E5G513A;5G=31Go5;O;M535;;7AK;79GA1K73;AI3;7?1A5?19C;951]5=3;M5153SS5;1GQAG5AI]1;9=3IGAEM7A35;GACE7553C5K15AM595;55I;5GK;;575A5EG=9557;E1SA3;gQ7553OE19791?M;153I37;3;1535=?5519;IKC;Q=3159Y13G;G5G19A=5Q513C951EA51A351Q7?19G7;3y537A?57;W7GA3e1351555AW19G7;K19A5=;MK51EC;9[9;1EA79C3CM9G137AA;37951919;759I59k7919AS791A5W1;9S;1?=;5G9=31?G7S957?I53S1;?7;3=3;75;9=5Q7?q75?51E51M?=9;51;59AM;1?M1;K15?573I9137A;5S?O5QI9=979C3=9;1;35ACA9=K7;Ak97Q7A?=913GCE=]Y131;951;?=55Q57?I9CG3519A;1?[95a3;=?U5Y973A7QM;7;Q;[3=;G35CGK755;;9A13=55Q57?55G51?M1;5G91MA9;5[?;I9G;5CK191A;5;Y531?;1K51375957?;=3;1?1KS5=3M197531E7K1357?5U?75E7E7E;135CA;59CMA;3753CMM5M3M;5A=9O97?55CA55A?=53YG=95=31QG7;?GA=AE=;3C53797Q57351;?1;EM579C3CSE1973A1G559;7M9C;KAG;5[3=9CA3CQCGAA597?5=;35a9;IE75G;9A1;95=9195195557;A35=K=KC;31973A1c795=5;E7E1G5GEC379A=?;1Ai1EG5GIG531M91K7W5A51;AEC9135G57A35=9753I5K1Q551SEGA7;E=5?1?1379;5;7K=59191;9ACA9;19=5GM?5UEO5319CGG9mA;31G3=55?;SI313I;A;955573;=M?=E73S13_;CQM;AG5C59CG37M3579G1?=3C5KO5;9;51M5919C9=KO9A513G1A9I35753;75EA1EC;31AGK1S;AM35;7G?G;M5=M31E5;C3=5A979;1979195C37?;7Q7W;13;CA319I3C537]57W153AI9I95AI53M=5?7G5GM5EY5;eI351?135C;;3I9AA;q=;?AC53=K;5y5Y;955A7M37A;?GA1;A919=EO9C5;AGK1;AA35737AM?7;5G35=E1A_;QAC9CK;19575313=?I9;1?;AA57919G5=3Y5_;15E;1G913a3;=3=E7K1559=31Q13C5MG5KO3C31;535=A91;3;ACGEM=E7E7E19M5G7ECM?19;5I9C3;7;975Q1MA3U;9IQ1AA37E=35O;;G;E55A5=Y59;51;K=5979O3M7535;A=5EGMMC97535M;7S5G5Q7;?A=;K5;Y;=9;7E1;3=E515E=Q=5?5U5K7G3=97Y53CEG=M;?=5MA;W7EA13=535=3I9G;7591YE575e37MYAG59;1357K=3GA7535A13;1;3G55I9737379;G=555E13;;1e91;Y5;;3G;=53=53A7913=ECE51M97QOS37?=59[M5;A37A37A5357;5W15?C?=9e;75K73S73195=]A;1;]7957A3I3I3C3;1;5E557;A53M;759C5?1?O;;3G7G5;955=E159;=?75?7E;C9;51;5G]19O9I;E51E5=?;13557E7;A3C9O31E131K5=9;19;=5S;5?5_=553G19=535G1Q=31A;5ECA3=M91K13U;3=9C;?7?I3=?7;?UM3O53=3S1E79;A1;9755535G7955=53I?1W;7979;I9551K1531?1;?1?I5QI37553=9A1?55=AEM=E155K5191?19191K73A7K=55AW7915ME;1A5Y375Q55A55=3;5C3I3=;91535e13IKCAG3135;5;1M5E15559_1Ke7cI313=_3U?5C?153;AMA1S3C95;79O3MIMAGE7;95G=91;9AA;15315EA731?CE19795=?137Y5A?5[3CE[3G;G57915A;3=;G35S;51;9;5=53=M3519UG?137E5=o5=5A59;;AAa55AG5553S1;31;535=9195CEa?1}S9G19=59;1591WA;;5;15;E=91G3SS;I5QM;CM;535SGC3;759I3Ii159_1_E=?=AK;YC?A=;9UAE5=5u=MK1E5A1A;9=K5;;51351i=5;59=E51;K79195;1AA9[;975W5519;57?=355=35[9C9I9;;73=3YI3=G9513A1G315GA9Y=;;]=K7W5579M1;91979AG=5G35C55MW;A;M51K1;;AW1?73;I35;51;K7531G31W1;AKA1E5CG5G955515G53IG9;M7;?1KGMU95[53A;7K5A15E;I3S191M537;35A;5=5M979137M9I95C9AIS?19O95M7?A1A5;37A9A1G?7?573195=5A3555CA5M3GCEA7EI;9=5E73573;C59=Q13CAA9;5579A7Q153I;?O9GA13IK55G13a3=;3;75M59AC;9=M319;AG5191M3=K1AA5?=5Q51A3=Q;5A;1M;?7313Co7;K;CE79_;19IK19;A;55S;;A19=9191A9O9A=e?=91AM3159=M35519O9G=5?5737E1G53C;9CE_O91G9=5E;197E51?C5?=5EMI3557K155?1Y5;M;957;E513C97?1K5UEC5K1_53G51A5WA7;9A753C9IM35519A7QA1M?1;915;KMO5913=913515;G]Y55=9=E51;5;91A59GOK55G19;13=A;W;573513G;1AA;91WI5W7S9GYCG55A31e?5735G513A1G559k1E75E1?;73I373=3M73I3795;1973=G;Q5797GM?CG?197Q=;975537553O37531?=9=37M;EA5[K;1?G=E1E=31?195IM53C31E5[?G1?1E=;3573;75;35=?1?1;M53IEO5ME755;;951595573I553A73GC3M15;?O9C3=379=GEA;1;35SA1A9;1?;=59AG;7Y5Q7;5Y9;7?55;A79C95[919;1?1E7973CG;;EC?AG13C;9;;=G5E=3I3C35=5M59G191A;5Q5C9C5?G7?;C3AS5755A55SK557W;;5C3U3IK=;35U;G5K7c5C;37?;AY1;53A55IA?C59;;A;75595‹55KY7;?A1;K1;313=]7E=31?A5A5=_9=31G3551YQ;1S9;1?5519AC3q1?55=31M9;;C9=5]G51;5E5135753I?;;79I91M;9C;97;9_735A1;KG=35CE73;75E=31915GEGC315K=?13MA7;95[;9=5KOK1319;;5U?57351;AW7531;E=Y9CKM1;979U3A1;9G1A?=EA;A;=95U9=5;3IECY3;1;9eC9I31G95;;5=G3IE=535O;GM3q;A;75K13CGAAQAA19735G15EI;9=35A557;95A=A3AA;MC?1;A3G;=319153I]=?7;3g31;95G19=?7?;753;753;U3;=31q;A3A1?CG?7M53=53;5=?1AK;155}5?I973CA35G7;59CW753=;M?AIK19U55M5E5I3OEC59;15E731M9M7;53=55E7G5915919O535G7KS5=95A=9AG[553I;E5;519A5=53=5;A535IM3CK19C97E5;C5?7E515919C379A1EA1S37E=5Q1A?573;M=3YS=5A3;5=9C3=KA5A5[5319AA;1G919791Y95=E57;3AU3sK7EG[?57G9A1?5C35C5E1K79OA;955G=AA55;95;AC9;CK;755A;3A51M35A=?YCA351A3;=S31E1?Ae5C3C?CE1919}5=E5Y7M3=3C9IQ5;1E=531E13;1;?;I3I;;;53A5M5791?7?5CEI535A131;;5979;eG;=9755?=?=A5379A5[955O?I3I53AC5YA3OQ=Y3C3;=;91WA7595;15A37YK1A91S9;1;9IAW55AM191;3=EA737AAGWMA;19I;?M5G19A13A1M?75A9CE7W1?731?;S5=9MM;=5;E5;79;7A3A7E197M3A_75AE51;313CQ;MCE;A555CE13=;3;GA79=979A7G;?1;3=c5A137E57;E51;K1;3O9=5E7GGE;73753A1;535AC3;C597G;951;AE=355ACEIEAG7A3=G979=3=5315;A;9;MC31A;A5G9;O913GI3MO319MM;5=K759=M?51MA97E=?7G?C5319=591?IS3C53A;=?5195M;=3I?=5;AG3;;13=E=535=?5;7Y5E;M1G3A;1Q=Y5M;9555731?1AA315EO53AC?S=;9O5]=531;A;Y5A31Q;CWA135A;1E=5A5E1559791?;A;M7A91;95;1Y3IA;G?=531MG95A[5EM=W7KM1?5g3U97979;15;EI5951WIM91;K1?G13GM15KC;9155KM13;7E7315;ECA95Y191?1;9M=?=?IGA?C3S1E5=5S59A1A31SG5Ke131;?C957;?=AA3M51;3GA;;5;7A53M5aS97Q;=5SGSK=95;7315A31357AQA7MEAGA5=537_379;135C9C?=A53;CA59O3GC;9;7375E1Y591A3=k59A55G=AK=913C;357;AM?=35G;q;S57KAM1W75G9=5E=3G1?;A1;357k97A55;W1K197Y3y53A=3;191A5S35[?5A1;91951?5=37QI;5;EU3S1;K51;5355579;=591M;?;U;?1K=5315;A;_3=95M7EG;1;53=35;73I;Y5?57G9735A5=59M7A35A1K19Y55=55Q7A35A551A91951EC9OKUA31?O91A55?A5=9;C9;5g3=915Q=3519M7cO53;IE7K5AM1?7M37KC?=9=555;9;5=?7;9A5G1;5?S=?1?I59Y5C5K5;=9=EM791;53AM1;AAE195=?=35U5535=9;1?I?1;G3;ACAE7;M?5A;GG;75cO55M9=313=A37?IKA73C9A7G?I?1WC9;7S55;K753=53OGM5K15A9=E5;7G313579C;3[91;AGA97E5;7EOKC3A7E5C?57?=5o1A313;1W555Y131;]1;91K19G;75M9A55CA535M135=3I?;Y51?;731A9Mk55S7S3;1?1W73;=55E;I379AA1;553C319_5IG55G3Me5G737E7M;3C53551K_I97_AM?g9=9I9M;M;5;CE5C;91Q55O531?;C5919=5E7;;A9C5?IK=5;;Y535;1qMA535G;19M1?Y15;9CA3U91KC5;KC;35A=?=A35155i1AA3C9C]1KG5755375351;;M?CE5;1A3A1313GOA9M13575S9U9C;9=5E55=3C91G535Sy95O;59=9G1979I319[95;;5755k;531319[KAA5=9OA37M3=E=5E7EO31357G95=55?_1;A35AY1951;EA7A;E7Q5M19;C95M_I31E13Y;557S531A9=;5KIM95C3MIY53C?551;A;M313=351975951951G31;W1M35M5Ce31KC315KC3A1?1AQ;57535=31?73;I3579;755E13G55797_95=?791?1E79;=EC;M?CS35=9S5OEa3=95;195C55K5A7A?5753I?1531e53O351?M1E51Q519U37EI;;3a5AEC9753C;3;1;M?19;7915A;AE7QC951kEC5E=957E19519;C91?=5;5E15?75E1;MM5M;5;9O?SA1]7531Q515?5755G5;559[59MS1591;K;555CKGA=35AO3I35M5O97357?=55K137YG;K1;;3=?=9519153I5?AG;=;K;M153;5=9=?7?;=A?S791?7;AQU9=31;9Y75SQI95=5E1?;s3I97Q5;19557?=E=553=95C319;79;7GA979;5C9IM31;E51?aGME=]51;9=553=G9C55?M;aA9OMKM1K7E155?;1K5M1;97E;753AU?GCS3I59;A;19A5O37;3;=3I?;5=9AC3=35=EI;913C35;=G?G1;;35A7;973CG37M375E7;E1?1?C95C_5;3I9=?1MW7973IEA;15EC37WI37E;=;3A7K;1c5=31;MW13;AI3=919=35=?55GI9G5U3I351Q51E=53G5;;M;57;A3735_;U3;7915A3CE=e;31;59;15;A59UWM19759;;;[;;;9CM9=9C;EIM9135=3;A;1595C5A;3A51A91E519;19=?5;M153A5C9M=;9519AM=3=951;A9;O5379;7K;15E_;1M95=9M57?U;A55S3=3;5;7A37;?;1?G7;E51913G1Q1E51M375S597535CM31A3;I37;WGC3A;19=;;A3ACq55G35=EA;1W1G9=91K1A59137AMEA79IWG135O91Q5=9;19ACKS579=M5QI;;9SM1E51;;9=?U53AU]5G7;9IA?=53;15919GS;735=G;MG3=951;55?=?795A51;55A97c13a31G91;;M?1?;;135573O3M1915559;5O3A;5[A5G555AW13=35I9CG;35O555GM3;;1K1KAC9=5;9C9M73e57;3C9;=?15Q1G9=A3C5c19579CM95ACEA7E131YAQ7K753=555;;G?519M5=?13IM9;5aEA5I3MI9=A5QM1G9;ACW1A?7;5G53=;MGK5135U31G9k57AKG1?1AY9;I3G=M;95;A;C?I3[M535=5373=3131;ES15E1E57595M753S=5319M=9=E7595;C9CKM;51G3S57?=?5GG1EA;197;G9=?IG37E5G1M957Y375;;5379O;97E=535A735GC?A=9U9;153=ƒWA7M9MC;;Y95A;1KCAWCE19I9=5;9=5AEM;O5E5S=?7?57A9;A1;]7E7315ECS91E5191YK1G3CS531919S5S;55=;;553=Y31;E=;9;CE7;31;97e3=5EA137?57;G53Y79;1E=?M75535AUK;155o1G5E51;A3US313C913=?=3C;3G13=W1KC?137;A;9aS3q;13;=97;9[535UA9755;A9;13C3O5E7K57�5=M537973C597;G53A5OA91A?75ME19131;ME5731GE1?CYW1SQ5551;535M;1AM;5ES5=9C9;G7K15EAO;M;]15?5737357?7595759C3C95Y1EC35A5aE;13I?73gM55A3M1357?;[35=M5?A;;7EI3O5QG1;95G7;KC3=?=3;7;355C91?GI3;A7A9;G5=5;AE1?7;_35IA?=A351913IG5AM;A5531K;1595IA9=5]5;AY5;7Q5C919=9C31;;31A?7AQ=9197;97;E;5A;15]G137A3A15G95=975;3573I?_1591?GY5=W7E7YG59AA=97AK557GKU?Ie355;MAY1?;M73759=;A951G?1AA9Y=31;55K7A?51E=9Y7E=5G5;9M7E5137?S519C;A?5I3C5W7;91?G7K=;?OAM;9AC3_1i791K=?;13=55G3M73AI91KIG3A1Y5;5?7?OG537?5=5G351M3=E7379;7;53A1;9=59ƒ=;591MKCA3513=5951A9195557q5A957;5A;M35O55MQ;=K5M19O9M513G5M755?CA355=5535;S1AG95=?55O;W=?=G5EA1A5M95;C95C;G3;1;97;M9=5979IQ5a3195;7A3;753;515;;91KSG1?;;I3S;A=31;K7W137EG;737;c7A9;M;5=9IM;5?=WG79G=313G;=5A5?CA9I;3IG3=?OK1375?755?=3O3AIM35G5=?;1;Q=?OE5MO35=k?1;K13=9AA5=55GA?5=?=;;?13=5_EA195M7351EI53191?1G5E1GM53=A;_91973CAS53G79155KAGA13=5?=37E55=5?=K5;=K1KS1KC5]795MMG1915?5735;O;3=9YA791?5=31A;A9;57E=5A9S79O_5?5A=?1G31;97MAS59G=3513=9;1Y357E79;5O5S31EMIGA9;;7K1?;1591W=SGAE7M591;913;e=55E;51?5=;;95135191A5319U5;K;755K19759=;9;S55=9_M55C957;A9;1;A;5K;19A=9=31o1915S?;19AA791W155K5M=5M3;5A5M75GAGG3A;735=KI?=91;9g553A1K51KC559CQ5;73=3S;79=535;=5A?5=5A?79O?C;AA3;5MACE1K;5;Y13=W7E7;;9S;197E=3;U5E=53S[9CG9=E51A3';


print Str2Txt("Written byxxxxxxxxxxxxxxxxxxxx");
exit;

##################################################

my $INPUT_TABLE;
my $OUTPUT_TABLE;
my $ENCODE_TABLE;
my $DECODE_TABLE;
EscapeInit();

my $E;
my $W1252 = (index(lc($0.'*>'),'cgi*>')>=0||length(ENV('UNIQUE')))?1:0;
#my $B64SET = '?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~';
my $URLSET = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|_';
my $MYSET  = 'abcdefghijklmnopqrstuvwxyzACBDEFGHIJKLMNOPQRSTUVWXYZ0123456789';

# This character set includes all letters. (52 bytes total)
my $ABC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';

# This randomized character set is used for B64 encoding and encryption.
# It includes all numbers, letters and the @ and _ characters. (64 bytes total)
my $B64SET = 'i8r0Rl1o9mqGsMeZ_PuLzBp2cNb6S4UfwWOIatHEhxVAdF5XDyCJnKY7@vQkg3jT';

# The following characters can be safely included within single quotes in
# Perl or JavaScript without having to use any escape characters. (93 bytes total)
my $SINGLE_QUOTED_SET = '^0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`~"*=+-,._/|[]{}()<>!@#$%&?:; ';

# The following characters can be safely included within double quotes in
# Perl or JavaScript without having to use any escape characters. (91 bytes total)
my $DOUBLE_QUOTED_SET = "^0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz`~'*=+-,._/|[]{}()<>!#%&?:; ";

# The following characters can be used in cookie values. (94 bytes total)
my $COOKIEJAR = '^0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$@!?*|#&%~+:-., []{}()_/\\><\"\'`';

# The following characters can be safely included in a shell command-line
# argument or between single or double quotes in Perl or JavaScript without
# needing any escape characters. (76 bytes total)
my $SHELLSET = '*0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[]{}()/!?:-._';


my $LINUX = (index(uc($^O), 'MSWIN') < 0) ? 1 : 0;
my $MSWIN = (index(uc($^O), 'MSWIN') < 0) ? 0 : 1;


#UpdateScreen("x\x1F" x 2430, 1, 1);  # Linux

my $ONLINE = 0;
my $DEBUG = 0;
#my $SEED = mag(hex(CRC($E)) * (time * $$) + hex(CRC(localtime())));  # Init RND Generator
my $HEX = '0123456789ABCDEF';
my @BIN = qw(0000 0001 0010 0011 0100 0101 0110 0111 1000 1001 1010 1011 1100 1101 1110 1111);

my $ARGS = 'a=30&time=1553863954&vx=3029C&s=TOR';
my @ARGV;
my @ARGN;
my $ARGC = 0;


      ###############################
     ##                             ##
     ##                             ##
     ##                             ##
     ##   OS-DEPENDENT FUNCTIONS    ##
     ##                             ##
     ##                             ##
     ##                             ##
      ###############################

###########################################################
#
# This function changes the video mode to 80x25 color text mode
# and updates the entire screen and moves the cursor.
# $SCREEN must be a 4000-byte string. This string must start
# with a character followed by the attributes (color).
# With no arguments, this function simply clears the screen.
# Tested using TinyPerl 5.8 with Windows XP PRO SP2 (32-bit),
# DOS Perl 5.004_02.
# Usage: UpdateScreen(SCREEN, X, Y)
#
sub UpdateScreen
{
  my $SCREEN = defined $_[0] ? $_[0] : " \x07" x 2000;
  my $X = defined $_[1] ? $_[1] - 1 : 0;
  my $Y = defined $_[2] ? $_[2] - 1 : 0;
  $X = 0 if ($X < 0);
  $Y = 0 if ($Y < 0);
  if ($OS > 2)
  {
    CLS();
    my $P;
    my $c = vec($SCREEN, 1, 8);
    my $i = 0;
    for (my $j = 1; $j < length($SCREEN) + 2; $j+=2)
    {
      $P = $c;
      $c = vec($SCREEN, $j, 8);   # Get color
      if ($c != $P)
      {
        cprintf($P, substr($SCREEN, 0, $i));
        $i = 0;
      }
      vec($SCREEN, $i++, 8) = vec($SCREEN, $j-1, 8);
    }
    if ($i) { cprintf($P, substr($SCREEN, 0, $i)); }
    MoveCursor($X, $Y);
    return;
  }
  $OS < 3 or return;
  ExecX86("\xBA" . chr($X) . chr($Y) . "\xB8\3\0\xCD\x103\xFF3\xDB\xB8\0\xB8\xB9\xD0\7\xBE\"\1P\7\x0E\x1F\xFC\xF3\xA5\xB8\0\2\xCD\x10\xC3" . $SCREEN);

# The above code is the equivalent of the
# following 8086 assembly code:
#
#	MOV	DX,<ROW><COL>	; We will use this later
#	MOV	AX,0003h	; Set video mode = 03 (80x25C)
#	INT	10h		; Call BIOS INT
#	XOR	DI,DI
#	XOR	BX,BX
#	MOV	AX,0B800h
#	MOV	CX,2000		; 80x25=2000
#	MOV	SI,OFFSET $SCREEN
#	PUSH	AX
#	POP	ES
#	PUSH	CS
#	POP	DS
#	CLD
#	REP	MOVSW		; copy $SCREEN to B800:0000
#	MOV	AX,0200h	; Move cursor position
#	INT	10h
#	RET			; Return to DOS

}

###########################################################



      ###############################
     ##                             ##
     ##                             ##
     ##                             ##
     ##     FILE I/O FUNCTIONS      ##
     ##                             ##
     ##                             ##
     ##                             ##
      ###############################


###############################################################
# 
# Checks if the argument string ends with a forward slash or
# backslash, and if it does, then removes it and returns 1,
# or returns 0 if no slash was found at the end of the string.
# Usage: INTEGER = EndsWithSlash(STRING)
#
sub EndsWithSlash
{
  my $P = defined $_[0] ? $_[0] : '';
  length($P) or return 0;
  index("\\/", substr($P, length($P)-1, 1)) >= 0 or return 0;
  chop $_[0];
  return 1;
}

###############################################################
#
# This function adds one or more lines to the end of a file.
# Returns 0 if file write operation was successful, or
# returns 1 if something was wrong.
#
# Usage: STATUS AppendTextFile(FILENAME, STRINGS...)
#

sub AppendTextFile
{
  @_ or return 1;
  my $NAME = shift;
  return 1 unless defined $NAME;
  return 1 unless length($NAME);
  @_ or return 1;
  my $DATA = join("\n", @_);
  length($DATA) or return 1;
  $DATA .= "\n";
  open(my $FILE, ">>$NAME") or return 1;
  print $FILE $DATA or return 1;
  close $FILE or return 1;
  return 0;
}

###############################################################
#
# This function writes a list of lines to a file.
# Returns: 1=SUCCESS, 0=FAILURE
#
# Usage: INTEGER WriteTextFile(FILENAME, STRINGS...)
#

sub WriteTextFile
{
  my $NAME = shift;
  my $DATA = join("\n", @_);
  open(my $FILE, ">$NAME") or return 0;
  print $FILE $DATA or return 0;
  close $FILE or return 0;
  return 1;
}
##############################################################
#
# This function simplifies a path by removing
# repeated backslash/forward slash characters, and
# tries to resolve the "." and ".." in a path name
# to have literal names only. v2019.5.26
#
# Usage: STRING = SimplifyPath(STRING)
#
sub SimplifyPath
{
  @_ or return '';
  my $P = shift;
  defined $P or return '';
  length($P) or return '';
  $P = Trim($P);
  $P =~ tr#\\#/#;
  if (uc(substr($P, 0, 8)) eq 'FILE:///') { $P = substr($P, 8, length($P)); }
  $P =~ s|///|/|g;
  $P =~ s|//|/|g;
  my $DRIVE = (vec($P, 1, 8) == 58) ? vec($P, 0, 8) & 223 : 0;
  if ($DRIVE) { $P = substr($P, 2, length($P)); }
  my $SLASH = (vec($P, 0, 8) == 47) ? 47 : 0;
  if ($SLASH) { $P = substr($P, 1, length($P)); }
  my @A = split('/', $P);
  for (my $i = 0; $i < @A; $i++)
  {
    if ($A[$i] eq '.') { splice(@A, $i, 1); $i--; }
    if ($A[$i] eq '..') { if ($i > 0) { splice(@A, --$i, 2); $i--; } else { splice(@A, $i, 1); $i--; } }
  }
  return ($DRIVE ? chr($DRIVE) . ':' : '') . ($SLASH ? '/' : '') . join('/', @A);
}
##################################################

# Usage: STRING = _FileName(\@_) - Removes the first argument from @_ just like shift() does and returns a file name. This function does not check syntax, but it does remove some illegal characters (<>|*?) from the name that obviously should not occur in a file name. If the file name doesn't contain any valid characters, then returns an empty string.
sub _FileName { @_ or return ''; my $N = shift; $N = shift(@$N); defined $N or return ''; length($N) or return ''; my $c; my $j = 0; my $V = 0; for (my $i = 0; $i < length($N); $i++) { $c = vec($N, $i, 8); next if ($c == 63 || $c == 42 || $c < 32); last if ($c == 60 || $c == 62 || $c == 124); if ($c > 32) { $V = $j + 1; } if ($V) { $i == $j or vec($N, $j, 8) = $c; $j++; } } return substr($N, 0, $V); }

# Usage: STATUS = WriteFile(FILE_NAME, STRING, [FILE_PTR]) - This function overwrites a portion of a binary file with STRING. Returns 1 if succeeded or returns 0 if something went wrong.
sub WriteFile { my $F = _FileName(\@_); length($F) or return 0; @_ or return 0; my $S = shift; defined $S or return 0; my $P = @_ ? shift : 0; defined $P or return 0; $P >= 0 or return 0; my $Z = -s $F; defined $Z or $Z = 0; $Z > 0 or $Z = 0; open(my $H, "+<$F") or return 0; binmode $H; if (length($S)) { if ($P) { sysseek $H, $P, 0; } print $H $S or return 0; } close $H or return 0; return 1; }

# OLD VERSION:
# This function overtwrites a file with a string. Returns the number of bytes written (new size of file).
# Usage: NEW_FILE_SIZE = WriteFile( FILENAME, STRING )
# sub WriteFile { @_ or return 0; my $NAME = shift; my $DATA = @_ ? shift : ''; my $LEN = length($DATA); open my $FILE, '>', $NAME or return 0; binmode $FILE; print $FILE $DATA; close $FILE or return 0; return (-s $NAME == $LEN) ? $LEN : 0; }
#

##################################################
#                                      v2020.07.04
# Writes a string to the end of a file.
# Returns 1 on success or 0 if something went wrong.
#
# * When this function is called with two arguments only,
# the file must already exist before anything can be
# written, or the operation will fail.
#
# * When some value is passed in the third argument,
# the file will be created if it didn't exist already.
#
# Usage: STATUS = AppendFile(FILE_NAME, STRING, [CREATE_FILE])
#
sub AppendFile
{
  return 0 if @_ < 2;
  my $F = defined $_[0] ? $_[0] : '';
  $F =~ tr/*?<>|\r\n//d;      # Remove illegal characters from file name.
  length($F) or return 0;
  if (-f $F)                  # File already exists:
  {
    defined $_[1] or return 1;  # Nothing to write.
    length($_[1]) or return 1;  # Nothing to write.
  }
  else                        # File doesn't exist yet:
  {
    defined $_[2] or return 0;  # Operation fails.
  }
  open(my $H, ">> $F") or return 0;
  print $H (defined $_[1] ? $_[1] : '') or return 0;    # Write data
  close $H or return 0;
  return 1;
}
##################################################

# Usage: HANDLE = OpenFileForReading(FILE_NAME) - Opens file for reading.
sub OpenFileForReading { my $F = _FileName(\@_); length($F) or return -1; -f $F or return -1; -s $F or return -1; my $HANDLE; open $HANDLE, "<$F" or return -1; return $HANDLE; }

# Usage: Readtil(FILE_HANDLE, LINE) - Moves the file pointer to a position right after LINE. The search is non-case sensitive. Each line is trimmed before comparison.
sub Readtil { @_ > 1 or return; my $H = shift; defined $H or return; return if ($H == -1); my $S = uc(Trim(shift)); length($S) or return; while (my $L = <$H>) { return if (index(uc(Trim($L)), $S) == 0); } }

# Usage: ARRAY = ReadLinex(HANDLE, [N]) - Reads N number of lines from an opened file handle and returns an array.
sub ReadLines { my @A; @_ or return @A; my $H = shift; defined $H or return @A; return @A if ($H == -1); my $M = @_ ? shift : 99999999; defined $M or return @A; $M or return @A; -f $H or return @A; -s $H or return @A; my $i = 0; while (my $L = <$H>) { $A[$i++] = Trim($L); $i < $M or last; } return @A; }

# Usage: ARRAY = ReadTextFile(FILE_NAME, [LIMIT]) - Reads the contents of a text file and returns the lines in an array. If a second argument is provided, then only the first few lines will be processed. Each line is trimmed before it is stored.
sub ReadTextFile { my @A; my $F = _FileName(\@_); length($F) or return @A; my $M = @_ ? shift : 99999999; defined $M or return @A; $M or return @A; -f $F or return @A; -s $F or return @A; my $H; my $B; my $i = 0; open $H, "<$F" or return @A; while (my $L = <$H>) { $A[$i++] = Trim($L); $i < $M or last; } close $H; return @A; }

# OLD VERSION: This function reads no more than N number of lines from a text file and returns the contents as an array. Will DIE() if the file doesn't exist.
# Usage: ARRAY ReadTextFile(FILENAME, N)
# sub ReadTextFile { my $NAME = shift; my $N = shift; my $i = 0; my @DATA; DIE(4) unless (-f $NAME); open my $FILE, '<', $NAME or return @DATA; while (my $LINE = <$FILE>) { last if ($i >= $N); $DATA[$i++] = Trim($LINE); } close $FILE; return @DATA; }
#

##################################################
#                                       v2020.6.11
# Reads a single line from a file and returns a string without
# line breaks. This function can read the Nth line of a file,
# and it can also limit the size of the returned string.
# Usage: STRING = ReadLine(FILENAME, [LINE_NUMBER, [MAX_BYTES_TO_READ]]])
#
sub ReadLine
{
  my $NAME = defined $_[0] ? $_[0] : '';
  $NAME =~ tr/\"\0*?|<>//d;  # Remove special characters from file name
  length($NAME) or return '';
  -e $NAME or return '';     # Check if file exists
  -f $NAME or return '';     # Check if file is plain file
  -s $NAME or return '';     # Check file size
  my $LINE = defined $_[1] ? $_[1] : 0;
  $/ = "\n";
  local *FH;
  open FH, "<$NAME" or return '';  # Open file for reading
  foreach my $R (<FH>)                # Read file line by line
  {
    if (--$LINE < 0)
    {
      $LINE = $R;
      last;
    }
  }
  close(FH);
  $LINE =~ tr/\r\n//d;    # Remove any new line characters
  defined $_[2] or return $LINE;
  length($LINE) > $_[2] or return $LINE;
  return substr($LINE, 0, $_[2]);
}
##############################################################


      ###############################
     ##                             ##
     ##                             ##
     ##                             ##
     ##      STRING FUNCTIONS       ##
     ##                             ##
     ##                             ##
     ##                             ##
      ###############################




##################################################
#                                       v2022.2.27
# This function compresses a string using run-length
# compression method, and it is used exclusively by
# the SaveRGB() function, which saves an image in
# SGI RGB format. SGI's RGB file format can save
# 24-bit true color images in compressed
# or uncompressed format.
#
# This function counts repeating characters and replaces
# them with a number that indicates how many times
# it is repeated, followed by the character that is
# to be repeated. If the function encounters a series
# of different bytes which cannot be compressed, it
# saves the number of characters, followed by the
# literal characters.
# The maximum length of a block is 127 bytes.
# So, for example, if 2000 bytes cannot be compressed,
# then they will be divided into 15 blocks, each block
# holding 127 bytes, and another block holding 95 bytes.
#
# If the highest bit of the block length is zero, it
# indicates that the following character is to be repeated.
# If the highest bit is 1, it indicates that the following
# block contains uncompressed bytes.
#
# Usage: STRING = SGI_Compress(STRING, START, LENGTH)
#
sub SGI_Compress
{
  my $PTR = $_[1];
  my $LEN = $_[2];
  my $LAST = $PTR + $LEN;
  my ($c, $FLUSH, $REP_COUNT, $DIFF_COUNT, $OUTPUT, $prev) = (-1, 0, 0, 0, '');
  for (my $i = $PTR; $i <= $LAST; $i++)
  {
    $prev = $c;
    $c = vec($_[0], $i, 8);    # Read next byte.
    
    if ($i == $LAST)
      { $FLUSH = ($DIFF_COUNT || $REP_COUNT <= 1) ? 2 : 1; }   # Flush last chunk

    if ($c == $prev)
    {
      $REP_COUNT++;
      if ($i == 1) { $DIFF_COUNT = 0; }
      if ($REP_COUNT == 2)    # Three repeated characters already?
      {
        if ($DIFF_COUNT)
          { $FLUSH = 2; }     # Write raw bytes to output, because repeated characters are coming next...
      }
    }
    else
    {
      $i or next;
      $DIFF_COUNT++;
      $PTR >= 0 or $PTR = $i;
      if ($REP_COUNT >= 2)
        { $FLUSH = 1; }
      elsif ($REP_COUNT == 1)
      {
        $REP_COUNT = 0;
        $DIFF_COUNT++;
      }
    }

    if ($FLUSH == 1)
    {
      $REP_COUNT++;
      while ($REP_COUNT > 0)    # Save repeated character
      {
        my $REP = $REP_COUNT >= 127 ? 127 : $REP_COUNT;
        $OUTPUT .= chr($REP) . chr($prev);
        $REP_COUNT -= 127;
      }
      $REP_COUNT = 0;
      $DIFF_COUNT = 0;
      $FLUSH = 0;
      $PTR = $i;
    }
    elsif ($FLUSH == 2)
    {
      while ($DIFF_COUNT > 0)           # Save 127-byte block at a time
      {
        my $REP = $DIFF_COUNT > 127 ? 127 : $DIFF_COUNT;
        $OUTPUT .= chr($REP | 0x80) . substr($_[0], $PTR, $REP);   # Save raw bytes
        $DIFF_COUNT -= 127;
        $PTR += 127;
      }
      $DIFF_COUNT = 0;
      $FLUSH = 0;
      $PTR = -1;
    }
  }
  return $OUTPUT . "\0";
}
##################################################
#                                       v2022.2.27
# This function expands a compressed string starting
# at PTR and stops when it reached a length of STR_LEN.
#
# Usage: STRING = SGI_Expand(COMPRESSED_STRING, START, LENGTH)
#
sub SGI_Expand
{
  my $PTR = $_[1];
  my $LEN = $_[2];
  my $OUTPUT = '';

  my $L = length($_[0]) - $PTR;
  while ($L--)
  {
    my $N = vec($_[0], $PTR++, 8);
    if ($N == 0) { last; }      # END OF ROW
    if ($N & 128)
    {
      $N &= 127;
      # Just copy N bytes
      if ($N >= $LEN) { return $OUTPUT . substr($_[0], $PTR, $LEN); }
      $OUTPUT .= substr($_[0], $PTR, $N);
      $PTR += $N;
    }
    else
    {
      # Repeat next byte N times
      my $c = substr($_[0], $PTR++, 1);
      if ($N >= $LEN) { return $OUTPUT . ($c x $LEN); }
      $OUTPUT .= $c x $N;
    }
    $LEN -= $N;
  }
  if ($LEN) { $OUTPUT .= "\0" x $LEN; }
  return $OUTPUT;
}
##################################################
#                                        v2021.2.2
# This function is similar to JavaScript's built-in
# escape() function, however this compresses repeated
# characters, so it will produce smaller data.
# Usage: STRING = EscapeString(STRING)
#
sub EscapeString
{
  my $S = defined $_[0] ? $_[0] : '';
  my $LP = length($S) - 1;
  my $c = -1;
  my $prev;
  my $X = 1;
  my $HIGH_BITS = 0;
  my $REPEAT = 0;
  my $OUTPUT = '';
  my $ESC = './-+';

  # Initialize lookup tables
  defined $OUTPUT_TABLE && defined $ENCODE_TABLE or EscapeInit();

  # Storing the string's length is necessary
  # to prevent BREACH attacks.
  $OUTPUT = Num2Set($LP, $OUTPUT_TABLE) . '*';

  for (my $i = 0; $i <= $LP; $i++)
  {
    $X = $HIGH_BITS;
    $prev = $c;
    $c = vec($S, $i, 8);
    if ($c & 128)
    {
      $HIGH_BITS = $c & 192;
    }
    else
    {
      $c = vec($DECODE_TABLE, $c & 127, 8);
      $HIGH_BITS = $c & 64;
    }
    $c = vec($OUTPUT_TABLE, $c & 63, 8);

    # Compress repeating bytes
    if ($HIGH_BITS == $X && $c == $prev && $REPEAT < 66 && $i < $LP)
    {
      $REPEAT++;
    }
    else
    {
      # When we have 3-66 repeating characters in a row,
      # we remove the repeats and replace them with the '*' byte
      # followed by the length, which is encoded into one byte.
      # Thus we shorten 4 repeating characters into 3.
      # To shorten the string and replace some of its last
      # couple of bytes, we use the substr() function.
      # When substr() is used this way, the string argument
      # must be at least 3 bytes long. We know, at this point,
      # $OUTPUT is at least 3 bytes long, so we're safe!
      if ($REPEAT > 2) { substr($OUTPUT, length($OUTPUT) - $REPEAT + 1) = '*' . substr($OUTPUT_TABLE, $REPEAT - 3, 1); }
      $REPEAT = 0;
    }
    $OUTPUT .= ($HIGH_BITS == $X ? '' : substr($ESC, $HIGH_BITS >> 6, 1)) . chr($c);
  }
  return $OUTPUT;
}
##################################################
#                                       v2021.1.31
# This function converts a plain text input string
# to a binary string. It is the opposite of the
# EscapeString() function.
# Usage: STRING = UnescapeString(STRING)
#
sub UnescapeString
{
  my $S = defined $_[0] ? $_[0] : '';
  my ($OUTPUT, $ESC, $LP, $c) = ('', 1, length($S) - 1);
  my @HI = (128, 0, 128, 0, 0);
  my @LO = (64, 0, 0, 0, 64);

  # Get string length
  my $i = index($S, '*');
  if ($i < 0 || $i > 6) { return ''; }
  my $MAXLEN = Set2Num(substr($S, 0, $i), $OUTPUT_TABLE);

  # Initialize lookup tables
  defined $INPUT_TABLE && defined $DECODE_TABLE or EscapeInit();

  for ($i++; $i <= $LP && length($OUTPUT) <= $MAXLEN; $i++)
  {
    $c = vec($S, $i, 8);
    if ($c > 47)
    {
      $c = vec($INPUT_TABLE, $c, 8);
      if ($HI[$ESC])
      {
        $c = chr($c | $LO[$ESC] | 128);
      }
      else
      {
        $c = vec($ENCODE_TABLE, $c | $LO[$ESC], 8);
        $c = chr($c | $HI[$ESC]);
      }
      $OUTPUT .= $c;
    }
    elsif ($c > 42)                     # Control character
    {
      $ESC = $c - 43;
    }
    elsif ($c == 42 && $i && $i < $LP)  # Compressed data
    {
      $c = vec($S, ++$i, 8);
      $c = vec($INPUT_TABLE, $c, 8) + 2;
      $OUTPUT .= substr($OUTPUT, length($OUTPUT) - 1, 1) x $c;
    }
  }
  return $OUTPUT;
}
##################################################
#                                        v2021.2.2
# This function is called by EscapeString() or
# UnescapeString() in order to initialize
# some global variables.
# Usage: EscapeInit()
#
sub EscapeInit
{
  # Create ENCODE/DECODE TABLE:
  my $LO  = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXY-. ';
  my $HI  = "|@#\$!?%&*`^~+:=Z,/\\[]{}()<>;_\"'\t\r\n\0\1\2\3\4\5\6\x07\x08\x0b\x0c\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x7f";
  $LO = ShuffleStr($LO, $SEED);
  $HI = ShuffleStr($HI, $SEED);
  $ENCODE_TABLE = $LO . $HI;
  $DECODE_TABLE = CreateReverseTable($ENCODE_TABLE);

  # Create INPUT/OUTPUT TABLE:
  $OUTPUT_TABLE = '_@0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  $OUTPUT_TABLE = ShuffleStr($OUTPUT_TABLE, $SEED);
  $INPUT_TABLE  = CreateReverseTable($OUTPUT_TABLE);
}
##################################################
#                                        v2021.1.6
# This function checks if STRING contains any
# of the words that occur in SUBSTR separated by
# | characters. The comparison is not case sensitive.
# Returns the position after SUBSTR if found,
# or zero if none matched.
# Usage: INTEGER = test(STRING, SUBSTR)
#
sub test
{
  my $S = defined $_[0] ? uc($_[0]) : '';
  my $M = defined $_[1] ? uc($_[1]) . '|' : '';
  my $Start = -1;
  my $End = 0;
  my $c;
  for (my $i = 0; $i < length($M); $i++)
  {
    $c = vec($M, $i, 8);
    if ($c == 124)
    {
      if ($Start >= 0)
      {
        $c = index($S, substr($M, $Start, $End - $Start + 1));
        $c < 0 or return $c + ($End - $Start);
      }
      $Start = -1;
      $End = 0;
      next;
    }
    if ($c > 32)
    {
      $End = $i;
      $Start >= 0 or $Start = $i;
    }
  }
  return 0;
}
##################################################
#                                        v2021.1.7
# This function searches for a substring and
# returns either the string following or preceding
# the match depending on the value of CMD.
# CMD is a hexadecimal number that tells the function
# how to match and which part of the string to return.
#  0x00001 : Return the string AFTER the substring.
#  0x00010 : Return the string BEFORE the substring.
#  0x00100 : If the match isn't found, return the whole string.
#  0x01000 : Convert string to uppercase before matching.
#  0x10000 : Start searching from the end of string.
# These values can be combined with OR.
# In addition, this function also works like the
# split() method. It splits string along substring
# and returns the first part in $a and the second
# part in $b. If substring is not found,
# $a and $b will be empty strings.
#
# Usage: STRING = cut(STRING, SUBSTR, [CMD])
#
sub cut
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $SUB = defined $_[1] ? $_[1] : '';
  my $CMD = defined $_[2] ? $_[2] : 0x111;
  my $P = ($CMD & 0x1000)  ?
    (($CMD & 0x10000) ? rindex(uc($STR), $SUB) : index(uc($STR), $SUB))
   :
    (($CMD & 0x10000) ? rindex($STR, $SUB) : index($STR, $SUB));
  $a = $b = '';
  $P < 0 and return ($CMD & 256) ? $STR : '';
  $a = substr($STR, 0, $P);
  $b = substr($STR, $P + length($SUB));
  return ($CMD & 16 ? $a : '') . ($CMD & 1 ? $b : '');
}
##################################################
#                                        v2021.1.5
# This function adds to the ASCII value of each
# character, shifting values either up or down.
# CHARSET defines what characters are allowed in
# the set. DIRECTION should be either a
# positive or a negative number.
# Usage: STRING = ShiftRStr(STRING, DIRECTION, CHARSET)
#
sub ShiftRStr
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $DIR = defined $_[1] ? $_[1] : 1;
  my $SET = defined $_[2] ? $_[2] : $COOKIEJAR;
  my $SL = length($SET);
  my $NEG = $DIR < 0 ? 1 : 0;
  my $SEED = abs($DIR);
  my $ADD;
  my $c;
  for (my $i = 0; $i < length($STR); $i++)
  {
    $c = index($SET, substr($STR, $i, 1));
    $c >= 0 or $c = 0;
    $SEED = ($SEED * 539 + 5321) & 0xFFFF;
    $ADD = ($SEED >> 4) & 63;
    if ($NEG) { $c += $SL - $ADD; } else { $c += $ADD; }
    $c %= $SL;
    vec($STR, $i, 8) = vec($SET, $c, 8);
  }
  return $STR;
}
# SHORT VERSION:
# This function adds to the ASCII value of each character, shifting values either up or down. CHARSET defines what characters are allowed in the set. DIRECTION should be either a positive or a negative value.
# Usage: STRING = ShiftRStr(STRING, DIRECTION, CHARSET)
# sub ShiftRStr { my $STR = defined $_[0] ? $_[0] : ''; my $DIR = defined $_[1] ? $_[1] : 1; my $SET = defined $_[2] ? $_[2] : $COOKIEJAR; my $SL = length($SET); my $NEG = $DIR < 0 ? 1 : 0; my $SEED = abs($DIR); my $ADD; my $c; for (my $i = 0; $i < length($STR); $i++) { $c = index($SET, substr($STR, $i, 1)); $c >= 0 or $c = 0; $SEED = ($SEED * 539 + 5321) & 0xFFFF; $ADD = ($SEED >> 4) & 63; if ($NEG) { $c += $SL - $ADD; } else { $c += $ADD; } $c %= $SL; vec($STR, $i, 8) = vec($SET, $c, 8); } return $STR; }
#
##################################################
#                                        v2021.1.2
# This function swaps two characters in a string,
# modifying the string that was passed to it.
# Usage: SwapChar(STRING, PTR1, PTR2)
#
sub SwapChar
{
  my $c = vec($_[0], $_[1], 8);
  vec($_[0], $_[1], 8) = vec($_[0], $_[2], 8);
  vec($_[0], $_[2], 8) = $c;
}
# SHORT VERSION:
# This function swaps two characters in a string, modifying the string that was passed to it.
# Usage: SwapChar(STRING, PTR1, PTR2)
# sub SwapChar { my $c = vec($_[0], $_[1], 8); vec($_[0], $_[1], 8) = vec($_[0], $_[2], 8); vec($_[0], $_[2], 8) = $c; }
#
##################################################
#                                       v2020.7.18
# This function inserts a space between each
# character of the input string. If a second
# argument is provided, then that will serve
# as the separator.
#
# Usage: STRING = InsertBetweenChars(STRING, [SEPARATOR])
#
sub InsertBetweenChars
{
  @_ > 0 or return '';
  my $SEPARATOR = defined $_[1] ? $_[1] : ' ';
  my @C = split(//, $_[0]);
  return join($SEPARATOR, @C);
}
##################################################
#                                        v2019.9.8
# Creates a random string of letters and numbers.
# Usage: STRING = RandomString(LENGTH)
#
sub RandomString
{
  my $i = defined $_[0] ? $_[0] : 0;
  my $A = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  my $S = '';
  while ($i--)
  {
    vec($S, $i, 8) = vec($A, int(rand(length($A))), 8);
  }
  return $S;
}
##################################################
# Generates a random binary string.
# Usage: STRING = RandomBinary(LENGTH)
#
sub RandomBinary
{
  my $i = defined $_[0] ? $_[0] : 0;
  my $S = '';
  while ($i--)
  {
    vec($S, $i, 8) = int(rand(256));
  }
  return $S;
}
##################################################
#
# This function searches STRING to see if any of its
# characters match any of the characters of SUBSTR.
# Returns 1 if a match was found; returns 0 otherwise.
# Usage: INTEGER = FindChar(STRING, SUBSTR)
#
sub FindChar
{
  defined $_[0] && defined $_[1] or return 0;
  length($_[0]) or return 0;
  my $i = length($_[1]);
  while ($i--)
  {
    index($_[0], substr($_[1], $i, 1)) < 0 or return 1;
  }
  return 0;
}
##################################################
#
# This function counts how many times STRING
# contains any of the characters of SUBSTR.
# Usage: INTEGER = CountChars(STRING, SUBSTR)
#
sub CountChars
{
  @_ > 1 or return 0;
  my $S = shift; defined $S or return 0; length($S) or return 0;
  my $L = shift; defined $L or return 0; length($L) or return 0;
  my $P;
  my $i = length($L);
  my $N = 0;
  while ($i-- > 0)
  {
    $P = 0;
    while (($P = 1+index($S, substr($L, $i, 1), $P)) > 0)
    { $N++; }
  }
  return $N;
}
##################################################
#                                        v2020.8.2
# This function counts how many times STRING contains
# a character which is provided in the second argument.
# Usage: INTEGER = CountChars(STRING, STRING)
#
sub CountChar
{
  defined $_[0] or return 0;
  defined $_[1] or return 0;
  my ($i, $C, $L) = (0, 0, length($_[0]));
  while ($i < $L)
  {
    ($i = index($_[0], $_[1], $i) + 1) or last;
    $C++;
  }
  return $C;
}
##################################################
#                                      v2019.11.23
# Counts how many times SUBSTR occurs in STRING and
# returns the number. The search is case sensitive.
# Usage: INTEGER = CountStr(STRING, SUBSTR)
#
sub CountStr
{
  defined $_[0] or return 0;
  defined $_[1] or return 0;
  (my $LA = length($_[0])) or return 0;
  (my $LB = length($_[1])) or return 0;
  $LA >= $LB or return 0;
  my $COUNT = 0;
  for (my $i = 0; $i < $LA; $i += $LB)
  {
    $i = index($_[0], $_[1], $i);
    $i >= 0 or last;
    $COUNT++;
  }
  return $COUNT;
}
##################################################
#                                      v2019.11.10
# This function works just like the index() function
# except it can compare more than one string. It will
# return 0 if there is no match. Returns 1 if the first
# substring was found. Returns 2 if the second substring
# was found or 3 if both the first and second were found...
# Usage: INTEGER = Find(STRING, SUBSTR1, [SUBSTR2...])
#
sub Find
{
  my $BIT = 1;
  my $S = shift;
  my $FOUND = 0;
  while (@_)
  {
    $FOUND |= index($S, shift) < 0 ? 0 : $BIT;
    $BIT <<= 1;
  }
  return $FOUND;
}
##################################################
#                                        v2020.8.2
# This function removes and returns the first word
# from a string separated by the "|" character.
# Usage: STRING = ShiftString(STRING)
#
sub ShiftString
{
  defined $_[0] or return '';
  my $P = index($_[0], '|');
  if ($P < 0)
  {
    $P = $_[0];
    $_[0] = '';
    return $P;
  }
  my $S = substr($_[0], 0, $P++);
  $_[0] = substr($_[0], $P);
  return $S;
}
##############################################################
#
# This function scans a string looking for special characters
# and determines what percentage of the string is plain text
# and also tries to determine the text format.
#
# Returns an integer whose lower 8 bits is the percentage (0-100).
# Bit 9 will be set if any LF characters were found.
# Bit 10 will be set if any CR characters were found.
# Bit 11 will be set if there are equal number of CR and LF
# characters in the string. These can be interpreted as follows:
#
#   000 = Format is undetermined.
#   001 = LINUX string (LF only)
#   010 = OSX string (CR only)
#   011 = MIXED format
#   111 = DOS text (CR-LF pairs)
#
# Usage: INTEGER = isText(STRING)
#
sub isText
{
  defined $_[0] or return 100;
  my $L = length($_[0]);
  $L or return 100;

  # We will simply count the number of plain text characters
  # and the number of CR and LF characters in the string.

  my $TOTAL = $L;   # Total length of string
  my $C;
  my $TX = 0;       # Number of plain text characters
  my $CR = 0;       # Number of 0D characters
  my $LF = 0;       # Number of 0A characters

  while ($L--)
  {
    $C = vec($_[0], $L, 8);
    next if ($C > 126);
    if ($C > 31 || $C == 9) { $TX++; next; }
    $LF++ if ($C == 10);
    $CR++ if ($C == 13);
  }

  # Now, we will try to determine what type of string
  # we're dealing with. There are 5 possibilities:
  # LINUX, DOS, OSX, MIXED, or "undetermined."
  #
  # Explanation of formats:
  # * OSX files contain CR characters as line break.
  # * Linux text files contain LF characters as line break.
  # * DOS text files contain an equal number of CR and LF
  #   characters in pairs.
  # * "MIXED" means that the string contains an unequal number of
  #   both CR and LF characters, so this may be a binary string.
  # * "Undeteremined" means that the string does not contain
  #   any line break characters at all, so it could be either
  #   a DOS text or Linux text or anything.

  $C = $LF ? 0x100 : 0;   # We use $C to store the string format.
  $C |= 0x200 if ($CR);
  $C |= 0x400 if ($CR == $LF);

  # The percentage is stored in the lower 7 bits,
  # and the format is stored in bits 9-11.
  return $C | int(($TX+$LF+$CR) / $TOTAL * 100);
}

##############################################################
#
# This function XORs each byte of a string
# with an integer and returns a new string.
# Usage: STRING = StrXOR(INTEGER, STRING)
#
sub StrXOR
{
  my $K = defined $_[0] ? $_[0] & 255 : 0;
  my $S = defined $_[1] ? $_[1] : '';
  my $L = length($S);
  while ($L--)
  {
    vec($S, $L, 8) = vec($S, $L, 8) ^ $K;
  }
  return $S;
}

##############################################################
#
# This function converts all adjacent whitespace characters to
# a single space. In this function, "whitespace" is defined as
# a character whose ASCII value is less than 33. (This includes
# many special characters such as new line characters, nul, etc.)
# A second argument may be supplied to convert to something
# other than a space. The second argument must be a number (0-255).
#
#   Usage: STRING = CollapseWhitespace3(STRING, [ASCII_VALUE])
#
#   Example:
#     CollapseWhitespace3("\n\t abc  123 \n") --> " abc 123 "
#     CollapseWhitespace3("\n\t abc  123 \n", 45) --> "-abc-123-"
#
sub CollapseWhitespace3
{
  @_ or return '';
  my $T = shift;
  defined $T or return '';
  my $L = length($T);
  $L or return ''; 
  my $SP = @_ ? $_[0] & 255 : 32;

  my $c;
  my $N = 0;    # consecutive whitespace counter
  my $P = 0;    # target pointer to overwrite original str $T
  my $U = 1;    # string length will be left unchanged
  for (my $i = 0; $i < $L; $i++)
  {
	$c = vec($T, $i, 8);
	if ($c < 33)
	{
# When the first "whitespace" is encountered, we
# replace it with a SPACE. When the second consecutive
# whitespace is encountered, we have to reduce the string.

	  if ($N++) { $U = 0; } else { vec($T, $P++, 8) = $SP; }
	}
	else
	{
	  $U or vec($T, $P, 8) = $c;
	  $N = 0;
	  $P++;
	}
  }
  return $U ? $T : substr($T, 0, $P);
}

##############################################################
#
# This function converts all adjacent whitespace characters to
# a single space. A second string argument may be supplied to
# convert to something other than a space. The second argument
# may contain only one character!
# In this function, "whitespace" is always defined as a character
# whose ASCII value is less than 33. (This includes many special
# characters such as new line characters, nul, bel, etc.)
#
#   Usage: STRING = CollapseWhitespace2(STRING, [STRING])
#
#   Example:
#     CollapseWhitespace2("\n\t abc  123 \n", "**") --> "**abc**123**"
#     CollapseWhitespace2("\n\t abc  123 \n", ".") --> ".abc.123."
#     CollapseWhitespace2("\n\t abc  123 \n", "") --> "abc123"
#
sub CollapseWhitespace2
{
  @_ or return '';
  my $T = shift;        # Get text
  defined $T or return '';
  length($T) or return '';
  my $SP = @_ ? vec(shift, 0, 8) : 32;  # Get separator

  my $c;
  my $W = 0;    # overwrite mode
  my $N = 0;    # consecutive whitespace counter
  my $P = 0;    # target pointer to overwrite original str
  for (my $i = 0; $i < length($T); $i++)
  {
	$c = vec($T, $i, 8);
	if ($c < 33)    # Found whitespace?
	{
	  if ($N++)
	  {
# Second consecutive space encountered,
# so we need to overwrite the string.
# Target ptr is not incremented.
		$W = 1;
	  }
	  else
	  {
# First "whitespace" encountered, so we replace
# it with space to make sure it's a space.
		vec($T, $P++, 8) = $SP;
	  }
	}
	else
	{
# Non-whitespace was encountered. If we have to reduce the
# length of the string, then we move a byte and continue.
	  if ($W) { vec($T, $P, 8) = $c; }
	  $N = 0;   # Number of spaces encountered = 0
	  $P++; # Target ptr moves forward.
	}
  }
  return $W ? substr($T, 0, $P) : $T;
}

###############################################################
#
# PrintStrPtr(11, "ABCDEFGHIJKLMNOPQ", 'title');
#
sub PrintStrPtr
{
  my ($P, $S, $T) = @_;
  $S =~ tr| \t\r\n\0\1\2\3\4\5\6\7\x08\x0B\x0C\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F|                                |;
  $T = substr($T, 0, 50);
  print '-' x (77-length($T)), ' ', $T, "\n>>$S<< LEN=", length($S), " PTR=$P\n";
  if ($P > -3 && $P <= 77) { print ' ' x ($P+2), "^"; }
  if ($P < 0 || $P >= length($S)) { print ' ' x 50, "!!!!!POINTER OUT OF RANGE!!!!"; }
  print "\n", '-' x 78, "\n";
}
###############################################################
#
# This function encrypts a string using the XOR operator.
#
#   Usage: STRING = XOR(STRING, PASSWORD)
#
sub XOR
{
  @_ or return '';
  my $S = shift;
  defined $S or return '';
  length($S) or return '';
  my $W = 'asd';  # Default Password
  my $P = @_ ? shift : $W;
  defined $P or $P = $W;
  length($P) or $P = $W;
  my $i = length($S);
  my $j = 0;
  while ($i--)
  {
    $j < length($P) or $j = 0;
    vec($S, $i, 8) = (vec($S, $i, 8) ^ vec($P, $j++, 8));
  }
  return $S;
}

############################################
#
# This function works like the index() function,
# except it looks for individual characters
# instead of an exact string match. It returns
# the position of the first single character in
# STRING that matches any of the characters in
# CHRS. If none of the characters in STRING
# match any character in CHRS, -1 is returned.
# Matching is case sensitive.
#
# If a third argument is supplied, this function
# works the opposite way: it returns the position
# of the first NON-matching character.
#
# Usage: INTEGER strchr(STRING, CHRS)
#        INTEGER strchr(STRING, CHRS, MODE)
#
# Example: strchr("cat5hr", "0123456789")         ---> 3
#          strchr("sharks", "0123456789")         ---> -1
#          strchr("2,587.91", "0123456789.,", 0)  ---> -1
#          strchr("2,5?7.91", "0123456789.,", 0)  ---> 3
#
sub strchr
{
  my $STRING = shift;
  my $CHRS = shift;
  my $MODE = ((scalar @_) > 0) ? 1 : 0;
  my $C;
  for (my $i = 0; $i < length($STRING); $i++)
  {
    $C = substr($STRING, $i, 1);
    if (((index($CHRS, $C)) < 0 ? 1 : 0) == $MODE)
    { return $i; }
  }
  return -1;
}
##################################################
sub isAnyOf { index($_[0], $_[1]) < 0 ? 0 : 1 }
################################################
# Exchanges the values of two scalar variables.
# Usage: xchg(VarA, VarB)
#
sub xchg{@_>1||return;my$X=$_[0];$_[0]=$_[1];$_[1]=$X;}

################################################################# RemoveTail
#
# This function removes the last few bytes of STRING
# if it matches the REMOVE string.
#
#   Usage: STRING = RemoveTail(STRING, REMOVE)
#
# Example: RemoveTail("Abcdef", "def") --> "Abc"
#          RemoveTail("Abcdef", "DEF") --> "Abcdef"
#
sub RemoveTail
{
  @_ or return '';
  my $S = shift;
  defined $S or return '';
  length($S) or return '';
  @_ or return $S;
  my $R = shift;
  defined $R or return $S;
  length($R) or return $S;
  my $P = rindex($S, $R);
  return ($P+length($R) == length($S)) ? substr($S, 0, $P) : $S;
}

###############################################################
#
# This function makes sure that string A doesn't
# start with string B.
#
# Usage: STRING = RemovePrefix(A, B)
#
sub RemovePrefix
{
  @_ or return '';         # Missing arguments?
  my $A = shift;
  defined $A or return '';
  my $LA = length($A);
  $LA or return '';        # Empty string?

  @_ or return $A;         # Nothing to remove?
  my $B = shift;
  defined $B or return $A;
  my $LB = length($B);
  return $A if ($LB == 0 || $LB > $LA);

  my $P = 0;
  while ($B eq substr($A, $P, $LB))
  {
    $P += $LB;
  }
  return ($P) ? substr($A, $P, length($A)) : $A; 
}

###############################################################
#
# This function makes sure that string A doesn't
# end with string B. Even if suffix B occurs
# repeatedly at the end of string A, all
# instances or repeats will be removed.
#
# Usage: STRING = RemoveSuffix(A, B)
#
sub RemoveSuffix
{
  @_ or return '';         # Missing arguments?
  my $A = shift;
  defined $A or return '';
  my $LA = length($A);
  $LA or return '';        # Empty string?

  @_ or return $A;         # Nothing to remove?
  my $B = shift;
  defined $B or return $A;
  my $LB = length($B);
  return $A if ($LB == 0 || $LB > $LA);

  my $End = -1;
  while ($B eq substr($A, $LA-$LB, $LB))
  {
    $LA -= $LB;
    $End = $LA;
  }
  return ($End < 0) ? $A : substr($A, 0, $End);
}
################################################################# RSPACE
#
# This function adds spaces to the end of a string list to
# make sure it's exactly N characters long. If the string
# is longer than N, then just returns the string itself.
#
#   Usage: STRING = RSPACE(N, STRING, [STRINGS...])
#
sub RSPACE
{
  @_ > 1 or return '';
  my $LEN = shift;
  my $S = join('', @_);
  my $L = length($S);
  $L < $LEN or return $S;
  return $S . (' ' x ($LEN - $L));
}
################################################################# LSPACE
#
# This function adds spaces to the beginning of a string list
# to make sure it's exactly N characters long. If the string
# is longer than N, then just returns the string itself.
#
#   Usage: STRING = LSPACE(N, STRING, [STRINGS...])
#
sub LSPACE
{
  @_ > 1 or return '';
  my $LEN = shift;
  my $S = join('', @_);
  my $L = length($S);
  $L < $LEN or return $S;
  return (' ' x ($LEN - $L)) . $S;
}
##################################################
#
# This function makes sure that STRING ends with SUFFIX.
#
#   Usage: STRING = AddSuffix(STRING, SUFFIX)
#
#   Example: AddSuffix('Abcdef', 'def')  ---> 'Abcdef'
#            AddSuffix('Abcdef', 'DEF')  ---> 'AbcdefDEF'
#
sub AddSuffix
{
  @_ or return ''; my $S = shift; defined $S or return ''; my $LS = length($S); $LS or return '';
  @_ or return $S; my $X = shift; defined $X or return $S; my $LX = length($X); $LX or return $S;
  if ($LS >= $LX) { if (substr($S, $LS - $LX, $LX) eq $X) { return $S; } }
  return $S . $X;
}
##############################################################

# Finds the first occurrence of string B in string A, and returns whatever comes after that up to the end of the line (not including the new line character). If there is a match, the return string will start with a new line character!
# Usage: STRING = ChopLine(A, B)
sub ChopLineAfter { @_ or return ''; my $A = shift; defined $A or return ''; my $LA = length($A); $LA or return ''; @_ or return ''; my $B = shift; defined $B or return ''; my $LB = length($B); $LB or return ''; $LA > $LB or return ''; my $P = index($A, $B); $P >= 0 or return ''; my $R = substr($A, $P+$LB, $LA); $P = index($R, "\n"); if ($P >= 0) { $R = substr($R, 0, $P); } $P = index($R, "\r"); if ($P >= 0) { $R = substr($R, 0, $P); } return "\n$R"; }

##############################################################

sub ENCODE
{
  my $S = shift;
  my $ALLOW = ')akU_l{~=c[$b62H8p:Zy9MAe0CvgO/XLEn1BI|&Wr?RPu45jdt7SF@V+.(;YfD]Q\'Jo!x*-3zG,wK^msqThi\\}N';
  my $OUTPUT = '';
  my $BYTE;
  my $P;

  return '' if (!defined $S);
  for (my $i = 0; $i < length($S); $i++)
  {
    $BYTE = substr($S, $i, 1);
    $P = index($ALLOW, $BYTE);
    if ($P < 0)
    {
      $BYTE = '%' . toHex(ord($BYTE));
    }
    else
    {
      $BYTE = substr($ALLOW, length($ALLOW) - $P, 1);
    }
    $OUTPUT .= $BYTE;
  }
  return $OUTPUT;
}

####################################################
# This function decodes an escaped backwards-encrypted URL string.
# Usage: STRING = DECODE(STRING)
sub DECODE
{
  my $S = shift;
  my $ALLOW = ')akU_l{~=c[$b62H8p:Zy9MAe0CvgO/XLEn1BI|&Wr?RPu45jdt7SF@V+.(;YfD]Q\'Jo!x*-3zG,wK^msqThi\\}N';
  my $OUTPUT = '';
  my $BYTE;
  my $XX;
  my $P;

  return '' if (!defined $S);
  for (my $i = 0; $i < length($S); $i++)
  {
    $BYTE = substr($S, $i, 1);
    $P = index($ALLOW, $BYTE);
    if ($P >= 0)
    {
      $BYTE = substr($ALLOW, length($ALLOW)-$P, 1);
    }
    if (ord($BYTE) == 37)
    {
      $BYTE = '';
      $XX = substr($S, $i+1, 2);
      if (length($XX) == 2)
      {
        $i += 2;
        $BYTE = chr(hex($XX));
      }
    }
    $OUTPUT .= $BYTE;
  }
  return $OUTPUT;
}

##############################################################

# Usage: URL_STRING = EncodeURL(BIN_STRING)  v2019.6.16 - This function takes any kind of binary string and converts it to a safe string that can be passed as an argument in the URL.
#sub EncodeURL { return ConvertCharSet(EncodeB64($_[0]), $B64SET, $URLSET); }

# Usage: BIN_STRING = DecodeURL(URL_STRING)  v2019.6.16 - This function takes an encoded URL string and converts it back to a binary string.
#sub DecodeURL { return DecodeB64(ConvertCharSet($_[0], $URLSET, $B64SET)); }

# Usage: STRING = EncodeB64(STRING)  v2019.6.16 - This function encodes a string into B64 format using a non-standard algorithm.
#sub EncodeB64 { @_ or return ''; my $S = shift; defined $S or return ''; my $L = length($S); $L or return ''; my @A; my $i; my $j; my $c; my $k = -4; my $SHIFT = 6; for ($i = $j = 0; $i < $L; $i++, $j++) { if ($SHIFT > 5) { $SHIFT = 0; $k += 4; $A[$k] = 0; $j++; } $SHIFT += 2; $c = vec($S, $i, 8); $A[$j] = $c; $A[$k] += ($c & 0xC0) >> $SHIFT; $A[$j] &= 63; } while ($j--) { vec($S, $j, 8) = $A[$j] + 63; } return $S; }

# Usage: STRING = DecodeB64(STRING)  v2019.6.16 - This function decodes a B64 string to binary string.
#sub DecodeB64 { @_ or return ''; my $S = shift; defined $S or return ''; my $L = length($S); $L or return ''; my $c; my $H; my $j = 0; my $OUTPUT = ''; for (my $i = 0; $i < $L; $i++) { $c = vec($S, $i, 8) - 63; $c = ($c < 0) ? 0 : $c & 63; if ($i & 3) { $H <<= 2; vec($OUTPUT, $j++, 8) = $c + ($H & 0xC0); next; } $H = $c; } return $OUTPUT; }

##############################################################
#
# SMALL VERSION:
# Usage: URL_STRING = EncodeURL(BIN_STRING)  v2019.6.16 - This function takes any kind of binary string and converts it to a safe string that can be passed as an argument in the URL.
# sub EncodeURL { return ConvertCharSet(EncodeB64($_[0]), $B64SET, $URLSET); }
# Usage: BIN_STRING = DecodeURL(URL_STRING)  v2019.6.16 - This function takes an encoded URL string and converts it back to a binary string.
# sub DecodeURL { return DecodeB64(ConvertCharSet($_[0], $URLSET, $B64SET)); }
#
# FULL VERSION:
# Usage: URL_STRING = EncodeURL(BIN_STRING)  v2019.6.16
# Usage: BIN_STRING = DecodeURL(URL_STRING)
# EncodeURL() takes any kind of binary string and converts it
# to a safe string that can be passed as an argument in the URL.
# DecodeURL() does the reverse.
#
#sub EncodeURL { return ConvertCharSet(EncodeB64($_[0]), $B64SET, $URLSET); }
#sub DecodeURL { return DecodeB64(ConvertCharSet($_[0], $URLSET, $B64SET)); }

##################################################
#                                      v2019.08.25
# Converts all adjacent whitespace characters to a single space.
# Usage: STRING = CollapseWhitespace(STRING)
#
sub CollapseWhitespace
{
  my $X = defined $_[0] ? $_[0] : '';
  my ($U, $N, $P, $i, $c) = (1, 0, 0, 0);
  while ($i < length($X))
  {
    $c = vec($X, $i++, 8);
    if ($c < 33)
    {
      if ($N++)
      {
        $U = 0;
      }
      else
      {
        vec($X, $P++, 8) = 32;
      }
    }
    else
    {
      $U or vec($X, $P, 8) = $c;
      $N = 0;
      $P++;
    }
  }
  return $U ? $X : substr($X, 0, $P)
}
##################################################
#
# SMALL VERSION:
# Usage: ARRAY = SplitAlong(STRING, SEPARATORS)  v2019.6.15 - This function splits a string into an array along characters that are listed in the SEPARATORS string. Any character in the SEPARATORS string will be treated as a separator of words. Empty elements will be skipped.
# sub SplitAlong { my @A; @_ or return @A; my $S = shift; defined $S or return @A; length($S) or return @A; @_ or return ($S); my $SS = shift; defined $SS or return ($S); length($SS) or return ($S); $S .= substr($SS, 0, 1); my $L = length($S); my $START = 0; my $LAST = 0; my $N = 0; for (my $i = 0; $i < $L; $i++) { if (index($SS, substr($S, $i, 1)) < 0) { $LAST or $START = $i; $LAST = $i + 1; } elsif ($LAST) { $A[$N++] = substr($S, $START, $LAST - $START); $LAST = 0; } } return @A; }
#
# FULL VERSION:
# Usage: ARRAY = SplitAlong(STRING, SEPARATORS)  v2019.6.15
# This function splits a string into an array along characters
# that are listed in the SEPARATORS string. Any character in
# the SEPARATORS string will be treated as a separator of
# words. Empty elements will be skipped.
#
sub SplitAlong
{
  my @A;
  @_ or return @A;
  my $S = shift;		# Get STRING
  defined $S or return @A;
  length($S) or return @A;

  @_ or return ($S);
  my $SS = shift;		# Get SUBSTRING
  defined $SS or return ($S);
  length($SS) or return ($S);

  $S .= substr($SS, 0, 1);	# Make sure STRING ends with separator
  my $L = length($S);

  my $START  = 0;
  my $LAST   = 0;
  my $N      = 0;
  for (my $i = 0; $i < $L; $i++)
  {
    if (index($SS, substr($S, $i, 1)) < 0)	# Not separator?
    {
      $LAST or $START = $i;
      $LAST = $i + 1;
    }
    elsif ($LAST)
    {
      $A[$N++] = substr($S, $START, $LAST - $START);
      $LAST = 0;
    }
  }
  return @A;
}
############################################################
#                                                 v2019.12.5
# This function splits a string into an array along each
# occurrence of substring. If substring is an empty string
# or not provided, then this function will split the string
# into individual characters, one character per element.
# If a third argument is given, only the first few items
# will be split; the rest will be returned as one element.
# Usage: ARRAY = Split(STRING, [SUBSTR, [N]])
#
sub Split
{
  defined $_[0] or return ();
  (my $L = length($_[0])) or return ();
  my $LL = defined $_[1] ? length($_[1]) : 0;
  $L > $LL or return ($_[0]);  # STRING should be longer than SUBSTR
  my $i = defined $_[2] ? $_[2] : 0x7FFFFFFF;
  $i > 0 or return ($_[0]);   # Return all in one chunk
  my ($START, $N, $P, @A) = (0, 0, 0);
  if ($LL == 0)
  {
    $i < $L or return split(//, $_[0]);
    while ($i--)
    {
      $A[$N++] = substr($_[0], $N, 1);
    }
    $A[$N] = substr($_[0], $N);
    return @A;
  }
  while ($i--)
  {
    last if (($P = index($_[0], $_[1], $P)) < 0);
    $A[$N++] = substr($_[0], $START, $P - $START);
    $START = $P + $LL;
  }
  $A[$N] = substr($_[0], $START);
  return @A;
}
############################################################
#
# Usage: ARRAY = SplitLines(STRING)  v2019.6.21
# This function splits a string containing many lines of text
# into an array where each element contains one line.
# Removes blank lines and new line characters.
#
sub SplitLines
{
  my @A;
  @_ or return @A;
  my $STRING = shift;
  $STRING =~ tr#\r#\n#;     # Convert CR to LF
  $STRING =~ s/\n\s*/\n/g;  # Remove blank lines (with spaces)
  return split("\n", $STRING);
}

#
# This function splits a string into
# an array along new-line \n characters.
# Usage: ARRAY = SplitLine2(STRING)
#
sub SplitLine2
{
  defined $_[0] or return ();
  my ($i, $j, $n, @A) = (0, 0, 0);
  while (($i = index($_[0], "\n", $i)) >= 0)
  {
    $A[$n++] = substr($_[0], $j, $i - $j);
    $j = ++$i;
  }
  $A[$n] = substr($_[0], $j, length($_[0]));
  return @A;
}

##############################################################
#
# SMALL VERSION:
# Usage: ARRAY = SplitWords(STRING)  v2019.6.14 - This function splits a string along whitespace, newline and various other special characters whose ASCII value is less than 32 such as vertical tab, null, bel, esc, etc. Returns the words in an array. No empty elements are returned.
# sub SplitWords { my @A; @_ or return @A; my $S = shift; defined $S or return @A; my $L = length($S); $L or return @A; my $START = 0; my $LAST = 0; my $N = 0; for (my $i = 0; $i <= $L; $i++) { if (vec($S, $i, 8) > 32) { $LAST or $START = $i; $LAST = $i + 1; } elsif ($LAST) { $A[$N++] = substr($S, $START, $LAST - $START); $LAST = 0; } } return @A; }
#
# FULL VERSION:
# Usage: ARRAY = SplitWords(STRING)  v2019.6.14
# This function splits a string along whitespace, newline
# and various other special characters whose ASCII value
# is less than 32 such as vertical tab, null, bel, esc, etc.
# Returns the words in an array. No empty elements are returned.
#
sub SplitWords
{
  my @A;
  @_ or return @A;
  my $S = shift;		# Get STRING
  defined $S or return @A;
  my $L = length($S);
  $L or return @A;

  my $START  = 0;
  my $LAST   = 0;
  my $N      = 0;
  for (my $i = 0; $i <= $L; $i++)
  {
    if (vec($S, $i, 8) > 32)
    {
      $LAST or $START = $i;
      $LAST = $i + 1;
    }
    elsif ($LAST)
    {
      $A[$N++] = substr($S, $START, $LAST - $START);
      $LAST = 0;
    }
  }
  return @A;
}
##################################################
#                                       v2022.2.11
# This function splits a string along characters
# and puts each character into a different element
# in the order they come. However, if a character is
# repeated, those will be stored in the same element.
# Example:
#      'xyZZZx_' => ('x', 'y', 'ZZZ', 'x', '_')
#
# ARRAY = SplitAlongDiffChar(STRING)
#
sub SplitAlongDiffChar
{
  my @A;
  defined $_[0] or return @A;
  my $L = length($_[0]);
  my ($i, $j, $c, $prev) = (0, -1, -1);
  while ($i < $L)
  {
    $prev = $c;
    $c = vec($_[0], $i, 8);
    $c == $prev or $j++;
    $A[$j] .= substr($_[0], $i++, 1);
  }
  return @A;
}
##############################################################
#
# SMALL VERSION:
# Usage: ARRAY = Group(STRING, [LENGTH])  v2019.6.14 - This function splits string into equal-size chuncks and returns an array. If LENGTH is not given, the default length is 1.
# sub Group { my @A; @_ or return @A; my $S = shift; defined $S or return @A; my $L = length($S); $L or return @A; my $N = (@_) ? shift : 1; $N or $N = 1; $L > $N or return ($S); return unpack("(a$N)*", $S); }
#
# FULL VERSION:
# Usage: ARRAY = Group(STRING, [LENGTH])  v2019.6.14
# This function splits string into equal-size chuncks and
# returns an array. If LENGTH is not given, the default length is 1.
#
sub Group
{
  my @A;
  @_ or return @A;
  my $S = shift;		# Get STRING
  defined $S or return @A;
  my $L = length($S);
  $L or return @A;

  my $N = (@_) ? shift : 1;	# Get LENGTH
  $N or $N = 1;
  $L > $N or return ($S);	# Nothing to do
  return unpack("(a$N)*", $S);
}

##############################################################
#
# Usage: LENGTH = SplitAt(STRING, X)  v2019.6.15
# This function splits STRING at pointer X and puts the first
# half of the string into $a and the second half into $b.
# When X is a negative index, it starts counting from the end
# of string. This function always returns the length of $a.
#
sub SplitAt
{
  @_ or return 0;
  my $S = shift;		# Get string
  defined $S or return 0;
  my $L = length($S);
  $L or return 0;

# TRY THIS:
#
#   @a  = unpack( "(a70)*", $_ );
#

  my $X = @_ ? shift : 0;	# Get pointer
  defined $X or $X = 0;
  if ($X >= $L)			# Out of range?
  {
    $a = $S;
    $b = '';
    return $L;
  }
  if ($X == 0 || $X <= -$L)	# Out of range?
  {
    $a = '';
    $b = $S;
    return 0;
  }
  $a = substr($S, 0, ($X < 0) ? $L + $X : $X);
  $b = substr($S, $X);
  return length($a);
}

##################################################
##
##
##
##
##                ARRAY FUNCTIONS
##
##
##
##

# Adds up a list of numbers and returns the sum.
sub SumOfAll { my $SUM = 0;  foreach (@_) { $SUM += $_; }  return $SUM; }
##################################################
#                                        v2022.3.3
# Returns a subset of an array as a string.
# START tells which element should be the first to
# include. N specifies how many elements to join. (0=All)
# And SEPARATOR tells what string to insert between the elements.
#
# Usage: STRING = JoinFrom(START, N, SEPARATOR, ARRAY_OR_LIST)
#
sub JoinFrom
{
  @_ >= 4 or return '';
  my $START = defined $_[0] ? $_[0] : 0;
  my $N = defined $_[1] ? $_[1] : 0;
  my $STR = defined $_[2] ? $_[2] : '';
  shift; shift; shift;
  my $SIZE = @_;
  $START >= 0 or $START += $SIZE;
  my $OUTPUT = '';
  my $STOP = ($N == 0) ? $SIZE - 1: $START + $N - 1;
  $STOP < $SIZE or $STOP = $SIZE - 1;
  for (my $i = $START; $i <= $STOP; $i++)
    { $OUTPUT .= $_[$i] . ($i < $STOP ? $STR : ''); }
  return $OUTPUT;
}
##################################################
#                                        v2021.2.8
# This function joins a list or array elements by
# inserting separator A (space) between each element,
# but when it reaches the Nth element, it inserts
# separator B which could be a newline character.
#
# Usage: STRING = NiceJoin(N, A, B, ARRAY or LIST...)
#
sub NiceJoin
{
  @_ > 3 or return '';
  my $i = 0;
  my $N = shift;
  my $A = shift;
  my $B = shift;
  my $OUTPUT = '';
  while (@_)
  {
    $OUTPUT .= shift;
    if (@_)
    {
      if (++$i == $N)
      {
        $OUTPUT .= $B;
        $i = 0;
      }
      else
      {
        $OUTPUT .= $A;
      }
    }
  }
  return $OUTPUT;
}
##################################################
#                                       v2021.1.19
# This function looks for a string in an array
# and returns the index where it is found, or
# returns -1 if it's not found.
# Usage: INDEX = FindInArray(STRING, LIST)
#
sub FindInArray
{
  @_ > 1 or return 0;
  defined $_[0] or return 0;
  length($_[0]) or return 0;
  my $FIND = uc(shift);
  for (my $i = 0; @_; $i++)
  {
    if (index(uc(shift), $FIND) >= 0) { return $i; }
  }
  return 0;
}
##################################################
#                                      v2020.11.19
# This function removes duplicate lines from an array
# by sorting it and comparing each line with case-sensitive
# comparison. Returns a new array.
#
# Usage: NEW_ARRAY = ExtractDuplicates(ARRAY)
#
sub ExtractDuplicates
{
  my @A = @_;
  @A > 1 or return @A;
  @A = sort(@A);
  my $i = 0;
  my $j = 1;
  while ($j < @A)
  {
    if ($A[$i] eq $A[$j])
    {
      splice(@A, $j, 1);
    }
    else
    {
      $i++; $j++;
    }
  }
  return @A;
}
##################################################
#                                      v2020.11.19
# This function trims each element of the input array
# and removes empty strings elements. This function
# shortens the original array.
#
# Usage: RemoveBlankLines(ARRAY)
#
sub RemoveBlankLines
{
  @_ or return;
  my @A = @_;
  my ($j, $i, $LINE) = 0;
  for ($i = 0; $i < @A; $i++)
  {
    $LINE = Trim($A[$i]);
    if (length($LINE))
    {
      if ($j < $i) { $A[$j] = $LINE; }
      $j++;
    }
  }
  $#A = $j - 1;
  return @A;
}  
##################################################

# SMALL VERSION:
# This function splits STRING at pointer X and puts the first half of the string into $a and the second half into $b. When X is a negative index, it starts counting from the end of string. This function always returns the length of $a.
# Usage: LENGTH = SplitAt(STRING, X)
#sub SplitAt { my ($S, $X) = @_; my $L = length($S); if ($X >= $L) { $a = $S; $b = ''; return $L; } if ($X == 0 || $X <= -$L) { $a = ''; $b = $S; return 0; } $a = substr($S, 0, ($X < 0) ? $L + $X : $X); $b = substr($S, $X); return length($a); }

# v2019.9.17   STRING = UCASE(STRING)
# Transforms a string to uppercase and returns a new string.
sub UCASE {my$T=defined$_[0]?$_[0]:'';my$L=length($T);my$c;while($L--){$c=vec($T,$L,8);vec($T,$L,8)=UC($c)if($c>96);}$T}

# v2019.9.17   STRING = LCASE(STRING)
# Transforms a string to lowercase and returns a new string.
sub LCASE {my$T=defined$_[0]?$_[0]:'';my$L=length($T);my$c;while($L--){$c=vec($T,$L,8);vec($T,$L,8)=LC($c)if($c>64);}$T}

# v2019.9.17   INTEGER = UC(INTEGER)
# Takes an ASCII code and returns its uppercase equivalent.
sub UC {my$c=defined$_[0]?$_[0]&255:0;$c>96||return $c;$c>122||return $c&223;if($W1252){return $c if($c==0xF7);return $c-32 if($c>=0xE0&&$c<=0xFD);return $c-16 if($c==0x9A||$c==0x9C||$c==0x9E);return 0x9F if($c==0xFF);}else{return 0x9A if($c==0x81);return 0x90 if($c==0x82);return 0x8E if($c==0x84);return 0x8F if($c==0x86);return 0x80 if($c==0x87);return 0x92 if($c==0x91);return 0x99 if($c==0x94);return 0xA5 if($c==0xA4);}$c}

# v2019.9.17   INTEGER = LC(INTEGER)
# Takes an ASCII code and returns its lowercase equivalent.
sub LC {my$c=defined$_[0]?$_[0]&255:0;$c>64||return $c;$c>90||return $c|32;if($W1252){return $c if($c==0xD7);return $c+32 if($c>=0xC0&&$c<=0xDD);return $c+16 if($c==0x8A||$c==0x8C||$c==0x8E);return 0xFF if($c==0x9F);}else{return 0x81 if($c==0x9A);return 0x82 if($c==0x90);return 0x84 if($c==0x8E);return 0x86 if($c==0x8F);return 0x87 if($c==0x80);return 0x91 if($c==0x92);return 0x94 if($c==0x99);return 0xA4 if($c==0xA5);}$c}

# v2019.9.22   INTEGER = isLetter(INTEGER)
# Takes an ASCII code and returns: 0=Non-letter 1=Vowel 2=Consonant
sub isLetter {my$c=defined$_[0]?$_[0]:0;$c>64||return 0;my$U=UC($c);($c!=LC($c)||$c!=$U)||return 0;index($W1252?"AEIOU\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD2\xD3\xD4\xD5\xD6\xD9\xDA\xDB\xDC":"AEIOU\x9A\x90\x8E\x8F\x80\x92\x99\xA5",chr($U))<0?2:1}

# v2019.9.22   INTEGER = isUC(INTEGER)
# Takes an ASCII code and returns 1 if the letter is uppercase. Returns 0 if it's not a letter.
sub isUC {my$c=defined$_[0]?$_[0]:0;$c==LC($c)?0:1}

# v2019.9.22   INTEGER = isLC(INTEGER)
# Takes an ASCII code and returns 1 if the letter is lowercase. Returns 0 if it's not a letter.
sub isLC {my$c=defined$_[0]?$_[0]:0;$c==UC($c)?0:1}

# v2019.9.15  STRING = Capitalize(STRING)
# Capitalizes the FIRST LETTER of string S and returns a new string.
sub Capitalize {my$S=defined$_[0]?LCASE($_[0]):'';my$c;for(my$i=0;$i<length($S);$i++){$c=vec($S,$i,8);if($c>96&&$c<123){vec($S,$i,8)=$c&223;last;}}$S}

# v2019.9.18  STRING = EveryOther(STRING)
# Capitalizes every other letter of string S and returns a new string.
sub EveryOther {my$S=defined$_[0]?$_[0]:'';my$c;for(my$i=0;$i<length($S);$i++){$c=vec($S,$i,8);next if($c<65);vec($S,$i,8)=$i&1?UC($c):LC($c);}$S}

# v2019.9.22  STRING = SentenceCase(STRING)
# Capitalizes the first letter of each sentence and returns a new string.
sub SentenceCase {my$S=defined$_[0]?LCASE($_[0]):'';my$c;my$N=1;for(my$i=0;$i<length($S);$i++){$c=vec($S,$i,8);if(index(" ,:;/\()[]{}<>|-+=\t\r\n\xFF",chr($c))<0){if(index('.!?',chr($c))>=0){$N=1;}elsif($N){vec($S,$i,8)=UC($c);$N=0;}}}$S}

# v2019.9.22  STRING = ReverseCase(STRING)
# Reverses uppercase letters with lowercase and vice versa.
sub ReverseCase {my$S=defined$_[0]?$_[0]:'';my$c;my$U;my$L=length($S);while($L--){$c=vec($S,$L,8);$U=UC($c);vec($S,$L,8)=$c==$U?LC($c):$U;}$S}

##############################################################




      ###############################
     ##                             ##
     ##                             ##
     ##                             ##
     ##        MATH FUNCTIONS       ##
     ##                             ##
     ##                             ##
     ##                             ##
      ###############################




##################################################
#                                       v2022.2.25
# This function returns a list of N random
# integers ranging from MIN to MAX.
#
# Usage: ARRAY = RandomIntList(N, MIN, MAX)
#
sub RandomIntList
{
  my ($N, $MIN, $MAX) = @_;
  my @INTEGERS;
  for (my $i = 0; $i < $N; $i++)
    { $INTEGERS[$i] = int(rand($MAX - $MIN) + $MIN); }
  return @INTEGERS;
}
##################################################
#                                       v2022.2.27
# This function takes an array of positive integers
# and tries to figure out the best combination to
# add up these numbers so that we reach TOTAL or
# some number closest to TOTAL. Returns an ARRAY of
# indexes that point to elements of the array that
# should be added up.
# The first element of this array will contain the
# sum that can be reached by adding up all the numbers.
#
# Usage: ARRAY = SolveKnapSack(TOTAL, LIST_OF_NUMBERS)
#
sub SolveKnapSack
{
  my @BLANK = (0);
  @_ >= 2 or return @BLANK;
  defined $_[0] or return @BLANK;
  my $GOAL = shift;

  # Create a copy of the input array and also find the MIN and MAX values.
  my @NUMBERS;  # Numbers will be copied here
  my ($MIN, $MAX, $MAXPTR) = (999999999999, 0);
  for (my $i = 0; $i < @_; $i++)
  {
    $a = $_[$i];
    if ($a < 1 || $a > $GOAL) { next; }          # Skip numbers that obviously aren't going to work
    if ($a == $GOAL) { return ($a, $i); }        # We found it already? Wow!
    push(@NUMBERS, $a * 16777216 + $i);          # We store the index along with the number, so they stay together when sorted.
    if ($a < $MIN) { $MIN = $a; }                # Find smallest number
    if ($a > $MAX) { $MAX = $a; $MAXPTR = $i; }  # Find largest number and remember its pointer
  }

  my $ALL_THE_SAME = ($MIN == $MAX) ? 1 : 0;                 # Are all the numbers the same?
  $ALL_THE_SAME or @NUMBERS = sort { $a <=> $b } @NUMBERS;   # Sort numbers (unless they're all the same).

  # First we will add up all the numbers starting from the least to the greatest.
  # At the same time, we separate NUMBERS from the index and store
  # the index numbers separately in an array called @INDEX.
  # We also record the sum of all numbers up to the 25% mark, the midpoint and the 75% mark.
  my @INDEX;               # This will hold pointers to each number
  my @OUTPUT = (0);        # This will hold the best combination we find
  my $SUM = 0;
  for (my $i = 0; $i < @NUMBERS; $i++)
  {
    $a = $NUMBERS[$i];                            # Numbers have been sorted, so we can separate them again.
    push(@INDEX, ($b = $a % 16777216));           # Extract the index portion of the number
    $SUM += ($NUMBERS[$i] = int($a / 16777216));  # Extract the number part, and add to sum
    if ($SUM <= $GOAL)
    {
      $OUTPUT[0] = $SUM;
      push(@OUTPUT, $b);
      if ($SUM == $GOAL) { return @OUTPUT; }      # Found the solution?
    }
  }

  # Stop if we were able to add up all the numbers OR if all the numbers were the same...
  if ($#OUTPUT == $#NUMBERS || $ALL_THE_SAME) { return @OUTPUT; }

  # Any combination of numbers will have to get us closer to our goal.
  # If not, then we fall back to what's in @OUTPUT.
  if ($MAX > $OUTPUT[0])  { @OUTPUT = ($MAX, $MAXPTR); }

  # Now we will add up pairs of numbers starting with the largest first.
  for (my $i = $#NUMBERS; $i > 0; $i--)
  {
    my @SET = (0);
    $SUM = $NUMBERS[$i] + $NUMBERS[$i-1];     # Add up the largest + the next largest number.
    # If $SUM is still larger, then keep going down to the next smaller value.
    # If $SUM is smaller, then we try to add as many large values as possible.
    if ($SUM <= $GOAL)
    {
      $SET[0] = $SUM;
      push(@SET, $INDEX[$i], $INDEX[$i-1]);
      if ($SUM == $GOAL) { return @SET; }

      # Add up all big numbers from now on until we find the closest number.
      for (my $j = $i - 2; $j >= 0; $j--)
      {
        $SUM += $NUMBERS[$j];
        if ($SUM <= $GOAL)
        {
          $SET[0] = $SUM;
          push(@SET, $INDEX[$j]);
          if ($SUM == $GOAL) { return @SET; }
        }
        else
        {
          # Adding up as many of the biggest numbers has led us here, but now
          # we can't add anymore big numbers, so let's start adding from the smallest ones.
          # See, if there's anything we can still fit in here.
          $SUM = $SET[0];
          for (my $k = 0; $k < $j; $k++)
          {
            $SUM += $NUMBERS[$k];
            if ($SUM <= $GOAL)
            {
              $SET[0] = $SUM;
              push(@SET, $INDEX[$k]);
              if ($SUM == $GOAL) { return @SET; }
            }
            else
            {
              $SUM = $SET[0];
              last;
            }
          }
          last;
        }
      }
      # If we break the record, then save the new record.
      if ($SUM > $OUTPUT[0]) { $SET[0] = $SUM; @OUTPUT = @SET; }
    }    
  }
  return @OUTPUT;
}
##################################################
#                                       v2022.2.10
# This function finds all the factors of N, which
# ideally should be an integer between 1 and 65536.
# Usage: STRING = FactorThis(N)
#
sub FactorThis
{
  my $N = defined $_[0] ? Round($_[0]) : 1;
  my $X = $N;
  my $HALFX = ($N >> 1) + 1;
  my $PRIME = 1;
  my @FACTORS;
  if ($N == 0) { return "$N = $N"; }
  if ($N < 0) { @FACTORS = (-1); $N = abs($N); } else { @FACTORS = (1); }
  for (my $i = 0; $i < length($PDIFF); $i++)
  {
    $PRIME += vec($PDIFF, $i, 8) - 47;   # Get next prime number
    $PRIME < $HALFX or last;
    for (my $EXP = 0; ; $EXP++)
    {
      if ($N % $PRIME || $N == 1)  # See if this prime divides N without a remainder
      { if ($EXP) { push(@FACTORS, $PRIME . ($EXP > 1 ? "^$EXP" : '')); } last; }
      else
      { $N /= $PRIME; }
    }
  }
  return $X . (@FACTORS < 2 ? ' is a prime number.' : ' = ' . join(' x ', @FACTORS));
}
##################################################
#                                       v2022.2.10
# This function takes several integers and returns
# the largest common factor that can divide them
# all into whole numbers. For example: The largest
# common factor of 66, 24, 18 is 6, because
# each of these numbers can be divided by 6.
# Usage: INTEGER = GetCommonFactor(A, B, [C], [etc...])
#
sub GetCommonFactor
{
  my @N = @_;
  my $R;
  my $PREV;
  my $PRIME = 1;
  my $COMMON = 1;
  for (my $i = 0; $i < length($PDIFF); $i++)
  {
    $PRIME += vec($PDIFF, $i, 8) - 47;   # Get next prime number from the list
    for ($R = 0; $R == 0; )
    {
      foreach (@N)
      {
        if ($_ & 0x7FFFFFFE == 0) { return $COMMON; }   # If one of the numbers is either 1 or 0, we quit.
        $R = $_ % $PRIME;
        $R == 0 or last;
      }
      if ($R == 0)
      {
        foreach (@N) { $_ /= $PRIME; }
        $COMMON *= $PRIME;
      }
    }
  }
  return $COMMON;
}
##################################################
#                                       v2022.2.10
# This function simplifies a fraction by reducing
# the numerator and denominator to the lowest
# integer. Since the return value is a string,
# a separator character will be inserted between
# the numerator and denominator. Both input values
# must be integers!!! Example:
#    SimplifyFraction(4000, 3500, ':') => '8:7'
#
# Usage: STRING = SimplifyFraction(NUMERATOR, DENOMINATOR, SEPARATOR)
#
sub SimplifyFraction
{
  my $N = defined $_[0] ? Round($_[0]) : 0;
  my $D = defined $_[1] ? Round($_[1]) : 1;
  my $S = defined $_[2] ? $_[2] : '/';
  if ($D == 0 || $D == 1) { return $N . $S . $D; }
  my $DIV = GetCommonFactor($D, $N);
  return ($N / $DIV) . $S . ($D / $DIV);
}
##################################################
#                                        v2021.2.8
# This function takes any string and merges all
# the digits in it into a number. It will ALWAYS
# return an integer that is no less than MIN and
# no greater than MAX. By default, the MIN
# value is -999,999,999,999,999. And MAX
# value is +999,999,999,999,999.
# Usage: INTEGER = toInt(STRING, [MIN, [MAX]])
#
sub toInt
{
  defined $_[0] or return 0;
  my $MIN = defined $_[1] ? $_[1] : -999999999999999;
  my $MAX = defined $_[2] ? $_[2] : 999999999999999;
  my $N = shift;

  # Check negative values
  my $NEG = index($N, '-') < 0 ? 0 : 1;

  # Remove everything except numbers:
  $N =~ tr|\x00-\x2F\x3A-\xFF||d;

  # Remove leading zeros
  my $i = 0;
  for (; $i < length($N); $i++)
  { vec($N, $i, 8) < 49 or last; }
  if ($i > 0) { $N = substr($N, $i); }

  length($N) or return 0;

  # Allow no more than 15 digits.
  if (length($N) > 15) { $N = substr($N, 0, 15); }

  # Add sign
  if ($NEG) { $N = -$N; }

  # Check MIN value
  $N = ($N > $MIN) ? $N : $MIN;

  # Check MAX value
  return ($N < $MAX) ? $N : $MAX;
}
###########################################################
#                                                v2019.9.27
# This function prints the first N powers of 2.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: PrintPowersOfTwo(INTEGER)
#
sub PrintPowersOfTwo
{
  my $N = '1';
  my $P = defined $_[0] ? $_[0] : 0;
  print "\n2^0 = 1";
  for (my $i = 1; $i <= $P; $i++)
  {
    $N = ADD($N, $N);
    print "\n2^$i = $N";
  }
  print "\n";
}

###########################################################
#                                                v2019.9.27
# This function returns the Nth power of 2.
# The return value is going to be a string holding
# a big integer in base 10.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: STRING = PowerOfTwo(INTEGER)
#
sub PowerOfTwo
{
  my $N = '1';
  my $i = defined $_[0] ? $_[0] : 0;
  while ($i--)
  {
    $N = ADD($N, $N);
  }
  return $N;
}

###########################################################
#                                                v2019.9.27
# This function tests each character of input string to
# make sure they are all digits only (0-9).
# Returns: 1 if it is a big integer
#          0 if it contains any illegal characters
#         -1 if the argument is missing
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: INTEGER = isBigInt(STRING)
#
sub isBigInt
{
  my $N = defined $_[0] ? $_[0] : '';
  my $L = length($N);
  $L or return -1;

  my $c;
  while ($L--)
  {
    $c = vec($N, $L, 8);
    return 0 if ($c < 48 || $c > 57);
  }
  return 1;
}

###########################################################
#                                                v2019.9.27
# This function extracts digits from a string and returns
# them as a positive integer. Everything else is discarded.
# All numbers after the decimal point are discarded.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: STRING = ExtractBigInt(STRING)
#
sub ExtractBigInt
{
  my $N = defined $_[0] ? $_[0] : '';
  my $i = 0;
  my $j = 0;
  my $c;
  while ($i < length($N))
  {
    $c = vec($N, $i++, 8);
    last if ($j && $c == 46);
    next if ($c < 48 || $c > 57);
    vec($N, $j++, 8) = $c;
  }
  return $j ? substr($N, 0, $j) : '0';
}

###########################################################
#                                                v2019.9.27
# This function converts a big integer from base 10
# to base 2. Both the input and the output are strings.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: STRING = BigInt2Bin(STRING)
#
sub BigInt2Bin
{
  defined $_[0] or return '';
  my $N = $_[0];

# Calculate powers of two, as many as we need...

  my $X;		# Power of two
  my $i = 0;		# Ptr to current power of two
  my $BIN = '';		# This will be our return value
  my @PWR = ('1');	# Powers of two

  while ($i++ < 3000)	# Max digits = 3000
  {
    $X = $PWR[$i - 1];
    $X = $PWR[$i] = ADD($X, $X);
    last if (CMP($N, $X) != 1);	# $N <= $PWR ?
  }

# Convert decimal number to binary
# starting with the most significant digit

  while ($i--)
  {
    if ( CMP($N, $PWR[$i]) == 2)
    {
      $BIN .= '0';
    }
    else
    {
      $BIN .= '1';
      $N = DIFF($N, $PWR[$i]);
    }
  }
  return $BIN;
}
###########################################################
#                                                v2019.9.27
# Swaps the value of two variables and returns the value
# of the first variable BEFORE the swap took place.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
#
# Usage: A = SWAP(A, B)
#
sub SWAP
{
  @_ == 2 or return 0;
  my $X = $_[0];
  $_[0] = $_[1];
  $_[1] = $X;
}
###############################################################
#
# This function returns the difference between
# two bytes.
#
# Usage: INTEGER DIFF(INTEGER, INTEGER)
#
#sub DIFF
#{
#  my $A = shift;
#  my $B = shift;
#  if ($A > $B) { return $A - $B; }
#  if ($A < $B) { return 256 - ($B - $A); }
#  return 0;
#}
###########################################################
#                                                v2019.9.26
# This function converts a float to an 8-byte string.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
# Usage: STRING = Float2Str(FLOAT)
#
sub Float2Str
{
  # pack('F' ...) does not return an 8-byte string in Perl 5.004 for DOS.
  # pack('d' ...) is the only right way to do it.

  my $N = defined $_[0] ? $_[0] : 0;
  return pack('d', $N);
}
###########################################################
#                                                v2019.9.26
# This function converts an 8-byte string to a float.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
# Usage: FLOAT = Str2Float(STRING)
#
sub Str2Float
{
  defined $_[0] or return 0;
  my $S = $_[0];
  my $L = length($S);
  if ($L > 8) { $S = substr($S, 0, 8); }
  if ($L < 8) { $S = "\0" x (8-$L) . $S; }
  return unpack('d', $S);
}
##################################################
#                                      v2020.07.08
# This function returns 1 if the input value is
# made up of digits only, otherwise returns zero.
# Usage: INTEGER = isInteger(NUMBER)
#
sub isInteger
{
  defined $_[0] or return 0;
  return isFromCharSet($_[0], '0123456789');
}
############################################
# Returns the portion of a number after the decimal point
# including the decimal point. If there is no decimal point,
# then add one before the first digit. Either way, the return
# value is going to be a number between 0 and 0.999999999...
#
# Usage:  INTEGER demoteX(FLOAT)
#
# Example: 9437205.109370883 ---> 109370883
#
sub demoteX
{
  my $TEMP = shift;
  $TEMP = sprintf("%.16f", $TEMP);
  $a = index($TEMP, '.0000000000000000');
  if ($a > 0)
  {
    $TEMP = substr($TEMP, 0, $a);
  }
  else
  {
    $a = index($TEMP, '.');
    $TEMP = substr($TEMP, $a+1);
  }
  return '0.' . $TEMP;
}
###############################################################
#
# This function returns the magnitude of a number.
# (The magnitude is the number itself with no sign,
# no decimal point, and no exponent.)
#
# Usage: INTEGER = mag(FLOAT)
#
# Example: mag("-1.2349900019e+048") --> "12349900019"
#

sub mag
{
  my $FLOAT = shift;
  # Remove exponent
  my $P = index($FLOAT, 'e');
  $FLOAT = substr($FLOAT, 0, $P) if ($P >= 0);
  return 0 if (length($FLOAT) == 0);
  # Remove all non-digit characters
  $FLOAT =~ s/\D//g;
  return (length($FLOAT)) ? $FLOAT : 0;
}

###############################################################
#
# This function returns the fractional part of a
# number (whatever comes after the decimal point).
# This number is always less than 1.
#
# Usage: FLOAT = fract(FLOAT)
#
#

sub fract
{
  my $FLOAT = shift;
  return $FLOAT - int($FLOAT);
}
##################################################
#                                        v2021.2.1
# This function extracts an integer from a number
# by removing everything except numbers (0-9).
# It also removes leading zeros. Returns zero
# when the number is missing or undefined.
# Usage: INTEGER = ForceInt(STRING)
#
sub ForceInt
{
  defined $_[0] or return 0;
  my $N = $_[0] . '.';

  # Here we'll erase everything except '-.0123456789'
  $N =~ tr|\x00-\x2C\x3A-\xFF||d;

  # Capture negative sign and trim number by removing
  # leading zeros and everything after the period.
  my ($START, $END, $i, $L, $NEG, $c) = (0, 0, 0, length($N), '');
  while ($i < $L)
  {
    $c = vec($N, $i++, 8);
    if ($c > 48) { $START or $START = $i; }
    elsif ($c == 46) { $END = $i; last; }
    elsif ($c == 45) { $NEG = '-'; }
  }
  $N = substr($N, $START - 1, $END ? $END - $START : $L);
  $N =~ tr|.\/\-||d;   # Remove all these: -/.
  return length($N) ? $NEG . $N : 0;
}

##################################################
#                                        v2021.2.2
# This function converts a positive integer N to
# any base using digits listed in string CHARSET.
# The output will be exactly as long as specified
# in the third argument if it's given.
# Usage: STRING = Num2Set(N, CHARSET, [LENGTH])
#
sub Num2Set
{
  defined $_[1] or return '';      # Stop if character set is missing
  length($_[1]) > 1 or return '';  # Must have at least 2 characters
  my $MAXLEN = defined $_[2] ? $_[2] : 0;
  my $Z = substr($_[1], 0, 1);   # ZERO
  defined $_[0] or return $Z;    # Undefined -> ZERO
  my $N = ForceInt($_[0]);
  length($N) < 21 or return $Z;  # Overflow -> ZERO
  $N > 0 or return $Z;           # Negative -> ZERO
  if ($N == 1) { return substr($_[1], 1, 1); }
  if ($N > 9007199254740991) { $N = 9007199254740992; }
  my $L = length($_[1]);
  my $OUTPUT = '';
  while ($N > 1)
  {
    my $C = $N % $L;
    $OUTPUT .= substr($_[1], $C, 1);
    if ($MAXLEN == length($OUTPUT)) { return $OUTPUT; }
    $N = int(($N - $C) / $L);
  }
  if ($N) { $OUTPUT .= substr($_[1], $N, 1); }
  return $OUTPUT . ($MAXLEN > 0 ? $Z x ($MAXLEN - length($OUTPUT)) : '');
}
##################################################
#                                        v2021.2.2
# This function converts string N from any base
# to a positive integer. Digit set must be
# provided in string CHARSET.
# Usage: INTEGER = Set2Num(N, CHARSET)
#
sub Set2Num
{
  defined $_[1] or return '';
  length($_[1]) or return '';
  my $E = length($_[0]);
  my $L = length($_[1]);
  my $PWR = 1;
  my $X = 0;

  # Skip leading zeros.
  while (vec($_[0], --$E, 8) == vec($_[1], 0, 8)) { }

  for (my $i = 0; $i <= $E; $i++)
  {
    my $D = substr($_[0], $i, 1);
    if (($D = index($_[1], $D)) < 0) { return $X; }  # Illegal char?
    if ($D) { $X += $D * $PWR; }
    $PWR *= $L;
  }
  return $X;
}
##################################################
#                                        v2021.2.2
# This function expects a 2-digit hexadecimal number
# and returns a positive integer. If the first two
# bytes contain any illegal characters, then this
# function will return a partial result or zero.
# Usage: INTEGER = HexChar(STRING)
#
sub HexChar
{
  # This function uses a lookup table to translate
  # hexadecimal digits to numbers. Modifying this string
  # may cause this function to return invalid results:
  defined $_[0] or return 0;
  my $HEX_TABLE = '................................................@ABCDEFGHI.......JKLMNO..........................JKLMNO';
  my $c = vec($_[0], 0, 8);
  my $HI = vec($HEX_TABLE, $c, 8) & 15;
  $c = vec($_[0], 1, 8);
  $c = vec($HEX_TABLE, $c, 8) & 127;
  return $c < 64 ? $HI : ($HI << 4) | ($c & 15);
}
##################################################
#                                        v2021.2.2
# This function looks for any hexadecimal digits in
# a string and returns a positive integer.
# Usage: INTEGER = Hex2Int(STRING)
#
sub Hex2Int
{
  # This function uses a lookup table to translate
  # hexadecimal digits to numbers. Modifying this string
  # may cause this function to return invalid results:
  my $HEX_TABLE = '................................................@ABCDEFGHI.......JKLMNO..........................JKLMNO';
  defined $_[0] or return 0;
  length($_[0]) or return 0;
  my $L = length($_[0]);
  my $PWR = 1;
  my $X = 0;
  while ($L--)
  {
    my $c = vec($_[0], $L, 8);
    ($c = vec($HEX_TABLE, $c, 8)) & 64 or next;
    $c &= 15;
    if ($c) { $X += $c * $PWR; }
    $PWR *= 16;
    $X < 9007199254740992 or last;
  }
  return $X;
}
##################################################
#                                        v2021.2.2
# This function returns a "random" character which
# is extracted from a string that contains a list
# of random numbers.
# Usage: INTEGER = RandomChar()
#
sub RandomChar
{
  my $N = HexChar(substr($RANDOM, $SEED, 2));
  if ($SEED <= 252) { $SEED += 3; } else { $SEED = 0; }
  return $N;
}
##############################################################
# Converts a hex string to an integer. If the input string is more than 12 digits, then only the lower 12 digits are evaluated.
# Usage: INTEGER = HexInt(STRING)
sub HexInt { @_ or return 0; my $X = shift; defined $X or return 0; my $i = length($X); $i or return 0; $X = uc($X); my $P; my $N = 0; my $PWR = 1; my $HEX = '0123456789ABCDEF'; while ($i--) { $P = index($HEX, substr($X, $i, 1)); return $N if ($P < 0); $N += $P * $PWR; $PWR *= 16; return $N if ($PWR > 281474976710655); } return $N; }

# v2019.08.28  INTEGER = toHEX(INTEGER)
# Converts a small integer to a two-digit hex string and returns the ASCII code representation.
sub toHEX{my$N=defined$_[0]?$_[0]:0;$N>0||return 0x3030;$N<255||return 0x4646;my$H=$N&0xF0;$N&=15;$N<10 or$N+=7;$H<0xA0 or$H+=0x70;0x3030+$N+($H<<4)}

# v2019.08.28  STRING = toHex(INTEGER)
# Converts a small integer to a two-digit hex string.
sub toHex{my$N=defined$_[0]?$_[0]:0;$N>0||return'00';$N<255||return'FF';sprintf('%.02X', $N)}

#sub toHex
#{
#  my $N = defined $_[0] ? $_[0] : 0;
#  $N > 0 || return '00';
#  $N < 255 || return 'FF';
#  sprintf('%.02X', $N)
#}


# v2019.08.28  STRING = toHexLong(INTEGER)
# Converts a long to 8-digit hex format.
sub toHexLong{my$N=defined$_[0]?$_[0]:0;$N>0||return'00000000';$N<4294967296||return'FFFFFFFF';sprintf('%.08X', $N)}

# v2019.9.15  STRING = HEX(A, N)
# This function converts integer A to hex format and returns a string that is exactly N bytes long.
sub HEX {my$A=defined$_[0]?$_[0]|0:0;my$N=defined$_[1]?$_[1]|0:8;my$X=sprintf('%X',$A);my$L=length($X);$L<$N?'0'x($N-$L).$X:$L==$N?$X:substr($X,$L-$N,$L)}

# v2019.9.15  STRING = CRC(STRING)
# This function returns a unique 8-digit hex number (hash) for a string. "ABC" and "CAB" will have two different CRC values.
sub CRC {my$S=defined$_[0]?$_[0]:'';my$L=length($S);my$X=$L;my$M=0;while($L--){$X=FMOD((vec($S,$L,8)+$X+23.0912)*2145,1222);$M+=$X;$M&=65535;}HEX($X*8765,4).HEX($M,4)}

# This function returns the 16-bit CRC of a string.
# Usage: INTEGER = CRC16(STRING)
sub CRC16 { @_ or return 0; my $S = shift; defined $S or return 0; $S .= 'Z'; my $L = length($S); $L > 1 or return 0; my $R = 11.39145817; while ($L--) { $R = FMOD($R * (389 + vec($S, $L, 8)) + 1.1, 2875); } return int($R * 23) & 0xFFFF; }


# BITWISE ROTATE

##################################################
#                                        v2021.8.1
# Rotates an 8-bit unsigned integer by 1 bit to the
# Left or by N bits when a second argument is given.
# Usage: INTEGER = ROL8(INTEGER, [N])
#
sub ROL8
{
  my $BYTE = defined $_[0] ? $_[0] & 255 : 0;
  my $N = defined $_[1] ? $_[1] & 7 : 1;
  return $BYTE if ($N == 0 || $BYTE == 0 || $BYTE == 255);
  return ROR8($BYTE, 8 - $N);
}
##################################################
#                                        v2021.8.1
# Rotates an 8-bit unsigned integer by 1 bit to the
# Right or by N bits when a second argument is given.
# Usage: INTEGER = ROR8(BYTE, [N])
#
sub ROR8
{
  my $BYTE = defined $_[0] ? $_[0] & 255 : 0;
  my $N = defined $_[1] ? $_[1] & 7 : 1;
  return $BYTE if ($N == 0 || $BYTE == 0 || $BYTE == 255);
  my @MASK = (0, 1, 3, 7, 15, 31, 63, 127);
  my $BITS = $BYTE & $MASK[$N];
  return ($BITS << (8 - $N)) | ($BYTE >> $N);
}
##################################################
#                                        v2021.8.1
# Rotates a 16-bit unsigned integer by 1 bit to the
# Left or by N bits when a second argument is given.
# Usage: INTEGER = ROL16(INTEGER, [N])
#
sub ROL16
{
  my $WORD = defined $_[0] ? $_[0] & 65535 : 0;
  my $N = defined $_[1] ? $_[1] & 15 : 1;
  return $WORD if ($N == 0 || $WORD == 0 || $WORD == 65535);
  my $V = 16 - $N;
  my @MASK = (0, 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767);
  my $BITS = $WORD & $MASK[$V];
  return ($BITS << $N) | ($WORD >> $V);
}
##################################################
#                                        v2021.8.1
# Rotates a 16-bit unsigned integer by 1 bit to the
# Right or by N bits when a second argument is given.
# Usage: INTEGER = ROR16(INTEGER, [N])
#
sub ROR16
{
  my $WORD = defined $_[0] ? $_[0] & 65535 : 0;
  my $N = defined $_[1] ? $_[1] & 15 : 1;
  return $WORD if ($N == 0 || $WORD == 0 || $WORD == 65535);
  my @MASK = (0, 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, 4095, 8191, 16383, 32767);
  my $BITS = $WORD & $MASK[$N];
  return ($BITS << (16 - $N)) | ($WORD >> $N);
}
##################################################
#                                        v2021.8.1
# Rotates a 32-bit unsigned integer by 1 bit to the
# Left or by N bits when a second argument is given.
# Usage: INTEGER = ROL32(INTEGER, [N])
#
sub ROL32
{
  my $LONG = defined $_[0] ? $_[0] & 0xFFFFFFFF : 0;
  my $N = defined $_[1] ? $_[1] & 31 : 1;
  return $LONG if ($N == 0 || $LONG == 0 || $LONG == 4294967295);
  my $V = 32 - $N;
  my @MASK = (0, 1, 3, 7, 15,
  0x1F, 0x3F, 0x7F, 0xFF,
  0x1FF, 0x3FF, 0x7FF, 0xFFF,
  0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF,
  0x1FFFF, 0x3FFFF, 0x7FFFF, 0xFFFFF,
  0x1FFFFF, 0x3FFFFF, 0x7FFFFF, 0xFFFFFF,
  0x1FFFFFF, 0x3FFFFFF, 0x7FFFFFF, 0xFFFFFFF,
  0x1FFFFFFF, 0x3FFFFFFF, 0x7FFFFFFF);
  my $BITS = $LONG & $MASK[$V];
  return ($BITS << $N) | ($LONG >> $V);
}
##################################################
#                                        v2021.8.1
# Rotates a 32-bit unsigned integer by 1 bit to the
# Right or by N bits when a second argument is given.
# Usage: INTEGER = ROR32(INTEGER, [N])
#
sub ROR32
{
  my $LONG = defined $_[0] ? $_[0] & 0xFFFFFFFF : 0;
  my $N = defined $_[1] ? $_[1] & 31 : 1;
  return $LONG if ($N == 0 || $LONG == 0 || $LONG == 4294967295);
  my @MASK = (0, 1, 3, 7, 15,
  0x1F, 0x3F, 0x7F, 0xFF,
  0x1FF, 0x3FF, 0x7FF, 0xFFF,
  0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF,
  0x1FFFF, 0x3FFFF, 0x7FFFF, 0xFFFFF,
  0x1FFFFF, 0x3FFFFF, 0x7FFFFF, 0xFFFFFF,
  0x1FFFFFF, 0x3FFFFFF, 0x7FFFFFF, 0xFFFFFFF,
  0x1FFFFFFF, 0x3FFFFFFF, 0x7FFFFFFF);
  my $BITS = $LONG & $MASK[$N];
  return ($BITS << (32 - $N)) | ($LONG >> $N);
}
##################################################
#                                        v2021.8.1
# This function performs bitwise rotate on a string
# segment marked by StartBit and EndBit. This input
# string is supposed to be a binary string made up
# of characters in the range of (0-255).
# This function rotates the bits Right by N bits.
# This can be used for rotating 8-byte string of
# 64-bit number right or left by any number of bits.
# Usage: STRING = RORS(STRING, N, StartBit, EndBit)
#
sub RORS
{
  my ($S, $N, $StartBit, $EndBit) = @_;
  my $LEFT = ($N < 0) ? 0 : 1;
  if ($StartBit >= $EndBit) { return $S; }
  $N = abs($N) % ($EndBit - $StartBit);
  $N or return $S;
  my $B = Str2Bin($S);
  if ($EndBit > length($B)) { return ''; }
  my $UNCH1 = substr($B, 0, $StartBit);
  my $UNCH2 = substr($B, $EndBit);
  $B = substr($B, $StartBit, $EndBit - $StartBit);
  if ($LEFT) { $N = length($B) - $N; }
  my $PART1 = substr($B, 0, $N);
  my $PART2 = substr($B, $N);
  return Bin2Str($UNCH1 + $PART2 + $PART1 + $UNCH2);
}


##############################################################
#
# SMALL VERSION:
# Usage: INTEGER = MakeInteger(STRING)  v2019.5.25 - This function returns an integer if the input value contains digits only, otherwise returns zero.
# sub MakeInteger { @_ or return 0; my $N = shift; defined $N or return 0; my $L = length($N); $L or return 0; my $C; while ($L--) { $C = vec($N, $L, 8); return 0 if ($C < 48 || $C > 57); } return $N; }
#
# FULL VERSION:
# Usage: INTEGER = MakeInteger(STRING)  v2019.5.25
# This function returns an integer if the input value
# contains digits only, otherwise returns zero.
#
sub MakeInteger
{
  @_ or return 0;
  my $N = shift;
  defined $N or return 0;
  my $L = length($N);
  $L or return 0;
  my $C;
  while ($L--)
  {
    $C = vec($N, $L, 8);
    return 0 if ($C < 48 || $C > 57);
  }
  return $N;
}
##############################################################




      ###############################
     ##                             ##
     ##                             ##
     ##                             ##
     ##       ARRAY FUNCTIONS       ##
     ##                             ##
     ##                             ##
     ##                             ##
      ###############################






##############################################################
#
# SMALL VERSION:
# Usage: INTEGER = ExtractList(\ARRAY_A, \ARRAY_B)  v2019.6.16 - This function searches ARRAY_A for any elements of ARRAY_B, and removes every instance from ARRAY_A. The search is case sensitive. Both arguments must be passed by reference. This function changes the length of ARRAY_A and returns the number of items removed.
# sub ExtractList { @_ or return 0; my @A = @{$_[0]}; @A or return 0; @_ or return 0; my @B = @{$_[1]}; @B or return 0; my $R = 0; for (my $j = 0; $j < @B; $j++) { for (my $i = 0; $i < @A; $i++) { if ($A[$i] eq $B[$j]) { splice(@A, $i--, 1); $R++; } } } @{$_[0]} = @A; return $R; }
#
# FULL VERSION:
# Usage: INTEGER = ExtractList(\ARRAY_A, \ARRAY_B)  v2019.6.16
# This function searches ARRAY_A for any elements of ARRAY_B,
# and removes every instance from ARRAY_A. The search is case
# sensitive. Both arguments must be passed by reference.
# This function changes the length of ARRAY_A and
# returns the number of items removed.
#
sub ExtractList
{
  @_ or return 0;
  my @A = @{$_[0]};		# Get ARRAY_A
  @A or return 0;

  @_ or return 0;
  my @B = @{$_[1]};		# Get ARRAY_B
  @B or return 0;

  my $R = 0;
  for (my $j = 0; $j < @B; $j++)
  {
    for (my $i = 0; $i < @A; $i++)
    {
      if ($A[$i] eq $B[$j])
      {
        splice(@A, $i--, 1);	# Remove match
        $R++;
      }
    }
  }
  @{$_[0]} = @A;		# Update ARRAY_A
  return $R;
}

################################################################# CollapseArray
#
# v2019.7.13  NEW_ARRAY = CollapseArray(ARRAY)
# This function removes blank lines from an array.
#
sub CollapseArray
{
  my $i = @_;
  while ($i--)
  {
    defined $_[$i] or splice(@_, $i, 1);
    length($_[$i]) or splice(@_, $i, 1);
  }
  return @_;
}

###############################################################

# This function returns random numbers between 0 and 255.
# Usage: INTEGER RND([SALT])
sub RND { my $SALT = @_ ? shift : 0; $SEED = abs($SEED * ($SALT + 171) - 112464) % 37119; return $SEED % 256; }

# This function encrypts a string using the XOR operator.
# Usage: STRING XCrypt(STRING, PASSWORD)
sub XCrypt { my @OUTPUT; $SEED = CRC($_[1]); for (my $i = 0; $i < length($_[0]); $i++) { push(@OUTPUT, chr(RND($i) ^ ord(substr($_[0], $i, 1)))); } return join("", @OUTPUT); }

##################################################
#
# Returns the form content as one giant string.
# Returns DEFAULT if no form data was received.
#
# Usage: STRING = GetFormData([DEFAULT, [OVERRIDE]])
#
sub GetFormData
{
  my $DEFAULT = @_ ? shift : '';
  return shift if @_;

  my @L;
  while (<STDIN>) { push @L, $_; }
  @L or return $DEFAULT;
  return join('\n', @L);
}

# CONDENSED VERSION:
# Usage: STRING = GetFormData([DEFAULT, [OVERRIDE]]) - Returns the form content as one giant string.
# sub GetFormData { my $DEFAULT = @_ ? shift : ''; return shift if @_; my @L; while (<STDIN>) { push @L, $_; } @L or return $DEFAULT; return join('\n', @L); }
#
###############################################################
#
# This function chops N number of bytes from
# the beginning of STRING, reducing its length.
# The removed bytes are padded with zeroes
# and returned. If the return value contains
# any non-digits, it is changed to 0...
#
# Usage: INTEGER chopInt(STRING, N)  v2018?? OLD!
#

sub chopInt
{
  my $LEN = $_[1];
  my $N = substr($_[0], 0, $LEN);
  for (my $i = 0; $i < length($N); $i++)
  {
    my $C = ord(substr($N, $i, 1));
    if ($C < 48 || $C > 57) { $N = 0; last; }
  }
  $_[0] = $LEN < length($_[0]) ? substr($_[0], $LEN) : '';
  return '0' x ($LEN - length($N)) . $N;
}

###############################################################

# This function converts an IP address to an 8-digit hex string.
# Usage: STRING IP2Hex(IPSTRING)
sub IP2Hex { my $S = shift; my @D = Split($S, '.'); my $OUTPUT; for (my $i = 0; $i <= $#D; $i++) { $OUTPUT .= toHex($D[$i]); } return $OUTPUT; }

###############################################################
#
# This function sends a 1x1 image to the browser and terminates this script.
#
# Usage: DIE(ERRORCODE)
#

sub DIE
{
  my $E = shift;
  if ($ONLINE && !$DEBUG) { SpitBMP($E, 1); } else { print("\n\nERRORCODE = $E\n"); }
  exit;
}

##################################################
#                                      v2021.12.27
# Terminates the script and may display an error
# message and the "PRESS ENTER TO EXIT" message.
#   Usage: EXIT()                         # Returns zero.
#          EXIT(EXITCODE)                 # Returns EXITCODE.
#          EXIT(ERROR_MESSAGE)            # Displays error message, returns zero.
#          EXIT(EXITCODE, ERROR_MESSAGE)  # Displays error message, returns EXITCODE.
#
sub EXIT
{
  my $STATUS = defined $_[0] ? $_[0] : 0;
  if (exists $ENV{REMOTE_ADDR}) { print "Content-Type: text/html\n\n<HTML><BODY><PRE>"; $PAUSE = 0; }
  if (defined $_[1]) { print $_[1]; }
  elsif (length($STATUS) > 3) { print $STATUS; $STATUS = 0; }
  if ($PAUSE) { $| = 1; CENTER('<<< PRESS ENTER TO EXIT >>>'); $PAUSE = <STDIN>; }
  exit $STATUS;
}
##################################################
#
# Prints an error message and exits.
# Usage: Abort(STRING)
#
sub Abort
{
  print "\nOops. An error occurred. $_[0]\n";
  exit;
}
##################################################
# Includes perl code and returns 1 if succeeded.
# Usage: INTEGER = Include(FILENAME)
sub Include
{
  my $F = defined $_[0] ? $_[0] : '';
  -e $F or return 0;
  my $Z = -s $F;
  $Z or return 0;
  local *FH;
  my $CODE = '';
  sysopen(FH, $F, 0) or return 0;
  sysread(FH, $CODE, $Z) or return 0;
  close FH;
  $Z = index($CODE, "\x5F\x5FEND\x5F\x5F");
  $Z < 0 or $CODE = substr($CODE, $Z+7);
  eval($CODE);
}
##################################################
#                                      v2019.11.23
# Prints the number of seconds since the last call.
# Usage: PrintTime([MSG])
#
#sub PrintTime
#{
#  $| = 1;
#  my $DIFF = (time - $TIME);
#  my $MSG = defined $_[0] ? $_[0] . ' ---' : '';
#  CENTER("---- $DIFF second(s) ----$MSG");
#  $TIME = time;
#  $| = 0;
#}
##################################################
# Prints the names of all the subs in this file.
# Usage: PrintSubs()
sub PrintSubs
{
  my ($S, $P);
  my $DATA = Self('CONTENT');
  my @SUBS;
  for (my $i = 0; $i < length($DATA); $i++)
  {
    ($i = index($DATA, "\nsub ", $i)) >= 0 or last;
    $DATA = substr($DATA, $i+5);
    ($i = index($DATA, '{')) >= 0 or last;
    $S = substr($DATA, 0, $i);
    $S =~ s/[\r\n\s+]$//g;
    push(@SUBS, lc($S));
  }
  @SUBS = sort(@SUBS);
  print "\n", scalar @SUBS, " subs were found:\n\n";
  PrintRows(@SUBS);
}
##################################################
#                                      v2019.11.24
# Returns the length of the longest string in
# an array. Stores the length of the
# shortest string in $a.
# Usage: INTEGER = LongestString(ARRAY)
#
sub LongestString
{
  my $L;
  my $A = 0;
  $a = 0x7FFFFFFF;
  for (my $i = 0; $i < @_; $i++)
  {
    $L = length($_[$i]);
    $L < $A or $A = $L;
    $L > $a or $a = $L;
  }
  return $A;
}
##################################################
#                                      v2019.11.23
# This function prints the contents of an array
# in rows on the screen.
# Usage: PrintRows(ARRAY)
#
sub PrintRows
{
  @_ or return;
  my $WIDTH = $OS < 3 ? 80 : `tput cols`;
  my $LONGEST = LongestString(@_);
  my $ROWS = int($WIDTH / $LONGEST);
  my $ITEMS_PER_ROW = Ceil(@_ / $ROWS);
  my $SPACING = int(($WIDTH - ($ROWS * $LONGEST)) / $ROWS);
  my $MARGIN = ($SPACING == 0) ? $WIDTH - ($ROWS * $LONGEST) : 0;
  my $NO_LINE_BREAK = $MARGIN + (($LONGEST + $SPACING) * $ROWS) == $WIDTH;
  my $P;
  my $S;

  for (my $i = 0; $i < $ITEMS_PER_ROW; $i++)
  {
    $NO_LINE_BREAK or print "\n";
    print ' ' x $MARGIN;
    for (my $R = 0; $R < $ROWS; $R++)
    {
      $P = $R * $ITEMS_PER_ROW + $i;
      $P < @_ or last;
      print $_[$P] . (' ' x ($LONGEST - length($_[$P]) + $SPACING));
    }
  }
  print "\n";
}
##################################################
#                                       v2021.2.21
# Returns the path where this script resides.
# This path will always end with a backslash or
# forward slash depending on the OS.
# Usage: STRING = MyPath()
#
sub SelfPath
{
  my $PATH = $0;
  my $MSWIN = $^O =~ /MSWIN|DOS|OS2/i ? 1 : 0;
  my $SLASH = substr('/\\', $MSWIN, 1);
  my $P = rindex($PATH, $SLASH);
  $P < 0 or return Trim(substr($PATH, 0, $P)) . $SLASH;
  $PATH = ($MSWIN) ? `CD` : (exists($ENV{PWD}) ? $ENV{PWD} : `pwd`);
  $PATH = Trim($PATH) . $SLASH;
  $PATH =~ tr|/\\||s;
  return $PATH;
}
##################################################
#
# This function returns the NAME, the PATH, or the
# CONTENT of this perl script depending on which
# item is requested in the argument.
#
# Usage: STRING = Self(STRING)
#
# Examples:
#   Self('NAME')     - Returns the file name only
#   Self('PATH')     - Returns the file path only
#   Self('FULL')     - Returns both path and file name
#   Self('SIZE')     - Returns the file size of this script
#   Self('DATE')     - Returns the date this script was last modified
#   Self('CONTENT')  - Returns the content of this script
#
sub Self
{
  my $SELF = __FILE__;
  my $S = defined $_[0] ? uc($_[0]) : '';
  if ($S eq 'FULL') { return $SELF; }
  if ($S eq 'SIZE') { return -s $SELF; }
  if ($S eq 'DATE') { return FormatDate((stat($SELF))[9]); }
  my $P = rindex($SELF, ($OS < 3 ? '\\' : '/'));
  if ($S eq 'NAME') { return ($P < 0) ? $SELF : substr($SELF, $P+1); }
  if ($S eq 'PATH') { return SelfPath(); }
  return ReadFile($SELF);
}
##################################################
# Prints the description of this program.
# Usage: About()
#
sub About
{
  my $PTRSIZE = `$^X -V:ptrsize`;
  $PTRSIZE =~ s/[^0-9]//g;
  print "\nPerl $] ", ($PTRSIZE << 3), '-bit ', $^O, ', ' . LocalTime8(), "\n";
  my $S = ReadFile($0);
  my $P = 1 + index($S, '# ');
  my $E = 1 + index($S, '###', $P);
  $E && $P or die "\nMissing argument.\n";
  $S = substr($S, $P, $E - $P);
  $S =~ tr/#//d;
  print "\n $0\n\n$S";
}
##################################################
# Converts a series of 1s and 0s to a binary string.
# Usage: STRING = Bin2Str(STRING)
sub Bin2Str
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L or return '';
  my $P = $L & 3;
  $P = $P ? '0' x (8 - $P) : '';
  return pack('B*', $_[0] . $P);
}
##################################################
# Converts a series of 1s and 0s to hex format.
# Usage: STRING = Bin2Hex(STRING)
sub Bin2Hex
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L or return '';
  my $P = $L & 3;
  $P = $P ? '0' x (8 - $P) : '';
  return uc(unpack('H*', pack('B*', $_[0] . $P) ));
}
##################################################
#
# Converts a number (0-255) to hex format and
# returns the corresponding ASCII codes as an integer.
#
# Usage: INTEGER = HexCode(INTEGER)
#
# Example: HexCode(195) => "C3" => 67 51 => 0x4333
#
sub HexCode
{
  @_ or return 0x3030;
  my $N = $_[0];
  defined $N or return 0x3030;
  length($N) or return 0x3030;
  $N = int($N);
  $N > 0 or return 0x3030;
  $N < 255 or return 0x4646;
  my @XX = (48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 65, 66, 67, 68, 69, 70);
  return ($XX[($N&240)>>4]<<8)+$XX[$N&15];
}
##################################################
# These functions return the current local time
# as a string in the following formats:
#
#   LocalTime1([TIME]) --> YYYY-MM-DD HH:MM:SS
#   LocalTime2([TIME]) --> YYYYMMDDHHMMSS
#   LocalTime3([TIME]) --> MM-DD-YYYY HH:MM:SSam (12hr format)
#   LocalTime4([TIME]) --> 40-digit binary string
#   LocalTime5([TIME]) --> 5-byte binary string
#   LocalTime6([TIME]) --> 10-digit hexadecimal string
#   LocalTime7([TIME]) --> Mmm DD, YYYY  HH:MM:SS
#   LocalTime8([TIME]) --> Www Mmm D YYYY H:MMa
#   LocalTime9([TIME]) --> TTTTTTTTTT, YYYY-MM-DD HH:MM:SSam
#   LocalTimeA([TIME]) --> Mmmmmmm D, YYYY
#   LocalTimeB([TIME]) --> YYYY-MM-DD
#
# In contrast, the builtin function localtime() returns
# the date and time in the following format:
#   localtime()  --> Ddd Mmm  D HH:MM:SS YYYY
#
sub LocalTime1 { my @D = localtime(defined $_[0] ? $_[0] : time); return sprintf('%.04d-%.02d-%.02d %.02d:%.02d:%.02d', (1900+$D[5]), (1+$D[4]), $D[3], $D[2], $D[1], $D[0]); }
sub LocalTime2 { my @D = localtime(defined $_[0] ? $_[0] : time); return sprintf('%.04d%.02d%.02d%.02d%.02d%.02d', (1900+$D[5]), (1+$D[4]), $D[3], $D[2], $D[1], $D[0]); }
sub LocalTime3 { my @D = localtime(defined $_[0] ? $_[0] : time); my $A = $D[2] > 11 ? 'p' : 'a'; $D[2] or $D[2] = 12; $D[2] < 13 or $D[2] -= 12; return sprintf('%.02d-%.02d-%.04d %.02d:%.02d:%.02d%s', (1+$D[4]), $D[3], (1900+$D[5]), $D[2], $D[1], $D[0], $A); }
sub LocalTime4 { my @D = localtime(defined $_[0] ? $_[0] : time); return sprintf('%.014b%.04b%.05b%.05b%.06b%.06b', (1900+$D[5]), (1+$D[4]), $D[3], $D[2], $D[1], $D[0]); }
sub LocalTime5 { return Bin2Str(LocalTime4(defined $_[0] ? $_[0] : time)); }
sub LocalTime6 { return Bin2Hex(LocalTime4(defined $_[0] ? $_[0] : time)); }
sub LocalTime7 { my @D = split(/\s+/, defined $_[0] ? localtime($_[0]) : localtime); return "$D[1] $D[2], $D[4]  $D[3]"; }
sub LocalTime8 { my @D = localtime(defined $_[0] ? $_[0] : time); my $M = substr('JanFebMarAprMayJunJulAugSepOctNovDec', $D[4] * 3, 3); my $W = substr('SunMonTueWedThuFriSat', $D[6] * 3, 3); my $A = $D[2] > 11 ? 'p' : 'a'; $D[2] or $D[2] = 12; $D[2] < 13 or $D[2] -= 12; return "$W $M $D[3] " . sprintf('%.04d %d:%.02d', (1900+$D[5]), $D[2], $D[1]) . $A; }
sub LocalTime9 { my $T = defined $_[0] ? $_[0] : time; my @D = localtime($T); my $A = $D[2] > 11 ? 'pm' : 'am'; $D[2] or $D[2] = 12; $D[2] < 13 or $D[2] -= 12; return sprintf('%d, %.04d-%.02d-%.02d %.02d:%.02d:%.02d%s', $T, (1900+$D[5]), (1+$D[4]), $D[3], $D[2], $D[1], $D[0], $A); }
sub LocalTimeA { my @M = qw(January February March April May June July August September October November December); my $T = defined $_[0] ? $_[0] : time; my @D = localtime($T); return sprintf("%s %d, %d", $M[$D[4]], $D[3], 1900+$D[5]); }
sub LocalTimeB { my @D = localtime(defined $_[0] ? $_[0] : time); return sprintf('%.04d-%.02d-%.02d', (1900+$D[5]), (1+$D[4]), $D[3]); }
# This function may be given a number of milliseconds since 1970 Jan 1, and it returns a date string in the following format: YYYY-MM-DD HH:MM:SS mmm
# Usage: STRING = JSTimeStamp([MILLISECONDS])
sub JSTimeStamp { my $MS = '000'; my $SEC = time; if (defined $_[0]) { $SEC = int($_[0] / 1000); $MS = $_[0] % 1000; $MS = '0' x (3 - length($MS)) . $MS; } return LocalTime1($SEC) . " $MS"; }
##################################################
#                                       v2022.2.11
# Converts time to custom format.
# Example:
#  'DDD MMM D YYYY h:mm:ssx' => 'Fri Feb 11 2022 9:33:13p'
#  'YYYY-MM-DD HHmm'         => '2022-11-02 2133'
#  'MMMM D, DDD Hxx'         => 'July 4, Wednesday 6pm'
#
# The following words in the format field will
# be replaced with values:
#
#  YYYY => four-digit year, i.e. '1997'
#  YY   => two-digit year, i.e. '97'
#  MMMM => the name of the month, i.e. 'August'
#  MMM  => three-letter name of month, 'Jul'
#  MM   => two-digit month, i.e. '06'
#  M    => month as a number, '6'
#  DDDD => day of the week, i.e. 'Friday'
#  DDD  => three-letter day of the week, 'Fri'
#  DD   => two-digit day of the month, '08'
#  D    => day as a number, '8'
#  HH   => two-digit hour in 24-hour format, '08'
#  H    => hour in 24-hour format, '8'
#  hh   => two-digit hour in 12-hour format, '05'
#  h    => hour in 12-hour format, '5'
#  mm   => two-digit minute, '07'
#  m    => minute as a number, '7'
#  ss   => two-digit second, '49'
#  s    => minute as a second, '49'
#  xx   => the letters 'am' or 'pm'
#  x    => just 'a' or 'p'
#
# Usage: STRING = FormatDate([TIME], [FORMAT])
#
sub FormatDate
{
  my $TIME = defined $_[0] ? $_[0] : time;
  my $FORMAT = defined $_[1] ? $_[1] : 'YYYY-MM-DD hh:mm:ssxx';
  my ($SEC, $MIN, $HR, $DAY, $MONTH, $YR, $DAY_OF_WEEK) = localtime($TIME < 0 ? time : $TIME);
  my $MO = qw(January February March April May June July August September October November December)[$MONTH];
  $DAY_OF_WEEK = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday)[$DAY_OF_WEEK];
  $YR += 1900;
  $MONTH++;
  my $HR12 = $HR > 0 ? $HR : 12;
  $HR12 < 13 or $HR12 -= 12;
  my @F = SplitAlongDiffChar($FORMAT);
  foreach(@F)
  {
       if ($_ eq 'YYYY') { $_ = $YR; }
    elsif ($_ eq 'YY') { $_ = substr($YR, 2, 2); }
    elsif ($_ eq 'MMMM') { $_ = $MO; }
    elsif ($_ eq 'MMM') { $_ = substr($MO, 0, 3); }
    elsif ($_ eq 'MM') { $_ = sprintf('%.02d', $MONTH); }
    elsif ($_ eq 'M') { $_ = $MONTH; }
    elsif ($_ eq 'DDDD') { $_ = $DAY_OF_WEEK; }
    elsif ($_ eq 'DDD') { $_ = substr($DAY_OF_WEEK, 0, 3); }
    elsif ($_ eq 'DD') { $_ = sprintf('%.02d', $DAY); }
    elsif ($_ eq 'D') { $_ = $DAY; }
    elsif ($_ eq 'HH') { $_ = sprintf('%.02d', $HR); }
    elsif ($_ eq 'H') { $_ = $HR; }
    elsif ($_ eq 'hh') { $_ = sprintf('%.02d', $HR12); }
    elsif ($_ eq 'h') { $_ = $HR12; }
    elsif ($_ eq 'mm') { $_ = sprintf('%.02d', $MIN); }
    elsif ($_ eq 'm') { $_ = $MIN; }
    elsif ($_ eq 'ss') { $_ = sprintf('%.02d', $SEC); }
    elsif ($_ eq 's') { $_ = $SEC; }
    elsif ($_ eq 'xx') { $_ = ($HR12 < 12) ? 'am' : 'pm'; }
    elsif ($_ eq 'x') { $_ = ($HR12 < 12) ? 'a' : 'p'; }
  }
  return join('', @F);
}
##################################################
#                                      v2019.10.13
# Divides a large integer by 2 and returns the
# remainder, which is going to be either 0 or 1.
#
# Example: MOD_2("-92,077,951,206,318,133,545,705,226,138,576") --> 0;
# Example: MOD_2("10111111010011110101100101100") --> 0;
# Example: MOD_2("C0638C9F") --> 1;
#
# ***ANY BASE***
# This function accepts numbers in base 10, 2, 8, or 16.
#
# ***ANY LENGTH***
# The number can be a million digits long or zero.
#
# ***NO ERROR CHECKING***
# If you pass an invalid argument such as MOD_2('_3$*?.')
# the return will still be either 0 or 1.
#
sub MOD_2
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L or return 0;
  my $c = vec($_[0], $L - 1, 8);
  $c & 64 or return $c & 1;	# Evaluate 0-9
  return $c & 1 ? 0 : 1;	# Evaluate A-F
}
##################################################
#                                      v2019.10.13
# Divides a big positive integer by 2 and returns
# the result. The remainder will be stored in $a.
# Accepts base 10 only.
# Usage: STRING = DIV_2(STRING)
#
sub DIV_2
{
  my $N = defined $_[0] ? $_[0] : '0';
  my ($i, $c, $Q, $L) = (0, 0, '0', length($N));
  $a = 0;
  while ($i < $L)
  {
    $a = vec($N, $i, 8) - ($a & 1 ? 38 : 48);
    vec($Q, $i++, 8) = vec('00112233445566778899', $a, 8);
  }
  $a &= 1;
  return $Q;
}
##################################################
#                                      v2019.10.13
# Divides a big positive integer by 3 and returns
# the result. The remainder will be stored in $a.
# Accepts base 10 only!
# Usage: STRING = DIV_3(STRING)
#
sub DIV_3
{
  my $N = defined $_[0] ? $_[0] : '0';
  my ($i, $c, $Q, $L) = (0, 0, '0', length($N));
  while ($i < $L)
  {
    # Instead of performing an actual division, this
    # function uses an index and table to get the result.
    $c += vec($N, $i, 8) - 48;

    # Here we get the quotient digits:
    vec($Q, $i++, 8) = vec('000111222333444555666777888999', $c, 8);

    # From '@JK' we get a value that is either 0, 10, or 11.
    $c = vec('@JK@JK@JK@JK@JK@JK@JK@JK@JK@JK', $c, 8) & 15;
  }
  $a = $c % 3;
  return $Q;
}
##################################################
#                                      v2019.10.13
# Divides a big positive integer by 5 and returns
# the result. The remainder will be stored in $a.
# Accepts base 10 only!
# Usage: STRING = DIV_5(STRING)
#
sub DIV_5
{
  my $N = defined $_[0] ? $_[0] : '0';
  my $L = length($N);
  $L or return 0;
  my ($i, $j, $Q) = (0, 0, '0');

# When we divide the first digit by 5,
# the result will be either 1 or 0. We will process
# the first digit outside the loop, because if the
# quotient starts with zero, we want to skip that.

  $a = vec($N, 0, 8) - 48;
  if ($a >= 5) { $Q = '1'; $j = 1; $a -= 5; }

  while (++$i < $L)
  {
    $a = vec($N, $i, 8) - (48, 38, 28, 18, 8)[$a];
    vec($Q, $j++, 8) = vec('00000111112222233333444445555566666777778888899999', $a, 8);
    $a %= 5;
  }
  return $Q;
}
##################################################
#                                      v2019.10.13
# Divides a big positive integer by one digit and
# returns the result. The remainder will be in $a.
# Accepts base 10 only!
# Usage: QUOTIENT = DIV_BY_DIGIT(DIVIDEND, DIGIT)
#
sub DIV_BY_DIGIT
{
  my $N = defined $_[0] ? $_[0] : '0';
  my $D = defined $_[1] ? $_[1] : '';
  length($D) && $D or return '';
  my $L = length($N);
  $L or return 0;
  my ($i, $j, $Q) = (0, 0, '0');

  # Skip initial zero.
  $a = vec($N, 0, 8) - 48;
  if ($a >= $D) { $Q = int($a / $D); $j = 1; $a %= $D; }

  while (++$i < $L)
  {
    $a = vec($N, $i, 8) + $a * 10 - 48;
    vec($Q, $j++, 8) = int($a / $D) + 48;
    $a %= $D;
  }
  return $Q;
}
##################################################
#                                      v2020.06.30
# Compares two large positive integers.
# The integers can be binary, octal,
# decimal, or hexadecimal.
#
# NOTE: Both numbers must be in the same base.
#
# Returns: 0 if they are equal
#          1 if the first one is greater
#          2 if the second one is greater
#
# Special cases:
# * When comparing an undefined value against
#   an empty string or zero, they will be equal.
# * Minus signs are ignored, therefore
#   -5 and +5 are treated as equal.
#
# Usage: INTEGER = CMP(STRING, STRING)
#
sub CMP
{
  my $A = defined $_[0] ? uc($_[0]) : '';
  my $B = defined $_[1] ? uc($_[1]) : '';
  my $A2 = length($A);
  my $B2 = length($B);
  my ($A1, $B1, $CA, $CB, $DIFF) = (0, 0, 48, 48, 0);

  # SHOW WHAT'S HAPPENING:
  print "\n\nString1=|$A|\nString2=|$B|  RET=";

  # Find the first significant digit or starting pointer for each string.
  # We will call this A1 and B1. In case the string starts with zeros,
  # spaces, tabs, new line characters, - and + signs, or other special
  # characters, we skip through those. We ignore them.
  while ($A1 < $A2 && vec($A, $A1, 8) < 49) { $A1++; }
  while ($B1 < $B2 && vec($B, $B1, 8) < 49) { $B1++; }

  # Find last significant digit or ending pointer for each string.
  # We will call this A2 and B2.
  while ($A2 > $A1 && vec($A, --$A2, 8) < 48) {} $A2++;
  while ($B2 > $B1 && vec($B, --$B2, 8) < 48) {} $B2++;

  # Calculate the number of digits in each number.
  my $AL = $A2 - $A1;
  my $BL = $B2 - $B1;

  # Are both numbers the same length?
  if ($AL == $BL)
  {
    # Compare from left to right, incrementing
    # pointers A1 and B1 as we walk through all the digits.
    while ($A1 < $A2)
    {
      $CA = vec($A, $A1++, 8);    # Get digit from string A
      $CB = vec($B, $B1++, 8);    # Get digit from string B
      $DIFF = $CA - $CB;
      if ($DIFF) { return $DIFF < 0 ? 2 : 1; }
    }
    return 0;
  }
  return 1 if ($AL > $BL);
  return 2 if ($AL < $BL);
  return 0;
}
##################################################
# Usage: CLS() - Clears the terminal window.
#
sub CLS
{
     if ($OS == 3) { print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; }
  elsif ($OS == 1) { system('COMMAND.COM /C CLS'); }
  elsif ($OS == 2) { system('CLS'); }
  elsif ($OS == 4) { print "\x1B[3J"; }
}
#sub CLS
#{
#  my $OS = uc($^O);
#  if (index($OS, 'LINUX') >= 0) { print "\x1Bc\x1B[0m\x1B[3J\x1B[H\x1B[2J"; }
#  elsif (index($OS, 'DOS') >= 0) { system('COMMAND.COM /C CLS'); }
#  elsif (index($OS, 'WIN') >= 0) { system('CLS'); }
#  else { print "\x1B[3J"; } # Mac
#}
##################################################
# Prints ANSI codes to stdout that changes the color.
# This function works under LINUX/OSX ONLY!
# Usage: ChangeColor(INTEGER)
#
sub ChangeColor
{
  $OS > 2 or return;

  my $C = shift;
  my $A = ($C & 0xF00) >> 8; # Get attrib
  my $B = ($C & 0x0F0) >> 4; # Get background color
  my $T = ($C & 0x00F);      # Get text color
  my $E = '2648375vnrptosqu';
  $E = "\x1B[" . (vec($E, $T, 8) - 20) . "m\x1B[" . (vec($E, $B, 8) - 10) . 'm';

  if ($A & 1) { $E .= "\x1B[05m"; }  # BLINKING
  if ($A & 2) { $E .= "\x1B[04m"; }  # UNDERLINE
  if ($A & 4) { $E .= "\x1B[03m"; }  # ITALIC
  if ($A & 8) { $E .= "\x1B[01m"; }  # BOLD
  print $E;
}
##################################################
#
# Prints ANSI codes to stdout that changes the
# color back to default.
# Usage: ResetColor()
#
sub ResetColor
{
  $OS > 2 or return;
  print "\x1B[0m";
}
##################################################
#
# This function inserts commas into a number at
# every 3 digits and returns a string.
# Usage: STRING = Commify(INTEGER)
# Copied from www.PerlMonks.org/?node_id=157725
#
sub Commify
{
  my $N = reverse $_[0];
  $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $N;
}
##################################################
#
# Removes empty elements from array @A and returns
# the new length of @A.
# Usage: LENGTH = CompactArray(ARRAY)
#
sub CompactArray
{
  my @A = @_;
  my $j = 0;
  for (my $i = 0; $i < @A; $i++)
  {
    length($A[$i]) or next;
    $A[$j++] = $A[$i];
  }
  $#A = $j - 1;
  return scalar @A;
}
##################################################
#                                       v2020.12.4
# This function returns the third argument. If a
# third argument is not specified, then returns the
# named environment variable. If the named environment
# variable doesn't exist, then returns the default value.
#
# Usage: VALUE = ENV( NAME, [DEFAULT, [OVERRIDE]] )
#
sub ENV
{
  @_ or return '';
  my $NAME    = defined $_[0] ? $_[0] : '';
  my $DEFAULT = defined $_[1] ? $_[1] : '';
  @_ < 3 or return $_[2];
  length($NAME) or return $DEFAULT;
  return (exists($ENV{$NAME})) ? Trim($ENV{$NAME}) : $DEFAULT;
}
# SHORT VERSION:
# Returns the named environment variable or default (or returns override when specified).
# Usage: VALUE = ENV( NAME, [DEFAULT, [OVERRIDE]] )
# sub ENV { @_ or return ''; my $NAME = defined $_[0] ? $_[0] : ''; my $DEFAULT = defined $_[1] ? $_[1] : ''; @_ < 3 or return $_[2]; length($NAME) or return $DEFAULT; return (exists($ENV{$NAME})) ? Trim($ENV{$NAME}) : $DEFAULT; }
#
##################################################
#                                      v2019.12.30
# This function returns the smallest number from
# a list of numbers. The return value will
# never be less than the first number,
# which is the bottom limit.
# Usage: INTEGER = FindLowest(BOTTOM, LIST...)
#
sub FindLowest
{
  my $MIN = 2147483647;
  my $BOTTOM = defined $_[0] ? $_[0] : 0;
  while (shift && defined $_[0])
  {
    if ($MIN > $_[0])
    {
      $_[0] > $BOTTOM or return $BOTTOM;
      $MIN = $_[0];
    }
  }
  return $MIN;
}
##################################################
#                                      v2019.12.30
# This function returns the largest number from
# a list of numbers. The return value will
# never be larger than the first number,
# which is the top limit.
# Usage: INTEGER = FindHighest(TOP, LIST...)
#
sub FindHighest
{
  my $MAX = -2147483646;
  my $TOP = defined $_[0] ? $_[0] : 0;
  while (shift && defined $_[0])
  {
    if ($MAX < $_[0])
    {
      $_[0] < $TOP or return $TOP;
      $MAX = $_[0];
    }
  }
  return $MAX;
}
##################################################
#
# This is the original QuickSort algorithm ported
# from QBASIC to Perl. Although this is the
# fastest known algorithm for sorting numbers,
# perl's builtin sort() function still outperforms.
#
# Usage: QSort(ARRAY_OF_NUMBERS)
#
sub QSort
{
  @_ or return;

  my ($First, $Last, $StackPtr, $temp, $i, $j) = (0, @_ - 1, 0);
  my @QStack;

  for (;;)  # We'll exit later when StackPtr == 0
  {
    do
    {
      $i = $First;
      $j = $Last;
      $temp = $_[($i + $j) >> 1];

      do
      {
        while ($_[$i] < $temp) { $i++; }
        while ($_[$j] > $temp) { $j--; }
        if ($i < $j) { @_[$i, $j] = @_[$j, $i]; }
        if ($i <= $j) { $i++; $j--; }
      }
      while ($i <= $j);

      if ($i < $Last)
      {
        $QStack[$StackPtr++] = $i;
        $QStack[$StackPtr++] = $Last;
      }
      $Last = $j;
    }
    while ($First < $Last);

    $StackPtr or return;
    $Last = $QStack[--$StackPtr];
    $First = $QStack[--$StackPtr];
  }
}
##################################################
sub toHexColor { sprintf('%.2X%.2X%.2X', $_[0], $_[1], $_[2]) }
sub HexTime { sprintf('%.08X', time); }
sub BEEP { print chr(7); }
sub say { print "@_\n"; }
sub MIN { return ($_[0] > $_[1]) ? $_[1] : $_[0]; }

# This function returns the largest of two numbers.
# Usage: NUMBER = MAX(NUMBER, NUMBER)
sub MAX { return ($_[0] > $_[1]) ? $_[0] : $_[1]; }

sub round { int(($_[0] < 0) ? ($_[0] - 0.5) : ($_[0] + 0.5)); }
sub Str2Bin { unpack('B*', $_[0] ? $_[0] : ''); }

##################################################
#                                       v2022.2.28
# Converts a string to a series of lowercase
# hexadecimal numbers which may include a separator.
# In list context, it returns a list of hexadecimal
# numbers, otherwise returns a string.
#
# Usage: STRING = Str2Hex(STRING, [SEPARATOR])
#         ARRAY = Str2Hex(STRING)
#
sub Str2Hex
{
  defined $_[0] or return '';
  if (wantarray) { return unpack('(H2)*', $_[0]); }
  my $S = defined $_[1] ? $_[1] : '';
  return length($S) ? join($S, unpack('(H2)*', $_[0])) : unpack('H*', $_[0]);
}
##################################################

sub Hex2Str { pack('H*', $_[0] ? $_[0] : ''); }
sub ClearAB { $a = $b = ''; }
sub CEIL { int($_[0]) + ($_[0] - int($_[0]) > 0) }
sub FLOOR { my $i = int($_[0]); $i < 0 ? ($_[0] - $i ? $i - 1 : $i) : $i; }
sub FMOD { $_[0] - int($_[0] / $_[1]) * $_[1] }
sub ArrayToUpperCase { map { uc($_) } @_ }
sub ArrayToLowerCase { map { lc($_) } @_ }
sub CharArray2String { join('', map(chr, @_)) }
sub String2CharArray { map(ord, split//, defined$_[0] ? $_[0] : '') }
sub SortNumbers { return sort {$a <=> $b} @_; }
##################################################
# Usage: INTEGER = EndsWithChar(STRING, LIST)
sub EndsWithChar { (@_ == 2 && defined $_[0] && defined $_[1] && length($_[1]) && length($_[0])) ? (index($_[1], substr($_[0], length($_[0]) - 1)) < 0 ? 0 : 1) : 0; }
# Usage: INTEGER = StartsWithChar(STRING, LIST)
sub StartsWithChar { (@_ == 2 && defined $_[0] && defined $_[1] && length($_[1]) && length($_[0])) ? (index($_[1], substr($_[0], 0, 1)) < 0 ? 0 : 1) : 0; }
##################################################
#                                       v2019.6.15
# Returns the smallest integer greater than or equal
# to a number. If this function gets a non-numeric
# value, it will return 0 without a warning.
# Usage: INTEGER = Ceil(NUMBER)
#
sub Ceil
{
  my $N = defined $_[0] ? $_[0] : 0;
  { no warnings; $N += 0; }
  my $I = int($N);
  return $I > 0 ? ($N - $I ? $I + 1 : $I) : $I;
}
##################################################
#                                       v2019.6.15
# Returns the largest integer less than or equal
# to a number. If this function gets a non-numeric
# value, it will return 0 without a warning.
# Usage: INTEGER = Floor(NUMBER)
#
sub Floor
{
  my $N = defined $_[0] ? $_[0] : 0;
  { no warnings; $N += 0; }
  my $I = int($N);
  return $I < 0 ? ($N - $I ? $I - 1 : $I) : $I;
}
##################################################
# Asks the user to press Enter to continue...
# Usage: PAUSE()
sub PAUSE
{
  $| = 1;  # Disable buffering for now
  print "\nPress Enter to continue...";
  scalar <STDIN>;
  $| = 0;
  return;
}
##################################################
# Prints a horizontal line to STDOUT. If provided,
# it will use a sample character to print the line.
#
# Usage: HR( OPTIONAL_STRING_BYTE )
#
# Example: HR();     --->  -----------------------
#          HR("*");  --->  ***********************
#
sub HR
{
  my $C = '-';
  if ((scalar @_) > 0) { $C = shift; }
  print "\n" . (substr($C, 0, 1)) x 80;
}
##################################################
#                                      v2019.11.23
# Removes the first N bytes from a string and
# returns what's left OR returns the last
# 2 bytes if N == -2.
# Usage: STRING = Slice(STRING, N)
#
sub Slice
{
  defined $_[0] or return '';
  defined $_[1] or return $_[0];
  my $L = length($_[0]);
  $L or return '';
  my $N = $_[1];		# Get pointer N
  if ($N < 0) { $N += $L; }	# Negative index?
  $N > 0 or return $_[0];	# Nothing to do?
  $N < $L or return '';		# Out of range?
  return substr($_[0], $N);
}
##################################################
#                                      v2019.11.23
# Returns true if string A ends with string B,
# otherwise returns false. This is case sensitive!
# Usage: INTEGER = EndsWith(STRING_A, STRING_B)
#
sub EndsWith
{
  defined $_[0] or return 0;
  defined $_[1] or return 1;
  my $LA = length($_[0]);
  my $LB = length($_[1]);
  $LB or return 1;
  $LA >= $LB or return 0;
  return $_[1] eq substr($_[0], $LA - $LB);
}
##################################################
#                                      v2019.11.23
# Returns true if string A starts with string B,
# otherwise returns false. This is case sensitive!
# Usage: INTEGER = StartsWith(STRING_A, STRING_B)
#
sub StartsWith
{
  defined $_[0] or return 0;
  defined $_[1] or return 1;
  my $LA = length($_[0]);
  my $LB = length($_[1]);
  $LB or return 1;
  $LA >= $LB or return 0;
  return $_[1] eq substr($_[0], 0, $LB);
}
##################################################
#                                      v2019.11.23
# Prints some text in the center of the screen.
# If given more than one argument, each
# argument will be printed on a new line.
# Usage: CENTER(STRINGS...)
#
sub CENTER
{
  my $WIDTH = $TERM[0];
  my $PADDING;
  my $TEXT;
  print "\n";
  foreach my $L (@_)
  {
    $TEXT = substr($L, 0, $WIDTH);
    $PADDING = int(($WIDTH - length($TEXT)) / 2);
    print ' ' x $PADDING, $TEXT;
    length($TEXT) == $WIDTH or print "\n";
  }
}
##################################################
#                                      v2020.06.16
# This function converts any binary string to plain
# text that can be inserted between two single quotes
# in a perl script.
#
# ASCII characters from 127 to 255 will be encoded as
# \x7F ... \xFF. In addition, any character that occurs in
# the second argument (ESCAPE_LIST) will also be encoded in
# the same way! So, if you put '<>&' in the second argument,
# then those characters will not occur anywhere in the
# output string. They will be encoded as '\x3C\x3E\x26'
#
# Usage: STRING = toPerlString(STRING, [ESCAPE_LIST])
#
sub toPerlString
{
  my $S = defined $_[0] ? $_[0] : '';
  my $E = defined $_[1] ? 1 : 0;
  my ($OUTPUT, $i, $L, $C, $c) = ('', 0, length($S));
  for (my $i = 0; $i < $L; $i++)
  {
    $c = vec($S, $i, 8);
       if ($c == 10) { $c = '\\n'; }   # LF
    elsif ($c == 13) { $c = '\\r'; }   # CR
    elsif ($c == 9)  { $c = '\\t'; }   # TAB
    elsif ($c == 39) { $c = '\\\''; }  # SINGLE QUOTE
    elsif ($c == 92) { $c = '\\\\'; }  # BACKSLASH
    elsif ($c < 8) {   $c = "\\$c"; }  # CONTROL CHAR
    elsif ($c < 32 || $c > 126) { $c = sprintf('\\x%.02X', $c); }
    else
    {
      $C = substr($S, $i, 1);  # Éáí
      $c = $E ? (index($_[1], $C) < 0 ? $C : sprintf('\\x%.02X', $c)) : $C;
    }
    $OUTPUT .= $c;
  }
  return $OUTPUT;
}
##################################################
#                                      v2019.12.22
# This function converts any binary string to plain
# text that can be inserted between two double quotes
# in a JavaScript file.
# Usage: STRING = StrQuote(STRING)
#
sub StrQuote
{
  defined $_[0] or return '';
  my ($OUTPUT, $L, $C, $c) = ('', length($_[0]));
  for (my $i = 0; $i < $L; $i++)
  {
    $c = vec($_[0], $i, 8);
       if ($c == 10) { $C = '\\n'; }  # LF
    elsif ($c == 13) { $C = '\\r'; }  # CR
    elsif ($c == 9)  { $C = '\\t'; }  # TAB
    elsif ($c == 34) { $C = '\\"'; }  # DOUBLE QUOTE
    elsif ($c == 92) { $C = '\\\\'; }  # BACKSLASH
    elsif ($c < 8)   { $C = "\\$c"; }  # CONTROL CHAR
    elsif ($c < 32 || $c > 126) { $C = sprintf('\\x%.2X', $c); }
    else { $C = substr($_[0], $i, 1); }
    $OUTPUT .= $C;
  }
  return $OUTPUT;
}
##################################################
#
# This function converts a string to HTML-safe
# string output. For example, it will convert the
# < > signs to &lt; and &gt;
#
# Usage: Print_SafeHTML(STRING)
#
sub Print_SafeHTML
{
  print '<TT>';
  my $S = defined $_[0] ? $_[0] : '';
  $S =~ s/\r\n/\n/g;
  $S =~ s/  /\t/g;

  my ($i, $L, $c) = (0, length($S));
  while ($i < $L)
  {
    $c = vec($S, $i++, 8);
       if ($c == 38) { $c = '&amp;'; } # &
    elsif ($c == 60) { $c = '&lt;'; }  # <
    elsif ($c == 62) { $c = '&gt;'; }  # >
    elsif ($c == 9)  { $c = '&nbsp; '}
    elsif ($c == 10) { $c = "\n<BR>"; }
    elsif ($c < 32 || $c > 126) { $c = ' '; }
    else { $c = chr($c); }
    print $c;
  }
}
##################################################
#                                       v2021.3.16
# This function converts a string to HTML-safe
# string output. For example, it will convert the
# < > signs to &lt; and &gt;
#
# Usage: STRING = toSafeHTML(STRING)
#
sub toSafeHTML
{
  my $STR = defined $_[0] ? $_[0] : '';
  $STR =~ s/\r\n/\n/g;
  $STR =~ s/\t/    /g;
  my $OUTPUT = '';
  my ($i, $L, $C, $c) = (0, length($STR), '');
  while ($i < $L)
  {
    $c = vec($STR, $i++, 8);
       if ($c == 38) { $C = '&amp;'; }
    elsif ($c == 60) { $C = '&lt;'; }
    elsif ($c == 62) { $C = '&gt;'; }
    elsif ($c == 32) { $C = ($C eq ' ') ? '&nbsp;' : ' '; }
    elsif ($c == 10) { $C = "\n<BR>"; }
    elsif ($c < 32 || $c > 126) { $C = "<FONT COLOR=CCCCCC>&#$c;</FONT>"; }
    else { $C = chr($c); }
    $OUTPUT .= $C;
  }
  return $OUTPUT;
}
##################################################
#
# This function produces a hex dump. Also prints the
# string in plain text format with the address.
# Usage: TextDump(STRING)
#
sub TextDump
{
  my $j = 0;
  my $S = shift;
  my $WIDTH = $OS < 3 ? 80 : `tput cols`;
  my $LINE_WIDTH = ($WIDTH > 150) ? 128 : 64;
  my $c;
  print "\n";
  for (my $i = 0; $i < length($S); )
  {
    printf('%.10X  ', $i);
    for (my $k = 0; $k < $LINE_WIDTH; $k++)
    {
      $c = vec($S, $i + $k, 8);
      if ($i + $k < length($S))
      {
        if ($c == 9) { $c = 32; }
        elsif ($c < 32 || $c > 126) { $c = 46; }
        printf('%c', $c);
      }
      else
      { print ' '; }
    }
    print "\n";
    $i += $LINE_WIDTH;
  }
}
##################################################
#
# This function prints the contents of a file in
# hex format and plain text along with the address.
# Usage: HexDump(STRING)
#
sub HexDump
{
  my $c;
  my $j = 0;
  my $S = shift;
  my $WIDTH = $OS < 3 ? 80 : `tput cols`;
  my $LINE_WIDTH = ($WIDTH > 150) ? 32 : 16;
  my $BYTES = 0;
  print "\n";
  for (my $i = 0; $i < length($S); )
  {
    $BYTES += $LINE_WIDTH;
    printf('%.10X ', $i);
    for (my $k = 0; $k < $LINE_WIDTH; $k++)
    {
      $c = vec($S, $i + $k, 8);
      if ($i + $k < length($S))
      {
        print ($k == 8 ? '-' : ' ');
        printf('%.2X', $c);
      }
      else
      { print '   '; }
    }
    print '  ';
    for (my $k = 0; $k < $LINE_WIDTH; $k++)
    {
      $c = vec($S, $i + $k, 8);
      if ($i + $k < length($S))
      {
        if ($c < 32 || $c > 126) { $c = 46; }
        printf('%c', $c);
      }
      else
      {
        print ' ';
      }
    }
    print "\n";
    if ($BYTES == 512) { print "\n"; $BYTES = 0; }
    $i += $LINE_WIDTH;
  }
}
##################################################
#                                      v2019.11.23
# This function takes an integer (0-255) and returns
# an 8-byte binary string. No error checking is done,
# to make sure the input value is a number, so passing
# a value such as "wj354" will produce a warning!
# Usage: STRING = toBin(NUMBER)
#
sub toBin
{
  defined $_[0] or return '00000000';
  my $ITS_A_NUMBER = 1;
  local $SIG{__WARN__} = sub { $ITS_A_NUMBER = 0; };
  ($_[0] < 255) or return 'FFFFFFFF';
  $ITS_A_NUMBER or return '00000000';
  $_[0] > 0 or return '00000000';
  return sprintf('%08b', $_[0]);
}

##################################################
#                                        v2021.8.1
# Converts base 10 positive integer to a max 32-byte
# string of 1s and 0s, inserting additional
# separator characters at every 8 digits.
# Usage: STRING = toBinX(NUMBER, [LENGTH, [SEPARATOR]])
#
sub toBinX
{
  my $N = defined $_[0] ? $_[0] : '';
  my $L = defined $_[1] ? $_[1] : 32;
  my $S = defined $_[2] ? $_[2] : '-';
  length($N) or $N = 0;
  if (length($N) > 10 || $N > 4294967295) { $N = 0xFFFFFFFF; }
  my @MASK = (1, 2, 4, 8, 16, 32,
  0x40, 0x80, 0x100, 0x200,
  0x400, 0x800, 0x1000, 0x2000,
  0x4000, 0x8000, 0x10000, 0x20000, 
  0x40000, 0x80000, 0x100000, 0x200000,
  0x400000, 0x800000, 0x1000000, 0x2000000,
  0x4000000, 0x8000000, 0x10000000, 0x20000000,
  0x40000000, 0x80000000);
  my $OUTPUT = '';
  while ($L--) { $OUTPUT .= ($N & $MASK[$L]) ? 1 : 0; }
  if (length($S))
  {
    if (length($OUTPUT) == 16) { return substr($OUTPUT, 0, 8) . $S . substr($OUTPUT, 8); }
    if (length($OUTPUT) == 32) { return substr($OUTPUT, 0, 8) . $S . substr($OUTPUT, 8, 8) . $S . substr($OUTPUT, 16, 8) . $S . substr($OUTPUT, 24); }
  }
  return $OUTPUT;
}

##################################################
#                                      v2019.11.23
# This function takes an integer (0-255) and returns
# an 8-byte binary string. No error checking is done,
# to make sure the input value is a number, so passing
# a value such as "wj354" will produce a warning!
# Usage: STRING = toBin(NUMBER)
#
sub toBin8
{
  defined $_[0] or return '00000000';
  my $ITS_A_NUMBER = 1;
  local $SIG{__WARN__} = sub { $ITS_A_NUMBER = 0; };
  ($_[0] < 255) or return '11111111';
  $ITS_A_NUMBER or return '00000000';
  $_[0] > 0 or return '00000000';
  return sprintf('%08b', $_[0]);
}
##################################################
#                                        v2021.8.1
# Converts a 16-bit unsigned integer to a 16-byte
# string of 1s and 0s. If the input number is
# negative, then returns all zeros! If the input
# is greater than 65535, then returns all 1s.
# If the input number is not a number,
# then returns all zeros.
# Usage: STRING = toBin16(NUMBER)
#
sub toBin16
{
  my $Z = '0' x 16;
  defined $_[0] or return $Z;
  my $ITS_A_NUMBER = 1;
  local $SIG{__WARN__} = sub { $ITS_A_NUMBER = 0; };
  ($_[0] < 65535) or return '1111111111111111';
  $ITS_A_NUMBER or return $Z;
  $_[0] > 0 or return $Z;
  return sprintf('%16b', $_[0]);
}

##################################################
#                                      v2019.11.23
# Returns 1 if the input value is a binary number.
# Returns 0 if the input value contains anything
# other than ones and zeros.
# Usage: INTEGER = isBin(VALUE)
#
sub isBin
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L or return 0;
  my $c;
  while ($L--)
  {
    $c = vec($_[0], $L, 8);
    return 0 if ($c < 48 || $c > 49);
  }
  return 1;
}
##################################################
#                                      v2019.11.22
# Returns 1 if the input value contains nothing but
# hexadecimal digits only (0-9 and A-F / a-f).
# Usage: INTEGER = isHex(VALUE)
#
sub isHex
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L or return 0;
  my $c;
  while ($L--)
  {
    $c = vec($_[0], $L, 8);
    $c > 47 or return 0;
    $c > 57 or next;
    $c |= 32;
    $c < 103 or return 0;
    $c > 96 or return 0;
  }
  return 1;
}
##################################################
#                                      v2019.11.23
# Returns 1 if the input value contains nothing but
# digits (0-9); returns 0 otherwise.
# Usage: INTEGER = isDec(VALUE)
#
sub isDec
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L or return 0;
  my $c;
  while ($L--)
  {
    $c = vec($_[0], $L, 8);
    return 0 if ($c < 48 || $c > 57);
  }
  return 1;
}
##################################################
#                                      v2019.11.23
# This function returns 1 if the input value is
# a number; returns zero otherwise.
# Usage: INTEGER = isNumber(VALUE)
#
sub isNumber
{
  defined $_[0] or return 0;
  my $R = 1;
  local $SIG{__WARN__} = sub { $R = 0; };
  return ($_[0] < 0) ? $R : $R;
}
##################################################
#
# This function reads the contents of a directory
# and returns a detailed record of each file and
# directory in an array.
# Usage: ARRAY = ReadDIR(PATH)
#
sub ReadDIR
{
  my @A;
  defined $_[0] or return @A;
  length($_[0]) or return @A;
  my $PATH = $_[0];

  if ($OS < 3)
  { $PATH =~ tr#/#\\#; }
  else
  { $PATH =~ tr#\\#/#; }

  # Make sure that PATH ends with a backslash or forward slash
  if (index("/\\", GetChar($PATH, -1)) < 0)
  { $PATH .= ($OS < 3 ? "\\" : '/'); }

  my $EXT;
  my $FULLNAME;
  local *DIR;
  opendir(DIR, $PATH) or return;
  while ((my $NAME = readdir(DIR)))
  {
    $FULLNAME = "$PATH$NAME";

    $EXT = rindex($NAME, '.') + 1;
    $EXT = $EXT > 1 ? uc(substr($NAME, $EXT, length($NAME))) : '';

    # We will display directories first, followed by
    # symbolic links, then all other special files,
    # and plain files last.
       if (-f($FULLNAME)) { $NAME = "3*$EXT*$NAME*"; }
    elsif (-d($FULLNAME)) { $NAME = "0*$EXT*$NAME*"; }
    elsif (-l($FULLNAME)) { $NAME = "1*$EXT*$NAME*"; }
    else                  { $NAME = "2*$EXT*$NAME*"; }

    # Get file info
    my @INFO = stat $FULLNAME;
    $NAME .= (vec($NAME, 0, 8) > 48 ? $INFO[7] : '0') . '*' . $INFO[2] . '*' . $INFO[9];

    # Store file data
    push(@A, $NAME);
  }
  closedir(DIR);
  return @A;
}
##################################################
#
# This function reads the contents of a folder
# and returns an array that contains file names
# whose extensions match the ones specified in
# the second argument. The second argument should
# be a string containing extensions separated
# by a single space.
# Example: ReadDIR('/work/text', 'TXT TEXT HTM')
#
# Usage: ARRAY = ReadDIR2(PATH, [EXTENSIONS])
#
sub ReadDIR2
{
  my @FILELIST;
  my $PATH = defined $_[0] ? $_[0] : '';
  my $FILTER = defined $_[1] ? $_[1] : '';
  my $F = length($FILTER);
  length($PATH) or return @FILELIST;
  $PATH .= '/';      # Make sure that path ends with '/'
  $PATH =~ tr|\\|/|; # Convert path to Linux format
  $PATH =~ tr|/||s;  # Remove double '//'
  if ($F)
  {
    # Format filter
    $FILTER =~ tr|a-z A-Z 0-9 _ ||cd;   # Remove bad characters
    $FILTER =~ tr|a-z|A-Z|;             # Convert to uppercase
    $FILTER = " $FILTER ";              # Add spaces for easy search
  }

  my $FULLNAME;
  local *DIR;
  opendir(DIR, $PATH) or return @FILELIST;
  while ((my $NAME = readdir(DIR)))
  {
    if (length($NAME) < 3)
      { $NAME ne '.' && $NAME ne '..' or next; }

    my $FULLNAME = "$PATH$NAME";

    # Ignore subdirectories; just deal with files.
    if (-f($FULLNAME))
    {
      # Do we return all files or just the ones
      # that have a certain extension?
      if ($F)
      {
        # Grab the file extension
        my $P = rindex($NAME, '.');
        $P++ > 0 or next;
        my $EXT = uc(substr($NAME, $P));

        # Skip file if its extension doesn't match
        index($FILTER, " $EXT ") >= 0 or next;
      }
      push(@FILELIST, $NAME);  # Add file to the list
    }
  }
  closedir(DIR);
  return @FILELIST;
}
##################################################
#                                        v2021.2.2
# This function shuffles a string using $SEED and
# $RANDOM global variables.
# Usage: STRING = ForwardShuffle(STRING, [SEED])
sub ShuffleStr
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $SEED = defined $_[1] ? $_[1] : 1416;
  my $L = length($STR);
  my $R;
  
  for (my $i = 0; $i < $L; $i++)
  {
    SwapChar($STR, int(RandomChar() / 255 * $L), $i);
  }
  return $STR;
}
##################################################
#                                        v2021.2.2
# This function creates a character lookup table
# which is a lot faster method for doing repetitive
# POINTER = index(CHARACTER_SET, CHARACTER_TO_FIND).
# Instead of that, we do this:
# POINTER = vec(CHARACTER_SET, ord(CHARACTER_TO_FIND), 8)
# This function expects a list of characters as the
# first argument and returns a 256-byte string,
# which contains pointers to each character in
# the list. A second argument may be provided if a
# smaller lookup table is desired. The second argument
# can be 128, or it can be left off. The default
# value is 256, which means the output is going to be
# a 256-byte string in which each character is a pointer.
#
# Usage: STRING = CreateReverseTable(STRING, [MAXLEN])
#
sub CreateReverseTable
{
  my $M = defined $_[1] ? $_[1] : 256;
  my $S = defined $_[0] ? $_[0] : '';
  my $PTR_TABLE = "\0" x $M;
  my $L = length($S);

  # Okay, what we're going to do here is a faster way
  # of achieving the same thing as:
  #    for ($i = 0; $i < $L; $i++)
  #    {
  #      $c = chr($i);
  #      $PTR = index($S, $c);
  #      $PTR >= 0 or $PTR = 0;
  #      vec($PTR_TABLE, $i, 8) = $PTR;
  #    }
  #

  for (my $i = 0; $i < $L; $i++)
  {
    vec($PTR_TABLE, vec($S, $i, 8), 8) = $i;
  }
  return $PTR_TABLE;
}
##################################################
#                                      v2019.11.23
# Shuffles an array. Updates the original array!
# Usage: Shuffle(ARRAY)
#
sub Shuffle
{
  my $R;
  for (my $i = 0; $i < @_; $i++)
  {
    $R = int(rand(@_));
    @_[$R, $i] = @_[$i, $R];
  }
}
##################################################
#                                        v2021.1.2
# This function shuffles a string in a way
# that it can be unshuffled later!
# Usage: STRING = ForwardShuffle(STRING, [SEED])
#
sub ForwardShuffle
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $SEED = defined $_[1] ? $_[1] : 14.169170531;
  my $L = length($STR);
  for (my $i = 0; $i < $L; $i++)
  {
    $SEED = FMOD($SEED * 3771.108376549 + 533.1500429732, 9177);
    SwapChar($STR, $SEED / 9176 * $L & 0x7FFFFFFF, $i);
  }
  return $STR;
}
# SHORT VERSION:
# This function shuffles a string in a way that it can be unshuffled later!
# Usage: STRING = ForwardShuffle(STRING, [SEED])
# sub ForwardShuffle { my $STR = defined $_[0] ? $_[0] : ''; my $SEED = defined $_[1] ? $_[1] : 14.169170531; my $L = length($STR); for (my $i = 0; $i < $L; $i++) { $SEED = FMOD($SEED * 3771.108376549 + 533.1500429732, 9177); SwapChar($STR, $SEED / 9176 * $L & 0x7FFFFFFF, $i); } return $STR; }
##################################################
#                                        v2021.1.2
# This function unshuffles a string that has been
# shuffled by the ForwardShuffle() function.
# Usage: STRING = BackwardShuffle(STRING, [SEED])
#
sub BackwardShuffle
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $SEED = defined $_[1] ? $_[1] : 14.169170531;
  my $L = length($STR);
  my @R;
  for (my $i = 0; $i < $L; $i++)
  {
    $SEED = FMOD($SEED * 3771.108376549 + 533.1500429732, 9177);
    $R[$i] = $SEED / 9176 * $L & 0x7FFFFFFF;
  }
  while ($L--) { SwapChar($STR, $R[$L], $L); }
  return $STR;
}
# SHORT VERSION:
# This function unshuffles a string that has been shuffled by the ForwardShuffle() function.
# Usage: STRING = BackwardShuffle(STRING, [SEED])
# sub BackwardShuffle { my $STR = defined $_[0] ? $_[0] : ''; my $SEED = defined $_[1] ? $_[1] : 14.169170531; my $L = length($STR); my @R; for (my $i = 0; $i < $L; $i++) { $SEED = FMOD($SEED * 3771.108376549 + 533.1500429732, 9177); $R[$i] = $SEED / 9176 * $L & 0x7FFFFFFF; } while ($L--) { SwapChar($STR, $R[$L], $L); } return $STR; }
##################################################
#                                      v2020.06.16
# Shuffles a string. Returns a new string.
# Usage: STRING = ShuffleString(STRING)
#
sub ShuffleString
{
  my $X = defined $_[0] ? $_[0] : '';
  (my $i = length($X)) or return '';
  my ($OUTPUT, $C, $R) = ('');
  while ($i--)
  {
    $R = int(rand($i));
    $C = vec($X, $i, 8);
    vec($X, $i, 8) = vec($X, $R, 8);
    vec($X, $R, 8) = $C;
  }
  return $X;
}
##################################################
#                                      v2019.11.24
# This function prints and reads a text in
# computer voice on Windows computers.
# (Tested on Windows XP and 7 using TinyPerl 5.8.)
# Returns 0 if the reading did not happen.
# Returns 1 if it succeeded. Of course, there is no
# guarantee that the speaker volume was turned up.
# Usage: STATUS = Speak(TEXT, VOLUME)
#
sub Speak
{
  defined $_[0] or return 0;
  length($_[0]) or return 0;
  my $TEXT = $_[0];
  my $VOLUME = defined $_[1] ? $_[1] : 100;
  print "\n\n$TEXT\n";	# For those who are deaf, it's important to print the message.
  $OS == 2 or return 0;	# This only works on Windows
  $TEXT =~ tr|\"| |;	# Remove all quotes
  my $FILE = 'SPEAK.VBS';
  my $CODE = "IF Wscript.Arguments.length > 1 THEN\n\tSET VOICE = CreateObject(\"SAPI.SpVoice\")\n\tVOICE.Volume = Wscript.Arguments(0)\n\tVOICE.Speak Wscript.Arguments(1)\n\tWScript.Quit 1\nELSE\n\tWScript.Echo \"Usage: speak.vbs <VOLUME> <TEXT>\"\nEND IF\nWScript.Quit 0";
  -e $FILE && -s $FILE == length($CODE) or CreateFile($FILE, $CODE);
  return system("$FILE $VOLUME \"$TEXT\"") eq '256' ? 1 : 0;
}
##################################################
#
# This function reads the entire contents of a file
# in binary mode and returns it as a string. If an
# errors occur, an empty string is returned silently.
# A second argument will move the file pointer before
# reading. And a third argument limits the number
# of bytes to read.
# Usage: STRING = ReadFile(FILENAME, [START, [LENGTH]])
#
sub ReadFile
{
  my $NAME = defined $_[0] ? $_[0] : '';
  $NAME =~ tr/\"\0*?|<>//d;	# Remove special characters
  -e $NAME or return '';
  -f $NAME or return '';
  my $SIZE = -s $NAME;
  $SIZE or return '';
  my $LEN = defined $_[2] ? $_[2] : $SIZE;
  $LEN > 0 or return '';
  local *FH;
  sysopen(FH, $NAME, 0) or return '';
  binmode FH;
  my $POS = defined $_[1] ? $_[1] : 0;
  $POS < $SIZE or return '';
  $POS < 1 or sysseek(FH, $POS, 0);	# Move file ptr
  my $DATA = '';
  sysread(FH, $DATA, $LEN);		# Read file
  close FH;
  return $DATA;
}
##################################################
#                                      v2019.11.24
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
# Usage: INTEGER = CreateFile(FILE_NAME, CONTENT)
#
sub CreateFile
{
  defined $_[0] or return 0;
  my $F = $_[0];
  $F =~ tr/\"\0*?|<>//d;	# Remove special characters
  length($F) or return 0;
  local *FH;
  open(FH, ">$F") or return 0;
  binmode FH;
  if (defined $_[1] ? length($_[1]) : 0) { print FH $_[1]; }
  close FH or return 0;
  return 1;
}
##################################################
#
# This function returns 0 if the file doesn't
# exist, otherwise it returns the file size,
# which could be zero as well.
# Usage: FILE_SIZE = FileSize(FILE_NAME)
#
sub FileSize
{
  defined $_[0] or return 0;
  length($_[0]) or return 0;
  -e $_[0] or return 0;		# File exists?
  -f $_[0] or return 0;		# Plain file?
  -s $_[0];			# Return size
}
##################################################
# This function expects a full path and returns
# the file name portion of the path.
# Usage: FILE_NAME = GetFileName(FULL_PATH)
#
sub GetFileName
{
  defined $_[0] or return '';
  my $F = $_[0];
  $OS > 2 or $F =~ tr|\\|/|;
  my $P = rindex($F, '/');
  return ($P < 0) ? $F : substr($F, $P+1);
}
##################################################
#                                       v2019.9.15
# Returns the path portion of a full file name
# without the trailing slash or backslash character.
# Usage: PATH = GetPath(FULL_NAME)
#
sub GetPath
{
  return JoinPath($_[0], '..');
}
##################################################
#                                       v2019.7.13
# This function joins two names into a single path by
# adding / in between the names. It also simplifies the
# resulting path by removing repeated \\ // characters,
# and tries to resolve the "." and ".." in a path name
# to literal names only.
# Usage: STRING = JoinPath(STRING, [STRING], [STRING]])
#
sub JoinPath
{
  @_ or return '';
  my @A;
  my $P;
  foreach $P (@_)	# Collapse array
  {
    defined $P or next;
    length($P) or next;
    $OS > 2 or $P =~ tr#/#\\#;
    push(@A, $P);	# Change "/" to "\" on DOS/Win
  }
  @A or return '';
  $P = shift(@A);	# Extract first element

  $P = Trim($P);
  my $L = length($P);
  $L or return '';

  # Remove prefix
  if (uc(substr($P, 0, 8)) eq 'FILE:///')
  { $P = substr($P, 8); }

  # Detect drive letter / start point on DOS/Win
  my $DRIVE = '';
  my $BACKSLASH = '';
  my $SEPARATOR = '/';
  if ($OS < 3)
  {
    if (vec($P, 1, 8) == 58)
    {
      $DRIVE = substr($P, 0, 2);
      $P = substr($P, 2, $L);
    }
    if (vec($P, 0, 8) == 92)
    {
      $BACKSLASH = '\\';
      $P = substr($P, 1, $L);
    }
    $SEPARATOR = '\\';
  }
  unshift(@A, $P);	# Put it back

  # Split along each separator
  @A = split("\\$SEPARATOR", join($SEPARATOR, @A));

  # Process each section of path
  my $TRIM = $OS > 2 ? '/' : '/\\';
  for (my $i = 0; $i < @A; $i++)
  {
    # Remove leading and trailing slashes
    $A[$i] = TrimChar($A[$i], $TRIM);

    # Remove "." or zero-length string
    if ($A[$i] eq '.' || length($A[$i]) == 0)
    { splice(@A, $i--, 1); next; }

    # Resolve ".."
    if ($A[$i] eq '..')
    {
      if ($i > 0)
      { splice(@A, --$i, 2); $i--; }
      else
      { splice(@A, $i, 1); $i--; }
    }
  }
  return $DRIVE . $BACKSLASH . join($SEPARATOR, @A);
}
##################################################
#                                        v2020.1.7
# This function changes the file name separator
# in a path to / or \ depending on the current OS.
# Usage: STRING = NicePath(STRING)
#
sub NicePath
{
  defined $_[0] or return '';
  length($_[0]) or return '';
  my $PATH = $_[0];
  if ($OS < 3)
  { $PATH =~ tr#/#\\#; }
  else
  { $PATH =~ tr#\\#/#; }
  return $PATH;
}
##################################################
#                                       v2021.1.20
# Returns the named integer from $ARGS if it's between
# MIN and MAX values or otherwise returns default.
# (The default value may be outside the MIN and MAX range.)
# Usage: INTEGER = GetArgInt(NAME, MIN, MAX, [DEFAULT])
#
sub GetArgInt
{
  @_ or return 0;
  my $NAME = defined $_[0] ? $_[0] : '';
  my $MIN = defined $_[1] ? $_[1] : 0;
  my $MAX = defined $_[2] ? $_[2] : 99999999999999;
  my $DEFAULT = defined $_[1] ? $_[1] : $MIN;
  @_ < 5 or return $_[4];  # Return OVERRIDE
  length($NAME) or return $DEFAULT;
  my $P = index("&$ARGS", "&$NAME=") + 1;
  $P or return $DEFAULT;
  $P += length($NAME);
  my $L = index($ARGS, '&', $P);
  my $RETURN = ($L < 0) ? substr($ARGS, $P) : substr($ARGS, $P, $L - $P);
  if (length($RETURN) == 0) { return $DEFAULT; }
  isFromCharSet($RETURN, $NUM) or return $DEFAULT;
  return ($RETURN < $MIN || $RETURN > $MAX) ? $DEFAULT : $RETURN;
}
##################################################
#                                       v2020.12.4
# Extracts the first occurrence of a named value
# from QUERY_STRING and returns it. If the value
# is not found, then an empty string is returned.
# Value names are case sensitive. Example:
# When $ARGS is '?p=12x48&r=XXX&c=990' then...
#    GetArgString('r') ---> 'XXX'
#
# Usage: VALUE = GetArgString(ARGUMENT_NAME)
#
sub GetArgString
{
  my $NAME = defined $_[0] ? $_[0] : '';
  length($NAME) or return '';
  my $P = index("&$ARGS", "&$NAME=") + 1;
  $P or return '';
  $P += length($NAME);
  my $L = index($ARGS, '&', $P);
  return $L < 0 ? substr($ARGS, $P) : substr($ARGS, $P, $L - $P);
}
# SHORT VERSION:
# Returns the named argument value from the global variable $ARGS.
# Usage: VALUE = GetArgString(ARGUMENT_NAME)
#sub GetArgString { my $NAME = defined $_[0] ? $_[0] : ''; length($NAME) or return ''; my $P = index("&$ARGS", "&$NAME=") + 1; $P > 0 or return ''; $P += length($NAME); my $L = index($ARGS, '&', $P); return $L < 0 ? substr($ARGS, $P) : substr($ARGS, $P, $L - $P); }
#
##################################################
#                                       v2020.7.10
# This function breaks down the QUERY_STRING into
# name-value pairs and populates 3 global variables.
# These variables must already exist before
# calling this function:
#   1. $ARGS - QUERY_STRING (input string)
#   2. $ARGC - Number of arguments
#   3. @ARGN - Argument names in all uppercase letters
#   4. @ARGV - Argument values
#
# Usage: ProcessQueryString()
#
sub ProcessQueryString
{
  length($ARGS) or return;
  SplitAB($ARGS, '#', -1);
  $ARGS = unescape($a);
  my @A = split(/\&/, $ARGS);
  for (my $i = 0; $i < @A; $i++)
  {
    if (SplitAB($A[$i], "="))
    {
      push(@ARGN, uc($a));
      push(@ARGV, $b);
      $ARGC++;
    }
  }
}
##################################################
#                                       v2020.7.10
# This function returns the value of the named
# argument. If not found, DEFAULT is returned.
# This function reads four global variables:
#    $ARGS, $ARGC, @ARGN, @ARGV
#
# Usage: VALUE = GetArgValue(NAME, [DEFAULT])
#
sub GetArgValue
{
  my $NAME = defined $_[0] ? uc($_[0]) : '';
  my $DEFAULT = defined $_[1] ? $_[1] : '';
  length($ARGS) or return '';
  $ARGC or ProcessQueryString();
  $ARGC or return '';

  for (my $i = 0; $i < $ARGC; $i++)
  {
    if ($ARGN[$i] eq $NAME)
    { return $ARGV[$i]; }
  }
  return $DEFAULT;
}
##################################################
#                                      v2019.11.20
# This function splits a URL string and always
# returns an array of 8 string elements.
# Usage: ARRAY = SplitURL(STRING)
#
#   $ARRAY[0] = PROTOCOL
#   $ARRAY[1] = DOMAIN or DRIVE
#   $ARRAY[2] = ROOT
#   $ARRAY[3] = PATH
#   $ARRAY[4] = FILENAME
#   $ARRAY[5] = EXTENSION
#   $ARRAY[6] = ARGUMENTS
#   $ARRAY[7] = BOOKMARK
#
# For example, this function can correctly split
# any of the following paths:
#
#   /etc/f*
#   \home
#   D:start.htm
#   C:\WORK\Important Stuff.docx
#   ftp://www.mysite.com/downloads/x.zip
#   file://C:\Users\Alan\Desktop\addresses.html
#   http://www.mysite.com/images/x.gif?p=552
#   https://www.mysite.com/main.asp?id=301000&w=s#TOP
#
sub SplitURL
{
  my @A = ('') x 8;
  defined $_[0] or return @A;
  length($_[0]) or return @A;
  my $P;
  my $PATH = $_[0];
  $PATH =~ tr|/|\\|;
  if (($P = index($PATH, ':\\\\')) > 0)
  {
    $A[0] = lc(substr($PATH, 0, $P));	# PROTOCOL
    $PATH = substr($PATH, $P+3);
    $PATH =~ s/^\\+//g;			# Trim backslash
    if (($P = rindex($PATH, '#')) > 0)
    {
      $A[7] = substr($PATH, $P+1);	# BOOKMARK
      $PATH = substr($PATH, 0, $P);
    }
    if (($P = rindex($PATH, '?')) > 0)
    {
      $A[6] = substr($PATH, $P+1);	# ARGUMENTS
      $PATH = substr($PATH, 0, $P);
    }
  }
  if (vec($PATH, 1, 8) == 58)
  {
    $A[1] = uc(substr($PATH, 0, 2));	# DRIVE
    $PATH = substr($PATH, 2);
  }
  elsif (($P = index($PATH, '\\')) > 0)
  {
    $A[1] = substr($PATH, 0, $P);	# DOMAIN
    $PATH = substr($PATH, $P);
  }
  if (vec($PATH, 0, 8) == 92)
  {
    $A[2] = '\\';			# ROOT
    $PATH = substr($PATH, 1);
  }
  if (vec($PATH, length($PATH)-1, 8) != 92)
  {
    $PATH = "\\$PATH";
    if (($P = rindex($PATH, '\\')) >= 0)
    {
      $A[4] = substr($PATH, $P+1);	# FILE
      $PATH = substr($PATH, 0, $P);
      if (($P = rindex($A[4], '.')) > 0)
      {
        $A[5] = substr($A[4], $P+1);	# EXTENSION
        $A[4] = substr($A[4], 0, $P);
      }
    }
  }
  $PATH =~ s/^\\+|\\+$//g;    # Trim backslash
  $A[3] = $PATH;			# PATH
  return @A;
}
##################################################
#                                      v2019.11.28
# This function returns the current drive letter
# followed by a colon under DOS/Windows.
# Returns an empty string in Linux.
# Usage: STRING = GetCurrentDrive()
#
sub GetCurrentDrive
{
  $OS < 3 ? substr(Trim(`cd`), 0, 2) : '';
}
##################################################
#                                      v2019.11.28
# Returns the current working directory. (If a drive
# letter is specified, then it returns the current
# directory of that drive. This applies to DOS/Windows
# only where each drive has its own current directory.)
# Usage: STRING = GetCurrentDirectory([DRIVE])
# Example: GetCurrentDirectory('D:')  --> 'D:\WORK'
#
sub GetCurrentDirectory
{
  if ($OS < 3)
  {
    my $DRIVE = defined $_[0] ? substr($_[0], 0, 2) : '';
    return Trim(`CD $DRIVE`);
  }
  return Trim(exists($ENV{PWD}) ? $ENV{PWD} : `pwd`);
}

# HERE'S A SIMPLER VERSION THAT MIGHT STILL DO THE JOB:
# v2021.1.20
#
#sub GetCurrentDirectory
#{
#  my $PATH = Trim(exists($ENV{PWD}) ? $ENV{PWD} : `cd`);
#  $PATH =~ tr|\\|/|;
#  if (vec($PATH, length($PATH) - 1, 8) != 47) { $PATH .= '/'; }
#  return $PATH;
#}
#
###################################################
# HERE IS ANOTHER SIMPLE VERSION:
#                                       v2021.1.20
# Returns the current working directory.
# Usage: STRING = GetCurrentDirectory()
# 
#sub GetCurrentDirectory
#{
#  my $PATH = Trim(exists($ENV{PWD}) ? $ENV{PWD} : `cd`);
#  my $Slash = vec($PATH, length($PATH) - 1, 8);
#  if ($Slash == 47 || $Slash == 92) { return $PATH; }
#  my $OS = uc($^O);
#  $Slash = index($OS, 'LINUX') >= 0 ? '/' : '\\';
#  return $PATH . $Slash;
#}
#
##################################################
#
# This function returns the OS type as a number.
# 1=DOS 2=WINDOWS 3=LINUX 4=OSX 9=OTHER
# Usage: INTEGER = GetOS()
#
sub GetOS
{
  my $OS = uc($^O);
  index($OS, 'LINUX')  >= 0 ? 3 :
  index($OS, 'MSWIN')  >= 0 ? 2 :
  index($OS, 'DOS')    >= 0 ? 1 :
  index($OS, 'DARWIN') >= 0 ? 4 : 9;
}
##################################################
#
# This function tests if a file is read-only by
# trying to open it for writing. Returns 1 if
# the file is read-only, or 0 if not.
# Usage: INTEGER = isReadOnly(FILENAME)
#
sub isReadOnly
{
  local *FH;
  open(FH, ">>$_[0]") or return 1;
  close FH;
  return 0;
}
##################################################
#
# This function returns true if a filename matches
# a certain wildcard pattern. There may be several
# question marks in the search pattern, but only one
# asterisk is allowed! The matching is NOT case sensitive!
# Usage: INTEGER = isMatch(FILENAME, WILDCARD)
# Example: isMatch("New_Document.txt", "n*.txt") ---> 1
#
sub isMatch
{
  my $F = defined $_[0] ? uc($_[0]) : '';
  my $W = defined $_[1] ? uc($_[1]) : '';
  length($F) && length($W) or return 0;

  # If there are invalid characters...
  if (FindChar($W.$F, '<|>')) { return 0; }

  # If there aren't any wildcards at all...
  if (FindChar($W, '*?') == 0) { return ($F eq $W) ? 1 : 0; }

  # Match what's before the asterisk...
  return 0 unless (_isMatch($F, $W, 1));

  # Match what comes after the asterisk...
  return _isMatch($F, $W, -1);
}
##################################################
#
# This function is called by isMatch() to compare
# two strings until the first asterisk. Returns 1
# if both strings match until the first asterisk.
# This function can start comparing strings starting
# from the beginning or starting from the end!
# DIRECTION must be either 1 or -1.
# Usage: INTEGER = _isMatch(FILENAME, WILDCARD, DIRECTION)
#
sub _isMatch
{
  my $F = shift; my $f; my $LF = length($F)-1;
  my $W = shift; my $w; my $LW = length($W)-1;
  my $DIR = shift;
  my $STOP = $LW; my $START = 0; my $FSTART = 0;
  if ($DIR < 0) { $STOP = 0; $START = $LW; $FSTART = $LF; }
  while ($START != $STOP)
  {
    $w = vec($W, $START, 8);  # Grab byte from wildcard pattern
    $f = vec($F, $FSTART, 8); # Grab byte from filename
    $START += $DIR;
    $FSTART += $DIR;
    if ($w == 42)   # ASTERISK?
    { return 1; }
    else
    {
      # If the character is "?" then skip, but if
      # it's not "?", then the characters must match.
      if ($w != 63) { ($f == $w) or return 0; }
    }
  }
  return 1;
}
##################################################
#                                      v2019.11.24
# This function works like the index() function.
# N is the start position. Uses rindex() when N
# is negative. Returns -1 if nothing was found,
# OR returns the position where SUBSTR was found.
# Usage: INTEGER = IndexOf(STRING, SUBSTR, [N])
#
sub IndexOf
{
  @_ > 1 or return -1;
  my $P = defined $_[2] ? $_[2] : 0;
  $P < 0 ? rindex($_[0], $_[1], $P + length($_[0])) : index($_[0], $_[1], $P);
}
##################################################
#                                      v2019.11.24
# This function splits STRING into two parts along the
# first occurrence of SUBSTR. The two resulting string
# segments are stored in $a and $b. The search for
# SUBSTR starts at position N. If N is -1, then
# starts searching from the end of the string.
# Returns 0 if SUBSTR was not found, OR
# returns POSITION+1 where SUBSTR was found.
# If SUBSTR is not found, the entire input string
# will be stored in $a, while $b will be empty.
# Usage: FOUND = SplitAB(STRING, SUBSTR, [N])
#
sub SplitAB
{
  $a = $b = '';
  @_ > 1 or return 0;
  my $P = IndexOf(@_);
  if ($P < 0) { $a = $_[0]; return 0; }
  $a = substr($_[0], 0, $P);
  $b = substr($_[0], $P + length($_[1]));
  return $P + 1;
}
##################################################
#                                      v2019.11.24
# This function returns the first half of STRING
# that comes before the first occurrence of SUBSTR.
# The search for SUBSTR starts at position N.
# If N is -1, then searches from the end of the string.
# If SUBSTR is not found, then returns an empty string.
# Usage: STRING = StrBefore(STRING, SUBSTR, [N])
#
sub StrBefore
{
  @_ > 1 or return '';
  my $P = IndexOf(@_);
  $P > 0 ? substr($_[0], 0, $P) : '';
}
##################################################
#                                      v2019.11.24
# This function returns the last half of STRING
# that comes after the first occurrence of SUBSTR.
# The search for SUBSTR starts at position N.
# If N is -1, then searches from the end of the string.
# If SUBSTR is not found, then returns an empty string.
# Usage: STRING = StrAfter(STRING, SUBSTR, [N])
#
sub StrAfter
{
  @_ > 1 or return '';
  my $P = IndexOf(@_);
  $P < 0 ? '' : substr($_[0], $P + length($_[1]));
}
##################################################
#                                        v2022.2.3
# This function returns the last character of a string.
# OR if a second argument is given, it returns the
# Nth character from the last.
#
# Usage: STRING = LastChar(STRING, [N])
#
sub LastChar
{
  defined $_[0] or return '';
  my $P = defined $_[1] ? $_[1] : 0;
  $P = length($_[0]) - ($P & 0x7FFFFFFF) - 1;
  return substr($_[0], $P, 1);
}
##################################################
#                                      v2019.11.23
# Returns the first byte of a string OR returns the
# Nth byte if a second argument is given. Returns the
# last byte if N is -1. Returns an empty string if the
# index is out of range or if the input string is empty.
# Usage: STRING = GetChar(STRING, [N])
#
sub GetChar
{
  defined $_[0] or return '';
  defined $_[1] or return substr($_[0], 0, 1);
  my $P = $_[1];
  my $L = length($_[0]);
  $P >= 0 or $P += $L;
  ($P >= 0 && $P < $L) or return '';
  substr($_[0], $P, 1);
}
##################################################
#                                      v2019.11.23
# Returns the ASCII code of the first byte of a
# string OR returns the Nth byte if a second
# argument is given. Returns the value of the
# last byte if N is -1. Returns 0 if the index
# is out of range or if the string is empty.
# Usage: INTEGER = GetCharCode(STRING, [N])
#
sub GetCharCode
{
  defined $_[0] or return 0;
  defined $_[1] or return vec($_[0], 0, 8);
  my $L = length($_[0]);
  my $P = $_[1];
  $P >= 0 or $P += $L;
  ($P >= 0 && $P < $L) or return 0;
  vec($_[0], $P, 8);
}
##################################################
#                                      v2019.11.25
# Splits a string along numbers and returns an
# array of alternating numbers and text.
# Usage: ARRAY = SplitNumbers(STRING)
#
# Example: SplitNumbers('6500 Main St, Miami, FL 33014') --->
#
#    ('6500', ' Main St, Miami, FL ', '33014')
#
sub SplitNumbers
{
  defined $_[0] or return ();
  my ($PTR, $PREV, $LEN, $TYPE, @A) = (0, -1, length($_[0]));
  $LEN or return ();

# Possible values for $PREV: -1=Uninitialized 0=NUMBER 1=TEXT

  for (my $i = 0; $i < $LEN; $i++)
  {
    $TYPE = vec($_[0], $i, 8);
    $TYPE = $TYPE < 48 || $TYPE > 57;	# Is it a number?
    if ($PREV == !$TYPE)		# Same as before?
    {
      push(@A, substr($_[0], $PTR, $i-$PTR));
      $PTR = $i;
    }
    $PREV = $TYPE;
  }
  push(@A, substr($_[0], $PTR));    # Process last chunk
  return @A;
}
##################################################
#                                       v2021.1.17
# This function extracts digits from a string and
# returns them in an array.
#   Example:
# GetNumbers("34DX5g") -> ["34", "5"]
# GetNumbers("-x39.4") -> ["39", "4"]
# Usage: ARRAY = GetNumbers(STRING)
#
sub GetNumbers
{
  my @N;
  defined $_[0] or return @N;
  my ($L, $p, $i, $c) = (length($_[0]), -1);
  for ($i = 0; $i <= $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    if ($c < 48 || $c > 57)
    {
      if ($p >= 0) { push(@N, substr($_[0], $p, $i - $p)); }
      $p = -1;
    }
    elsif ($p < 0) { $p = $i; }
  }
  return @N;
}
##################################################
#                                       v2019.6.15
# Sends a simple B/W bitmap image to stdout.
# Usage: SpitBMP(WIDTH, HEIGHT)
#
sub SpitBMP
{
  $| = 1;
  my $W = defined $_[0] ? $_[0] : 1;
  my $H = defined $_[1] ? $_[1] : 1;
  my $HEADERLEN = 62;
  my $BITS_PER_PIXEL = 1;
  my $DATASIZE = CEIL(($W * $H) >> 3);
  my $FILESIZE = $DATASIZE + $HEADERLEN;
  my $HEADER = 'BM' . pack('VxxxxVVVV', $FILESIZE, $HEADERLEN, 40, $W, $H) . chr(1) . pack('xCxxxxxV', $BITS_PER_PIXEL, $DATASIZE) . "\0" x 20 . "\xFF\xFF\xFF\0";
  my $OUTPUT = $HEADER . "\0" x $DATASIZE;
  print "Content-Type: image/bmp\n",
        'Content-Length: ', length($OUTPUT), "\n\n", $OUTPUT;
}
##################################################
#
# This function produces a 16-color 1x1 BMP image
# and sends it to stdout.
# Usage: SpitColorBMP(COLOR)
#
# Example: SpitColorBMP('A0')   --->  red pixel
#          SpitColorBMP('90')   --->  green pixel
#
sub SpitColorBMP
{
  $| = 1;
  my $Y = "\0"x2;
  my $Z = "\0"x3;
  my $COLOR = defined $_[0] ? $_[0] : 0;
  print "Content-type: image/bmp\n\n",
  "BMz", chr(0)x7, "v$Z($Z\x01$Z\x01$Z",
  "\x01\0\x04$Z$Y\x04", chr(0)x25, "\x80$Y\x80$Z",
  "\x80\x80\0\x80$Z\x80\0\x80\0\x80\x80$Y\x80\x80",
  "\x80\0\xC0\xC0\xC0$Z\xFF$Y\xFF$Z\xFF\xFF\0\xFF",
  "$Z\xFF\0\xFF\0\xFF\xFF$Y\xFF\xFF\xFF\0", chr(hex($COLOR)), "$Z";
}
##################################################
#                                      v2021.12.31
# This function opens Windows Paint to view or
# edit the photo. On Linux, this function doesn't
# do anything (yet).
# Usage: OpenPhotoEditor(FileName)
#
sub OpenPhotoEditor
{
  my $FileName = defined $_[0] ? $_[0] : '';
  my $OS = uc($^O);
  index($OS, 'MSWIN') >= 0 or return;

  # Open Windows Paint and continue with perl script...
  # Remove the word "START" to cause perl to wait until Paint is closed before continuing.
  system("START C:\\WINDOWS\\SYSTEM32\\MSPAINT.EXE \"$FileName\"");
}
##################################################
#                                      v2021.12.31
# Returns a 24-bit integer after fusing together
# the RED, GREEN and BLUE values.
# Usage: INTEGER = RGB(RED, GREEN, BLUE)
#
sub RGB { return (($_[0] & 255) << 16) | (($_[1] & 255) << 8) | ($_[2] & 255); }
##################################################
#                                      v2021.12.31
# Fuses RED, GREEN and BLUE values into a 3-byte string.
# Usage: STRING = RGB2str(INTEGER, INTEGER, INTEGER)
#
sub RGB2str
{
  my $C = '';
  vec($C, 0, 8) = $_[0] & 255;
  vec($C, 1, 8) = $_[1] & 255;
  vec($C, 2, 8) = $_[2] & 255;
  return $C;
}
##################################################
#                                      v2021.12.31
# Converts a 24-bit integer to a 3-byte string.
# Usage: STRING = Color2str(INTEGER)
#
sub Color2str
{
  my $C = '';
  vec($C, 0, 8) = ($_[0] >> 16) & 255;  # Write RED
  vec($C, 1, 8) = ($_[0] >> 8) & 255;   # Write GRN
  vec($C, 2, 8) = $_[0] & 255;          # Write BLU
  return $C;
}
##################################################
#                                      v2021.12.31
# Returns a random RGB color as a 24-bit integer.
# Usage: INTEGER = RandomColor()
#
sub RandomColor
{
  my $R = (rand() * 7285799078) & 255;
  my $G = (rand() * 6231646627) & 255;
  my $B = (rand() * 5465284336) & 255;
  return RGB($R, $G, $B);
}
##################################################
#                                      v2021.12.31
# Draws a bunch of random boxes on the image.
# Usage: DrawRandomBoxes(ImageData, Count)
#
sub DrawRandomBoxes
{
  my $COUNT = defined $_[1] ? $_[1] : 0;
  my $ImageWidth = vec($_[0], 0, 16);
  my $ImageHeight = vec($_[0], 1, 16);
  while ($COUNT--)
  {
    my $x = int(rand($ImageWidth)) >> 1;
    my $y = int(rand($ImageHeight)) >> 1;
    my $w = int(rand() * $ImageWidth) >> 1;
    my $h = int(rand() * $ImageHeight) >> 1;
    DrawBox($x, $y, $w, $h, $_[0], RandomColor());
  }
}
##################################################
#                                      v2021.12.31
# Draws a filled box on an image.
# Usage: DrawBox(x, y, Width, Height, Image, Color)
#
sub DrawBox
{
  my ($x, $y, $w, $h, $Data, $Color) = @_;

  # Make sure we have the right arguments
  # If any coordinates are outside the image boundaries, we don't expand the image.
  return if ($w <= 0 || $h <= 0);
  my $ImageWidth = vec($Data, 0, 16);
  my $ImageHeight = vec($Data, 1, 16);
  return if ($x >= $ImageWidth);
  return if ($y >= $ImageHeight);
  if ($x < 0) { $x = 0; } elsif ($x + $w >= $ImageWidth) { $w = $ImageWidth - $x - 1; }
  if ($y < 0) { $y = 0; } elsif ($y + $h >= $ImageHeight) { $h = $ImageHeight - $y - 1; }

  $Color = Color2str($Color);

  my $x2 = $x + $w;
  my $y2 = $y + $h;
  for (; $y <= $y2; $y++)
  {
    my $PTR = ($y * $ImageWidth + $x) * 3 + 4;
    for (my $i = 0; $i <= $w; $i++)
    {
      substr($_[4], $PTR, 3, $Color);
      $PTR += 3;
    }
  }
}
##################################################
#                                      v2021.12.30
# Draws random dots all over the image.
# Usage: DrawRandomDots(ImageData, Count)
#
sub DrawRandomDots
{
  my $ImageWidth = vec($_[0], 0, 16);
  my $ImageHeight = vec($_[0], 1, 16);
  my $COUNT = defined $_[1] ? $_[1] : 10;
  while ($COUNT--)
  {
    my $X = int(rand($ImageWidth));
    my $Y = int(rand($ImageHeight));
    SetPixel($X, $Y, $_[0], RandomColor());
  }
}
##################################################
#                                      v2021.12.29
# Changes the color of one pixel in an image.
#
# NO ERROR CHECKING IS DONE!
# Do not call this function with coordinates that
# are outside the boundaries of the image! Doing so
# will have undesired results! If any arguments are
# missing, this function will still do something
# you probably don't want...
#
# The color must be an integer whose lower 24 bits
# store the values for red, green and blue.
# Example: 0xFFCC00 = orange
#
# Usage: SetPixel(x, y, Image, Color)
#
sub SetPixel
{
  my $Width = vec($_[2], 0, 16);
  my $PTR = (($_[1] * $Width) + $_[0]) * 3 + 4;
  my $RGB = $_[3];
  substr($_[2], $PTR, 3, Color2str($RGB));
}
##################################################
#                                      v2021.12.29
# This function creates a canvas in memory and fills
# it with the given color. The color must be an
# integer whose lower 24 bits store the color values
# for red, green and blue. Example: 0xFFFF00 = yellow
# Minimum size of the canvas: 0 x 0 pixels
# Maximum size of the canvas: 32767 x 32767 pixels
# If no arguments are provided, this function returns
# a 1x1 image that contains one white pixel.
#
# The "canvas" or "image" returned by this function
# is a simple string that contains raw bitmap data
# (which is not the same as the BMP file format).
#
# Example: CreateCanvas(120, 100, 0xFF0000)
#    Creates a 120x100 image that is solid red color.
#
# Usage: STRING = CreateCanvas(Width, Height, [Color])
#
sub CreateCanvas
{
  my $W = defined $_[0] ? int($_[0]) : 1;
  my $H = defined $_[1] ? int($_[1]) : 1;
  my $C = defined $_[2] ? int($_[2]) : 0xFFFFFF;
  $W >= 0 or $W = 0; $W < 32768 or $W = 32767;   # Allowed Width: 0-32767
  $H >= 0 or $H = 0; $H < 32768 or $H = 32767;   # Allowed Height: 0-32767
  my $SIZE = '';
  vec($SIZE, 0, 16) = $W;                        # Store image width
  vec($SIZE, 1, 16) = $H;                        # Store image height
  my $PIXEL = Color2str($C);                     # Write color value into $PIXEL as string
  return $SIZE . ($PIXEL x ($W * $H));
}
##################################################
#                                      v2021.12.30
# This function flips an image vertically.
# Usage: FlipVertical(ImageData)
#
sub FlipVertical
{
  defined $_[0] or return;
  my $ImageWidth  = vec($_[0], 0, 16);
  my $ImageHeight = vec($_[0], 1, 16);
  $ImageWidth > 0 or return;
  $ImageHeight > 1 or return;

  my $t;
  my $FirstLine = 0;
  my $LastLine = $ImageHeight - 1;
  my $Lines = int($ImageHeight >> 1);
  while ($Lines--)
  {
    my $P1 = $FirstLine * $ImageWidth * 3 + 4;
    my $P2 = $LastLine * $ImageWidth * 3 + 4;
    for (my $i = 0; $i < $ImageWidth * 3; $i++)
    {
      $t = vec($_[0], $P2, 8);
      vec($_[0], $P2, 8) = vec($_[0], $P1, 8);
      vec($_[0], $P1, 8) = $t;
      $P2++;
      $P1++;
    }
    $FirstLine++;
    $LastLine--;
  }
}
##################################################
#                                      v2021.12.29
# Converts ImageData to a Bitmap (BMP) image format
# and outputs it either to a file or to stdout.
# ImageData should be a string starting with
# 16-bit width and 16-bit height of the image,
# followed by 24-bit RRGGBB value groups.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: INTEGER = SaveBMP(FileName, ImageData)
#
sub SaveBMP
{
  @_ == 2 or return 0;
  my $FileName = defined $_[0] ? $_[0] : '';
  my $Data     = defined $_[1] ? $_[1] : '';
  my $Width    = vec($Data, 0, 16);
  my $Height   = vec($Data, 1, 16);

  my $HEADERLEN = 54;
  my $BITS_PER_PIXEL = 24;
  my $PADDING = $Width & 3;
  my $DATASIZE = ($Width * 3 + $PADDING) * $Height;
  my $FILESIZE = $DATASIZE + $HEADERLEN;
  my $OUTPUT = 'BM' . pack('VxxxxVVVV', $FILESIZE, $HEADERLEN, 40, $Width, $Height) . chr(1) . pack('xCxxxxxV', $BITS_PER_PIXEL, $DATASIZE) . "\0" x 16;

  # BMP files contain images upside down,
  # so we flip the data as we copy it into $OUTPUT.
  my $BYTES_PER_LINE = $Width * 3;
  my $src = ($Height - 1) * $BYTES_PER_LINE + 4;
  while ($src > 0)
  {
    # BMP files also contain R-G-B values as B-G-R
    # so here we swap the Red and Blue values one by one. So stupid, I know...
    my $LINE = substr($Data, $src, $BYTES_PER_LINE);
    for (my $i = 0; $i < $BYTES_PER_LINE; $i += 3)
    {
      my $t = vec($LINE, $i+2, 8);
      vec($LINE, $i+2, 8) = vec($LINE, $i, 8);
      vec($LINE, $i, 8) = $t;
    }
    $OUTPUT .= $LINE;
    $src -= $BYTES_PER_LINE;
    $PADDING or next;
    $OUTPUT .= "\0" x $PADDING;
  }

  if (length($FileName)) { return CreateFile($FileName, $OUTPUT); }    # Save BMP to file

  # Print to stdout instead...
  $| = 1;
  print "Content-Type: image/bmp\nContent-Length: ", length($OUTPUT), "\n\n", $OUTPUT;
  return 1;
}
##################################################
#                                       v2019.9.27
# This function adds two large positive integers.
#
# Both numbers must be in base 10. The numbers may
# not contain any character other than digits (0-9).
# Two additional arguments may be provided to shift
# the input numbers left or right before being added.
# A negative shift moves digits to the right
# discaring the least significant digits, while
# a positive shift moves digits to the left
# (it's the same as multiplying by 10, 100, or 1000).
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
# Usage: STRING = ADD(STRING, STRING, [INTEGER, [INTEGER]])
# Example: ADD('1111', '222', -1, 2) --> '22311'
#
sub ADD
{
  my $A = defined $_[0] ? $_[0] : '';
  my $B = defined $_[1] ? $_[1] : '';
  my $AL = length($A) + (defined $_[2] ? $_[2] : 0);
  my $BL = length($B) + (defined $_[3] ? $_[3] : 0);
  my $i = ($AL > $BL) ? $AL : $BL;
  my $CARRY = 0;
  my $SUM = '0';
  my $X;
  while ($i-- > 0)
  {
    $X  =  $AL ? vec($A, --$AL, 8) : 48;
    $X += ($BL ? vec($B, --$BL, 8) : 48) + $CARRY;
    $CARRY = $X > 105 ? 1 : 0;
    vec($SUM, $i, 8) = $X - ($CARRY ? 58 : 48);
  }
  return ($CARRY ? '1' : '') . $SUM;
}
##################################################
#                                       v2019.9.27
# This function returns the difference between two
# large positive integers in base 10. These
# "large integers" are strings that hold digits
# only (0-9) and nothing else. No spaces, tabs,
# line breaks, or letters allowed! The return value
# of this function will always be a string
# containing a positive integer.
# Tested with TinyPerl 5.8.0 and Perl 5.004 for DOS.
# Usage: STRING = DIFF(STRING, STRING)
#
sub DIFF
{
  my $A = defined $_[0] ? $_[0] : '0';
  my $B = defined $_[1] ? $_[1] : '0';
  my $AL = length($A);
  my $BL = length($B);
  my $DIFF = 0;
  my $i = 0;

# Swap A and B if B is greater

  if ($AL == $BL)
  {
    return '0' if ($A eq $B);
    while ($DIFF == 0)		# Check if B is greater
    {
      $DIFF = vec($B, $i, 8) - vec($A, $i++, 8);
    }
  }
  if ($BL > $AL || $DIFF > 0)
  {
    ($A, $B) = ($B, $A);	# Swap A and B
  }

# At this point, we know that $A > $B

  my $AX;		# Current digit from integer A
  my $BX = 0;		# Current digit from integer B + carry
  my $START = 0;	# Start trim
  $DIFF = '';		# This will be our return value
  $AL = length($A);
  $BL = length($B);
  $i = my $MAXLEN = ($AL > $BL) ? $AL : $BL;
  while ($i--)					# Loop until max($AL, $BL)
  {
    $AX  = $AL ? vec($A, --$AL, 8) : 48;
    $BX += $BL ? vec($B, --$BL, 8) : 48;	# Get new digit + Add carry
    $AX -= $BX;					# Subtract
    $BX = $AX < 0 ? 1 : 0;			# Carry 1 or 0
    $AX += $BX ? 58 : 48;			# Convert digit to ASCII code '0' - '9'
    vec($DIFF, $i, 8) = $AX;			# Write digit
    $AX == 48 or $START = $i;			# Keep track of last non-zero digit
  }
  return substr($DIFF, $START);			# Remove initial zeros
}
##################################################
# Extracts a section from string S that lies between
# the first occurrence of strings A and B. Returns
# an empty string if A is not found.
# Usage: STRING = Between(S, A, [B])
#
sub Between
{
  (defined $_[0] && defined $_[1]) or return '';
  (length($_[0]) && length($_[1])) or return '';
  my $p1 = index($_[0], $_[1]);
  return '' if ($p1 < 0);
  my $B = defined $_[2] ? $_[2] : '';
  length($B) or return substr($_[0], $p1);
  my $p2 = index($_[0], $B, $p1 + length($_[1]));
  return '' if ($p2 <= $p1);
  my $start = $p1 + length($_[1]);
  return substr($_[0], $start, $p2 - $start);
}
##################################################
#                                       v2019.6.15
# Just like Trim(), this function can remove spaces
# or tabs from before and after STRING but it can also
# remove any other character, whatever is found in SUBSTR.
# Usage: STRING = TrimChar(STRING, SUBSTR)
#
sub TrimChar
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L or return '';
  defined $_[1] or return $_[0];
  length($_[1]) or return $_[0];
  my $START = 0;
  my $LAST = 0;
  while ($L--)
  {
    if (index($_[1], substr($_[0], $L, 1)) < 0)
    {
      $START = $L;
      $LAST or $LAST = $L + 1;
    }
  }
  return substr($_[0], $START, $LAST - $START);
}
##################################################
#                                       v2022.2.11
# This function removes whitespace from before and
# after STRING. Whitespace is here defined as any
# character whose ASCII value is less than 33.
# This includes spaces, tabs, esc, null, vertical tab,
# new lines, etc.
# Usage: STRING = Trim(STRING)
#
sub Trim
{
  my $P = 0;
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  # In an earlier version, I used vec() to get characters,
  # but I was told that it will throw an error when working on
  # Unicode characters. So, I replaced it with ord(substr()).
  while ($P <= $L && ord(substr($_[0], $P++, 1)) < 33) {} $P--;
  while ($P <= $L && ord(substr($_[0], $L--, 1)) < 33) {}
  return substr($_[0], $P, $L - $P + 2);
}
##################################################
#                                        v2022.2.7
# This function removes whitespace from the right
# side of a string and returns a new string.
# Usage: STRING = RTRIM(STRING)
#
sub RTRIM
{
  defined $_[0] or return '';
  my $i = length($_[0]);
  while ($i >= 0 && vec($_[0], --$i, 8) < 33) {}
  return substr($_[0], 0, $i+1);
}
##################################################
#                                        v2022.2.7
# Makes sure that string ends with a certain suffix.
#
# Flags is an optional argument that modifies how this
# function handles the input string.
# When Flags is 1, the function will trim whitespace from
# the end of string before checking if it ends with the suffix.
# When Flags is 0x10, the checking is not case sensitive.
# When Flags is 0x100, the function makes sure that the suffix
# is not repeated more than once at the end of the string.
# When Flags is 0x1010, the function removes the suffixes
# it has matched and adds the new one.
#
# Example:
#   EndWith('hello World', 'WORLD')                       => 'hello WorldWORLD'
#   EndWith('hello World', 'WORLD', 0x0010)               => 'hello World'
#   EndWith('hello World', 'WORLD', 0x1010)               => 'hello WORLD'
#   EndWith('hello World  World  WORLD', 'WORLD', 0x0101) => 'hello World'
#   EndWith('hello World  World  WORLD', 'WORLD', 0x1101) => 'hello WORLD'
#
# Usage: STRING = EndWidth(STRING, SUFFIX, [FLAGS])
#
sub EndWith
{
  my $S = defined $_[0] ? $_[0] : '';  # String
  my $X = defined $_[1] ? $_[1] : '';  # Suffix
  my $F = defined $_[2] ? $_[2] : 0;   # Flags
  my $i = ($F & 256) ? 0x7FFFFFFF : 1;
  my $FoundSuffix = -1;
  my $LS = length($S);  # Length of string
  my $LX = length($X);  # Length of suffix
  while ($i--)          # Remove existing suffix(es) if any
  {
    $LS >= $LX or last;
    if ($F & 1) { while ($LS >= 0 && vec($S, --$LS, 8) < 33) {} $LS++; }
    my $CurrentSuffix = substr($S, $LS - $LX, $LX);
    if (($F & 0x10) ? uc($CurrentSuffix) eq uc($X) : $CurrentSuffix eq $X)
    { $FoundSuffix = $LS; $LS -= $LX; } else { last; }
  }
  if ($FoundSuffix < 0) { return $S . $X; }
  return ($F & 0x1000) ? substr($S, 0, $LS) . $X : substr($S, 0, $FoundSuffix);
}
##################################################
#                                       v2019.12.8
# Returns the first word from a string which may
# start with whitespace or new line characters.
# Usage: STRING = ExtractFirstWord(STRING)
#
sub ExtractFirstWord
{
  defined $_[0] or return '';
  my ($i, $P, $L) = (-1, -1, length($_[0]));
  $L or return '';
  while (++$i < $L)
  {
    if (vec($_[0], $i, 8) > 32)
    { $P >= 0 or $P = $i; }
    else
    { $P < 0 or last; }
  }
  return substr($_[0], $P, $i - $P);
}
##################################################
#                                      v2019.11.27
# Redirects the visitor's browser to another site.
# Usage: Redirect(URL)
#
sub Redirect
{
  defined $_[0] or return;
  print "Content-type: text/html\n\nLocation: $_[0]\n\n";
}
##################################################
#                                       v2019.8.29
# Takes number V and returns the same number
# unless it equals either A or B in which case
# it swaps the output:
#   If V == A, then returns B.
#   If V == B, then returns A.
#
# Usage: NUMBER = SwapNum(V, A, B)
#
sub SwapNum
{
  @_ == 3 or return 0;
  my ($V, $A, $B) = @_;
  return $V == $A ? $B : ($V == $B ? $A : $V);
}
##################################################
#                                        v2021.1.2
# Escapes a string using a custom character set.
# The first character of CHARSET will be used as
# an escape character. The rest of the characters
# will not be escaped.
# Usage: STRING = EscapeString(STRING, CHARSET)
#
#sub EscapeString
#{
#  @_ == 2 or return '';
#  my ($STR, $SET, $P, $c) = @_;
#  my $ESC = substr($SET, 0, 1);
#  my $OUTPUT = '';
#  for (my $i = 0; $i < length($STR); $i++)
#  {
#    $c = substr($STR, $i, 1);
#    $P = index($SET, $c, 1);
#    if ($P > 0) { $OUTPUT .= $c; next; }
#    $OUTPUT .= $ESC . sprintf('%.2X', vec($STR, $i, 8));
#  }
#  return $OUTPUT;
#}
# SHORT VERSION:
# Escapes a string using a custom character set. The first character of CHARSET will be used as an escape character. The rest of the characters will not be escaped.
# sub EscapeString { @_ == 2 or return ''; my ($STR, $SET, $P, $c) = @_; my $ESC = substr($SET, 0, 1); my $OUTPUT = ''; for (my $i = 0; $i < length($STR); $i++) { $c = substr($STR, $i, 1); $P = index($SET, $c, 1); if ($P > 0) { $OUTPUT .= $c; next; } $OUTPUT .= $ESC . sprintf('%.2X', vec($STR, $i, 8)); } return $OUTPUT; }
#
##################################################
#                                        v2021.1.2
# This function is the reverse of EscapeString()
# Usage: STRING = UnescapeString(STRING, CHARSET)
#
#sub UnescapeString
#{
#  @_ == 2 or return '';
#  my ($STR, $SET) = @_;
#  $STR =~ s/\%/\%25/g;
#  my $c = substr($SET, 0, 1);
#  $STR =~ s/\Q$c/\%/g;
#  unescape($STR);
#}
# SHORT VERSION:
# This function is the reverse of EscapeString()
# Usage: STRING = UnescapeString(STRING, CHARSET)
# sub UnescapeString { @_ == 2 or return ''; my ($STR, $SET) = @_; $STR =~ s/\%/\%25/g; my $c = substr($SET, 0, 1); $STR =~ s/\Q$c/\%/g; unescape($STR); }
#
##################################################
#                                       v2020.6.16
# This function is similar to the escape() function
# in JavaScript. It takes a string and converts the
# special characters to %XX format where XX is
# a hexadecimal number.
# Usage: STRING = escape(STRING)
#
# Example: "+Hello World!" --> "%2BHello+World%21"
#
sub escape
{
  my $X = defined $_[0] ? $_[0] : '';
  my $L = length($X);
  $L or return '';

  my ($i, $j, $Z, $C) = (0, 0, '');
  while ($i < $L)
  {
    $C = vec($X, $i++, 8);
    if ($C == 32)
    {
      $C = 43;
    }
    elsif (($C < 44 || $C > 122) || ($C > 90 && $C < 95) || ($C == 60 || $C == 62))
    {
      $Z .= '%' . sprintf("%.02X", $C);
      $j += 3;
      next;
    }
    vec($Z, $j++, 8) = $C;
  }
  return $Z;
}
# SHORT VERSION:
# Similar to the escape() function in JavaScript.
# Usage: STRING = escape(STRING)
# sub escape { my $X = defined $_[0] ? $_[0] : ''; my $L = length($X); $L or return ''; my ($i, $j, $Z, $C) = (0, 0, ''); while ($i < $L) { $C = vec($X, $i++, 8); if ($C == 32) { $C = 43; } elsif (($C < 44 || $C > 122) || ($C > 90 && $C < 95) || ($C == 60 || $C == 62)) { $Z .= '%' . sprintf("%.02X", $C); $j += 3; next; } vec($Z, $j++, 8) = $C; } return $Z; }
#
##################################################
#                                       v2019.8.29
# This function converts an URL string to regular
# binary string. It's the opposite of the escape()
# function. If it encounters any invalid codes,
# those characters will be included as part of the
# string. If it encounters an unexpected end of
# string, it will produce no warnings and no errors.
# Usage: STRING = unescape(STRING)
#
sub unescape
{
  my $X = defined $_[0] ? $_[0] : '';
  my $L = length($X);
  $L or return '';

  my $i = index($X, '%');	# Find first encoded character
  return $X if ($i < 0);	# Found none? -> Return original string
  my $j = $i - 1;
  my $C = 0;
  my $D = 0;

  $X =~ tr|+| |;
  for (; $i < length($X); $i++)
  {
    $C = vec($X, $i, 8);
    if ($C == 37)
    {
      $C = substr($X, ++$i, 1);   # Grab first hex digit
      last if (length($C) == 0);  # Unexpected end of string?
      $C = index($HEX, uc($C));   # Expecting hex digit
      if ($C < 0) { $i--; next; } # Not a hex digit?
      $D = substr($X, ++$i, 1);   # Grab second digit
      if (length($D))             # Got it!
      {
        $D = index($HEX, uc($D)); # Expecting hex digit
        if ($D < 0) { $i--; }     # Not a hex digit?
        else
        { $C <<= 4; $C += $D; }   # We're using 2 hex digits
      }
    }
    if ($j < $i) { vec($X, ++$j, 8) = $C; }
  }
  if ($j < $i) { $X = substr($X, 0, ++$j); }
  return $X;
}
# SHORT VERSION:
# Opposite of the escape() function.
# Usage: STRING = unescape(STRING)
# sub unescape { my $X = defined $_[0] ? $_[0] : ''; my $L = length($X); $L or return ''; my $i = index($X, '%'); return $X if ($i < 0); my $j = $i - 1; my $C = 0; my $D = 0; $X =~ tr|+| |; for (; $i < length($X); $i++) { $C = vec($X, $i, 8); if ($C == 37) { $C = substr($X, ++$i, 1); last if (length($C) == 0); $C = index($HEX, uc($C)); if ($C < 0) { $i--; next; } $D = substr($X, ++$i, 1); if (length($D)) { $D = index($HEX, uc($D)); if ($D < 0) { $i--; } else { $C <<= 4; $C += $D; } } } if ($j < $i) { vec($X, ++$j, 8) = $C; } } if ($j < $i) { $X = substr($X, 0, ++$j); } return $X; }
#
##################################################
#
# This function creates a path to a given file.
# Note: Path must not contain a space or tab!
#
# Return values: 0=SUCCESS
#                1=FAILED
#                2=INVALID PATH
#
# Usage: INTEGER MakePath(FULLNAME)
#
# Example: MakePath('C:\ABC\x.txt') ---> Creates C:\ABC folder
#          MakePath('\A\B\C')       ---> Creates C:\A\B folders
#          MakePath('\A\B\C\')      ---> Creates C:\A\B\C folders
#          MakePath('\ABC')         ---> do nothing
#          MakePath('\AAA\ABC')     ---> Create \AAA folder
#
sub MakePath
{
  my $PATH = shift;
  my $C;
  my $P;
  my $i;

  # Change all backslash to forward slash
  $PATH =~ tr#\\#/#;

  # Check for illegal characters or invalid format
  return 2 if (index($PATH, '..') >= 0);
  for ($i = 0; $i < length($PATH); $i++)
  {
    $C = ord(substr($PATH, $i, 1));
    return 2 if ($C < 33 || $C > 126);
    return 2 if (index('*?=;+,[|]<">', chr($C)) >= 0);
    if ($C == 58) { return 2 if ($i != 1); }
  }

  # Chop file name, leave path only
  $i = rindex($PATH, '/');
  return 0 if ($i < 1);
  $PATH = substr($PATH, 0, ++$i);

  # Create folders
  for ($i = $P = 0; $i < length($PATH); $i++)
  {
    $C = ord(substr($PATH, $i, 1));
    if ($C == 47)
    { mkdir(substr($PATH, 0, $i), 0777) if ($P != 58 && $P != 0); }
    $P = $C;
  }

  # Check success
  return (-d $PATH) ? 0 : 1;
}
##################################################
#                                       v2019.7.13
# Splits a path string along / or \ characters.
# Usage: ARRAY = SplitPath(STRING)
#
sub SplitPath
{
  my $PATH = defined $_[0] ? Trim($_[0]) : '';
  length($PATH) or return ();
  $OS > 2 or $PATH =~ tr#\\#/#;
  my $P = index($PATH, ':///');
  split('/', ($P < 0) ? $PATH : substr($PATH, $P + 4));
}
##################################################
#
# This function changes the current working directory.
# Usage: INTEGER = CHDIR(PATH)
#
sub CHDIR
{
  defined $_[0] or return 0;
  my $PATH = GetAbsolutePath($_[0]);
  if (-e $PATH)
  {
    `cd $PATH`;
    $ENV{PWD} = $PATH;
  }
  else
  {
    my @D = SplitPath($PATH);
    for (my $i = 0; $i < @D; $i++)
    {
    }
  }
}
##################################################
#                                      v2019.11.28
# This function executes x86 binary code in DOS/Windows.
# Tested using TinyPerl 5.8 with Windows 7 Ultimate 32-bit,
# Windows XP PRO SP2 (32-bit), and DOS Perl 5.004_02.
# Returns whatever the program prints to stdout or
# returns an empty string if something went wrong.
# The PROGRAM string should contain the name of
# the file (to be created) and any arguments
# that may need to be passed.
# Usage: STRING = ExecX86(PROGRAM, BINARY)
# Example: ExecX86('MVCURSOR.COM 4 12', '...');
#
sub ExecX86
{
  @_ == 2 && $OS < 3 or return '';
  (defined $_[0] && defined $_[1]) or return '';
  (length($_[0]) && length($_[1])) or return '';
  my $PATH = 'C:\\WINDOWS\\TEMP\\';
  SplitAB($_[0], ' ');
  my $PRG = $PATH . GetFileName($a);
  my $ARGS = $b;
  my $CODE = $_[1];
  my $WRITE = (-e $PRG) ? (-s $PRG == length($CODE) ? 0 : 2) : 1;
  if ($WRITE)
  {
    -e $PATH or mkdir($PATH, 0777);
    # Remove read-only flag if the file exists
    if ($WRITE == 2) { chmod 0777, $PRG; }
    local *FH;
    open(FH, ">$PRG") or return '';
    binmode FH;
    print FH $CODE;
    close FH or return '';
  }
  return `$PRG $ARGS`;
}
##################################################
#                                      v2019.11.28
# This function returns the character width and height
# of the console window as an array.
# Usage: ARRAY = GetConsoleSize()
#
# $ARRAY[0] = WIDTH
# $ARRAY[1] = HEIGHT
#
sub GetConsoleSize
{
  my $WIDTH = 80;
  my $HEIGHT = 25;
  if ($OS < 3)
  {
    # DOS or WinXP: Use an assembly code
    if (index(`ver`, 'Version 5.') >= 0 || $OS == 1)
    {
      # We acquire the screen width by calling BIOS INT 10...
      my $OUTPUT = ExecX86('SCRWIDTH.COM', "\xB4\x0F\xCD\x10\xA3\0\1\xC6\6\2\1\$\xB4\t\xBA\0\1\xCD!\xC3");
     if (length($OUTPUT) == 2) { $WIDTH = vec($OUTPUT, 1, 8); }
    }
  }
  elsif ($OS == 2)	# Windows: Use powershell
  {
    my $W = uc(`POWERSHELL -COMMAND ECHO \$HOST.UI.RAWUI`);
    my @N = SplitNumbers(TrimChar(Between($W, 'WINDOWSIZE', "\n"), ' :'));
    if (@N == 3) { $WIDTH = $N[0]; $HEIGHT = $N[2]; }
  }
  else			# Linux: Use tput ...
  {
    $WIDTH = `tput cols`;
    $HEIGHT = `tput lines`;
  }
  return ($WIDTH, $HEIGHT);
}
#################################################
#                                     v2019.11.28
# LINUX/OSX ONLY!
# Changes the cursor's position within the
# terminal window using ANSI codes.
# Usage: MoveCursor(X, Y)
#
sub MoveCursor
{
  $OS > 2 or return;
  my $X = defined $_[0] ? $_[0] : 1;
  my $Y = defined $_[1] ? $_[1] : 1;
  $X > 0 or $X = 1;
  $Y > 0 or $Y = 1;
  print "\x1B[$Y;$X", 'H';
  #system("tput cup $Y $X");
}
##################################################
#                                      v2019.11.28
# This function expects a relative path which may
# begin with . or .. and returns an absolute path.
# Usage: FULLPATH = GetAbsolutePath(PATH)
#
sub GetAbsolutePath
{
  defined $_[0] or return '';
  my $P = Trim($_[0]);
  length($P) or return '';
  $OS > 2 or $P =~ tr#\\#/#;
  if (vec($P, 0, 8) == 46)	# Starts with . or ..
  {
    return JoinPath(GetCurrentDirectory(), $P);
  }
  elsif (vec($P, 0, 8) == 47)	# Starts with / or \
  {
    return JoinPath(GetCurrentDrive() . '/', $P);
  }
  elsif (vec($P, 1, 8) == 58)	# Starts with a drive letter?
  {
    if (vec($P, 2, 8) != 47)	# Missing / or \
    {
      my $DRIVE = substr($P, 0, 2);
      my $PATH_WITHOUT_DRIVE = substr(GetCurrentDirectory($DRIVE), 2);
      $P = substr($P, 2);
      # If the path is "C:WORK" or something like that, then
      # it is clearly missing a part. The drive letter
      # must always be followed by a backslash.
      return JoinPath($DRIVE . '/', $PATH_WITHOUT_DRIVE, $P);
    }
    return JoinPath($P, '');
  }
  return JoinPath(GetCurrentDirectory(), $P);
}
##################################################
#                                      v2019.11.28
# This function returns a 32-bit integer.
# Usage: LONG = Checksum(STRING)
#
sub Checksum
{
  use integer;
  my $C = 0x55555555;
  defined $_[0] or return $C;
  my $S = $_[0];
  my $i = length($S);
  while ($i--)
  {
    $C += ((vec($S, $i, 8) + 1) << (($i & 3) << 3));
    $C = (($C >> 31) & 1) | (($C << 1) & 0xFFFFFFFe);
  }
  return $C & 0xFFFFFFFF;
}
##################################################
#                                      v2019.11.28
# This function prints something in color in the
# terminal window.
# Usage: cprintf(COLOR, TEXT, [ARGS])
#
sub cprintf
{
  @_ > 1 or return;
  my $E = shift;
  my $A = ($E & 0xF00) >> 8; # Get font style
  my $B = ($E & 0x0F0) >> 4; # Get background color
  my $C = ($E & 0x00F);      # Get text color

# Linux/OSX cprintf solution using ANSI codes:

  if ($OS > 2)
  {
    $E = '2648375vnrptosqu';	# Color code translation table
    $E = "\x1B[" . (vec($E, $C, 8) - 20) . "m\x1B[" . (vec($E, $B, 8) - 10) . 'm';

    if ($A & 1) { $E .= "\x1B[05m"; }  # BLINKING
    if ($A & 2) { $E .= "\x1B[04m"; }  # UNDERLINE
    if ($A & 4) { $E .= "\x1B[03m"; }  # ITALIC
    if ($A & 8) { $E .= "\x1B[01m"; }  # BOLD

    print $E;		# Set color
    printf(@_);
    print "\x1B[0m";	# Reset color
    return;
  }

# Windows cprintf solution:

  my $MSG = sprintf(shift, @_);

  # We're going to use this as a command line argument,
  # so we need to clean the string...

  $MSG =~ tr#|<>"\r\n##d;
  $MSG = "\"$MSG\"";

  if ($OS == 2 && $X64)
  {
    # This solution requires Windows Powershell,
    # so it will not work if PowerShell is missing!

    my $POWERSHELL = "C:\\Windows\\System32\\WindowsPowerShell\\v1.0\\PowerShell.exe";
    if (-e $POWERSHELL)
    {
      system("POWERSHELL -COMMAND WRITE-HOST $MSG -FOREGROUND $C -BACKGROUND $B");
      return;
    }
  }

# DOS cprintf solution:

  # Here we use a 16-bit DOS program to print color text.
  # This will work on some Windows as well, but it
  # won't work on a 64-bit Windows platform.

  $E = sprintf('%.2X', $E);    # Prepare color attribute
  ExecX86("COLORMSG.COM $E $MSG", "\xB3\x812\xFF\x8AO\xFF2\xED\xE39\x8B\xFB\xB0 \xFC\xF3\xAEtQ\xE3~\x8AE\xFF\xB3\x24\xFE\xC7S\xB3\xAD\xFF\xE3\xEBn\x80= ts\xD0\xE0\xD0\xE0\xD0\xE0\xD0\xE0\x8A\xE0G\x8AE\xFF\xB3\x3CS\xEBq\xB3A\x80/!+\xC4I\xE3N2\xE4P\xB8\"\"\xF2\xAEuD\xE3B\x8B\xF7\x8B\xD1\xF2\xAEu\x40J:%u;GIu\xF3+\xD1t-\x8B\xCA\xB3|\x80/!\xB3\x86\x80/![\xB0 \xB4*\x80\xEC!\xCD1\xB2\"\xAC\xB4/\x80\xEC!\xCD1:\xC2u\x97\x8A\xE2:\x24u\x91F\xE2\xEB2\xC0\xB4L\xCD!\xEB\xC7\xEB\xA6,0\xC3\x3CAr\xF9\xB2\xF9\xF6\xDA*\xC2\xEB\xF1\x3Car\xF0, \xEB\xEC");
}
##################################################
#                                      v2019.11.28
# This function prints something in color in the
# terminal window. Unfortunately it's quite slow
# in Windows and DOS...
# Usage: cprint(COLOR, STRING, [STRING], [etc...])
#
sub cprintf
{
  @_ > 1 or return;
  my $E = shift;
  my $MSG = join('', @_);
  my $A = ($E & 0xF00) >> 8; # Get font style
  my $B = ($E & 0x0F0) >> 4; # Get background color
  my $C = ($E & 0x00F);      # Get text color

  # Linux/OSX cprintf solution using ANSI codes:
  my $OS = uc($^O);
  if ($OS =~ /LINUX|DARWIN/)
  {
    $E = '2648375vnrptosqu';	# Color code translation table
    $E = "\x1B[" . (vec($E, $C, 8) - 20) . "m\x1B[" . (vec($E, $B, 8) - 10) . 'm';

    if ($A & 1) { $E .= "\x1B[05m"; }  # BLINKING
    if ($A & 2) { $E .= "\x1B[04m"; }  # UNDERLINE
    if ($A & 4) { $E .= "\x1B[03m"; }  # ITALIC
    if ($A & 8) { $E .= "\x1B[01m"; }  # BOLD

    print $E;		      # Set color
    printf($MSG);     # Print text
    print "\x1B[0m";	# Reset color
    return;
  }

  # DOS/OS2/Windows cprintf solution:

  # First we check for the existence of Windows Powershell.
  my $POWERSHELL = "C:\\Windows\\System32\\WindowsPowerShell";
  if (-e $POWERSHELL)
  {
    system("POWERSHELL -COMMAND WRITE-HOST $MSG -FOREGROUND $C -BACKGROUND $B");
    return;
  }

  # And finally, if that didn't work...

  # We're going to use this as a command line argument,
  # so we need to clean the string...
  $MSG =~ tr#|<>"\r\n##d;
  $MSG = "\"$MSG\"";

  # Here we use a 16-bit DOS program to print color text.
  # This will work on DOS/OS2 and some Windows versions as well,
  # but it won't work on a 64-bit Windows platforms. My assumption
  # is that 64-bit Windows platforms have PowerShell. If .

  $E = sprintf('%.2X', $E);    # Prepare color attribute
  my $F = 'COLORMSG.COM';
  my $BIN = "\xB3\x812\xFF\x8AO\xFF2\xED\xE39\x8B\xFB\xB0 \xFC\xF3\xAEtQ\xE3~\x8AE\xFF\xB3\x24\xFE\xC7S\xB3\xAD\xFF\xE3\xEBn\x80= ts\xD0\xE0\xD0\xE0\xD0\xE0\xD0\xE0\x8A\xE0G\x8AE\xFF\xB3\x3CS\xEBq\xB3A\x80/!+\xC4I\xE3N2\xE4P\xB8\"\"\xF2\xAEuD\xE3B\x8B\xF7\x8B\xD1\xF2\xAEu\x40J:%u;GIu\xF3+\xD1t-\x8B\xCA\xB3|\x80/!\xB3\x86\x80/![\xB0 \xB4*\x80\xEC!\xCD1\xB2\"\xAC\xB4/\x80\xEC!\xCD1:\xC2u\x97\x8A\xE2:\x24u\x91F\xE2\xEB2\xC0\xB4L\xCD!\xEB\xC7\xEB\xA6,0\xC3\x3CAr\xF9\xB2\xF9\xF6\xDA*\xC2\xEB\xF1\x3Car\xF0, \xEB\xEC";
  unless (-e $F && -s $F == length($BIN)) { CreateFile('COLORMSG.COM', $BIN); }
  system("$F $E $MSG");
}
##################################################
#                                      v2019.11.28
# Returns 1 if the OS that is installed is a
# 64-bit version OS. Returns zero otherwise.
# Usage: INTEGER = is64bitOS()
#
sub is64bitOS
{
  # If Perl is 64-bit, then the OS is 64-bit as well.
  my $PTRSIZE = `$^X -V:ptrsize`;
  $PTRSIZE =~ s/[^0-9]//g;
  if ($PTRSIZE == 8) { return 1; }

  if ($OS == 1)		# DOS is 16-bit
  { return 0; }

  if ($OS == 2)		# Check Windows
  {
    my $E = uc(`SET`);
    my $PRG = 'C:\\PROGRAM FILES (X86)';
    index($E, $PRG) < 0 or return 0;
    -e $PRG or return 0;
    if (index($E, 'PROCESSOR_ARCHITECTURE=X86') >= 0)
    { index($E, 'PROCESSOR_ARCHITEW6432') >= 0 or return 0; }
    return 1;
  }
  if ($OS > 2)		# Check Linux/OSX
  {
    return index(`uname -a`, ' x86_64') < 0 ? 0 : 1;
  }
  return 0;
}
##################################################
#                                      v2019.11.28
# This function changes the background and text
# color of the console window without erasing
# any text. This works on WINDOWS ONLY!!!
# Usage: SetBgColor(INTEGER)
#
sub SetBgColor
{
  $OS == 2 or return;
  my $C = defined $_[0] ? $_[0] : 7;
  system('COLOR ' . sprintf('%.2X', $C));
}
##################################################
#                                       v2019.12.4
# Capitalizes the first letter of every word.
# Usage: STRING = ToTitleCase(STRING)
#
sub ToTitleCase
{
  my $S = defined $_[0] ? lc($_[0]) : '';
  my ($i, $p, $BREAK) = (-1, 0);
  while (++$i < length($S))
  {
    ($BREAK = index(" .,:;!?/\\()[]{}<>|-+=\t\n\r\xFF", substr($S, $i, 1))) >= 0
      or $p < 0
      or ($p = vec($S, $i, 8)) > 122
      or vec($S, $i, 8) = $p & 223;
    $p = $BREAK;
  }
  return $S;
}
##################################################
#                                        v2021.3.3
# Capitalizes the first letter of every word.
# Usage: ASCII_STRING = TitleCase(ASCII_STRING)
#
sub TitleCase
{
  my $S = defined $_[0] ? lc($_[0]) : '';
  my $L = length($S);
  my $LETTERCOUNT = 0;
  my $WORD_SEPARATORS = " .,:;!?&/\()[]{}<>|-+=\t\n\r\xFF";
  for (my $i = 0; $i < $L; $i++)
  {
    if (index($WORD_SEPARATORS, substr($S, $i, 1)) >= 0)
      { $LETTERCOUNT = 0; }
    elsif ($LETTERCOUNT++ == 0)
    {
      my $c = vec($S, $i, 8);
      if ($c > 96 && $c < 123)  # Convert letter to upper case
        { vec($S, $i, 8) = $c & 223; }
    }
  }
  return $S;
}
##################################################
#                                       v2022.2.27
# This function builds the $PDIFF string that is
# declared at the beginning of this file.
# The $PDIFF string holds the difference between
# consecutive prime numbers, so they can be easily
# calculated without doing countless multiplications.
#
# Usage: STRING = BuildPDIFFString(MAX_VALUE)
#
sub BuildPDIFFString
{
  my $MAXVALUE = defined $_[0] ? $_[0] : 100;
  my @MUL = (0) x $MAXVALUE;

  # First we calculate the prime numbers.
  for (my $i = 1; $i <= $MAXVALUE; $i++)
  {
    for (my $j = 1; $j <= $MAXVALUE; $j++)
    {
      $a = $i * $j;
      $a < $MAXVALUE or last;
      $MUL[$a]++;
    }
  }

  # Next we calculate the difference between consecutive
  # prime numbers, and save the difference in a string.
  my $k = 0;
  my $PREV = 1;
  my $OUTPUT = '';
  for (my $i = 2; $i < $MAXVALUE; $i++)
  {
    if ($MUL[$i] < 3)
    {
      my $DIFF = $i - $PREV;    # Right now $i holds the current prime number, and $PREV holds the previous prime number.
      vec($OUTPUT, $k++, 8) = $DIFF + 47;
      $PREV = $i;
    }
  }
  return $OUTPUT;
}
####################################################################################################
#                                       v2019.12.6
# This function takes regular perl source code
# as an input string and outputs compact perl code
# that has spaces and comments removed.
# Will not work with here document!!
# Usage: STRING = CompactPerl(STRING)
#
sub CompactPerl
{
  defined $_[0] or return '';
  my @A = SplitLines($_[0]);
  my $c;
  my $P;
  foreach my $X (@A)
  {
    $X = Trim($X);
    $c = vec($X, 0, 8);
    if ($c == 35) { $X = ''; }
    if (($P = rindex($X, '#')) >= 0)
    {
      $c = vec($X, $P-1, 8);
      if ($c == 32 || $c == 9) { $X = substr($X, 0, $P); }
#     $X =~ s/[\t ]#[^#]$//;
      $X = Trim($X);
    }
    $X = Replace($X, 'my @', 'my@');
    $X = Replace($X, 'my $', 'my$');
    if (($P = index($X, '"')) < 0)
    {
      if (($P = index($X, '\'')) < 0)
      {
        if (($P = index($X, '~')) < 0)
        {
          $X = Replace($X, ', ', ',');
          $X = Replace($X, ' (', '(');
          $X = Replace($X, ' { ', '{');
          $X = Replace($X, ' } ', '}');
          $X = Replace($X, ' < ', '<');
          $X = Replace($X, ' > ', '>');
          $X = Replace($X, ' . ', '.');
          $X = Replace($X, ' .= ', '.=');
          $X = Replace($X, ' = ', '=');
          $X = Replace($X, ' == ', '==');
          $X = Replace($X, ' != ', '!=');
          $X = Replace($X, ' =~ ', '=~ ');
          $X = Replace($X, ' - ', '-');
          $X = Replace($X, ' -= ', '-=');
          $X = Replace($X, ' += ', '+=');
          $X = Replace($X, ' + ', '+');
          $X = Replace($X, ' * ', '*');
          $X = Replace($X, ' / ', '/'); # This might not be a good idea!
          $X = Replace($X, ' : ', ':');
          $X = Replace($X, ' ? ', '?');
        }
      }
    }
  }
  return join('', @A);
}
##################################################
#                                       v2019.12.7
# This function scans string S and replaces the
# first N occurrences of string A with string B
# and returns a new string. If N is -1 then only
# the last instance is replaced.
# Usage: STRING = Replace(STRING_S, STRING_A, [STRING_B, [N]])
#
sub Replace
{
  # First, we make sure that required arguments are available
  # and any special scenarios are handled correctly.

  defined $_[0] or return '';     # Missing arguments?
  defined $_[1] or return $_[0];  # Missing arguments?
  my $B = defined $_[2] ? $_[2] : '';    # Replace to --> $B
  my $N = defined $_[3] ? $_[3] : 0x7FFFFFFF;   # Get $N
  my ($LA, $LB) = (length($_[1]), length($B));  # Get string lengths

  # The search string must not be an empty string, or we exit.
  # The string that we search for must not be longer than
  # the string in which we search.
  ($N && $LA && $LA <= length($_[0])) or return $_[0];
  my ($LAST, $F, $X) = (0, 0, $_[0]);

  if ($N > 0x7FFFFFFE)
  {
    # If N was not provided, then that means we have to
    # replace every instance, so we'll use regex...

    my $A = $_[1];
    $X =~ s/\Q$A\E/$B/g;
    return $X;
  }

  if ($N < 0)
  {
    # If we get here, we must not replace every
    # instance, and we must go from right to left.

    $F = length($X);
    while (($F = rindex($X, $_[1], $F)) >= 0)
    {
      substr($X, $F, $LA) = $B;
      ++$N or last;
    }
    return $X;
  }

  if ($LA == $LB)
  {
    # In this case, output string will be the
    # same length as the input string.
    # We must not replace every instance,
    # and we search from left to right.

    while (($F = index($X, $_[1], $F)) >= 0)
    {
      substr($X, $F, $LA) = $B;
      $F += $LB;
      --$N or last;
    }
    return $X;
  }

  # In this final scenario, the output string will
  # NOT be the same length as the input string.
  # We must not replace every instance,
  # and we search from left to right.

  # For performance reasons, we build a new string.
  $X = '';
  while (($F = index($_[0], $_[1], $F)) >= 0)
  {
    $X .= substr($_[0], $LAST, $F - $LAST);
    $X .= $B;
    $F += $LA;
    $LAST = $F;
    --$N or last;
  }
  return $X . substr($_[0], $LAST);
}
##################################################
#                                       v2019.12.6
# Creates a JavaScript program in Windows that
# returns the number of milliseconds.
# Usage: UseTimer()
#
sub UseTimer
{
  $OS < 3 or return;
  CreateFile('Z:\\gettime.js', 'WScript.Quit((new Date()).getMilliseconds() >> 2);');
}
##################################################
#                                       v2019.12.6
# Returns the number of milliseconds since Jan 1 1970.
# This function works in WINDOWS ONLY!
# You must call UseTimer() first!
# Usage: NUMBER = GetTime()
#
sub GetTime
{
  return time * 1000 + (system('Z:\\gettime.js') >> 6);
}
##################################################
#                                       v2019.12.6
# This function prints time elapsed since last call.
# This function works in WINDOWS ONLY! You must first
# call UseTimer() and declare an array named @TIME
# Usage: PrintTime()
#
sub PrintTime
{
  my $T = GetTime();
  push(@TIME, $T);
  @TIME > 2 or return;
  $T = abs($T - $TIME[$#TIME-1]);
  print "\n", ' ' x (8 - length($T)), "$T ms. ", join(' ', @_);
}
##################################################
#                                       v2019.12.9
# Returns one or more words from a string.
# The string is treated as a list of words separated
# by whitespace. In this case, a "whitespace" is any
# character whose ASCII value is less than 33. This
# includes new line characters, tab, space, null, etc.
# PTR tells which word to grab starting with 1.
# If PTR is 3, the third word is returned.
# If PTR is not specified, the default value is 1.
# COUNT tells how many words to return. Default is 1.
# When COUNT has a negative value, returns every word
# from PTR all the way to the end of the string.
# The words in the return value will always be separated
# by a space character regardless of how many spaces or
# tabs were between them in the input string.
#
# Usage: STRING = GetWord(STRING, [PTR, [COUNT]])
#
sub GetWord
{
  defined $_[0] or return '';
  my $LEN   = length($_[0]);
  my $PTR   = defined $_[1] ? $_[1] : 1;
  my $COUNT = defined $_[2] ? $_[2] : 1;
  return '' if ($LEN == 0 || $COUNT == 0 || $PTR >= $LEN);

  my $START = -1;
  my $OUTPUT = '';
  $PTR > 0 or $PTR = 1;
  for (my $i = 0; $i <= $LEN; $i++)
  {
    if (vec($_[0], $i, 8) > 32)
    {
      $START >= 0 or $START = $i;
      next;
    }
    if ($START >= 0)
    {
      if ($PTR-- < 2)
      {
        length($OUTPUT) == 0 or $OUTPUT .= ' ';
        $OUTPUT .= substr($_[0], $START, $i - $START);
        last if ($COUNT-- == 1);
      }
      $START = -1;
    }
  }
  return $OUTPUT;
}
##################################################
#                                       v2019.12.9
# This function looks for words composed of characters
# listed in the second argument and splits a string so
# that even or odd numbered elements of the array will
# be composed of the set. Example:
# SplitGroup('-abc23caba', 'abc') --> ['-', 'abc', '23', 'caba']
# As you can see, every odd numbered element in the output
# array is composed of the characters a, b and c; while
# even numbered elements are do NOT contain a, b, or c.
#
# Usage: ARRAY = SplitGroup(STRING, LIST)
#
sub SplitGroup
{
  defined $_[0] or return ();
  my $LEN = length($_[0]) or return ();
  defined $_[1] or return ($_[0]);
  length($_[1]) or return ($_[0]);
  my ($PTR, $PREV, $TYPE, @A) = (0, -1);
  for (my $i = 0; $i < $LEN; $i++)
  {
    $TYPE = index($_[1], substr($_[0], $i, 1)) < 0 ? 0 : 1;
    if ($PREV == !$TYPE)		# Same as before?
    {
      push(@A, substr($_[0], $PTR, $i-$PTR));
      $PTR = $i;
    }
    $PREV = $TYPE;
  }
  push(@A, substr($_[0], $PTR));	# Process last chunk
  return @A;
}
##################################################
#                                      v2019.12.12
# Waits for a keypress and returns the key code.
# Usage: INTEGER = GetKey()
#
sub GetKey
{
  my $X;
  if ($OS > 2)	# Linux or OSX
  {
    $X = 'readkc';
    CreateFile($X, "#!/bin/bash\nread -rsn1 k1\nread -rsn1 -t 0.0001 k2\nread -rsn1 -t 0.0001 k3\nread -rsn1 -t 0.0001 k4\nread -rsn1 -t 0.0001 k5\nread -rsn2 -t 0.0001 k6\necho " . '${k1} ${k2} ${k3} ${k4} ${k5} ${k6};' . "\n") or return -1;
    return `$X`;
  }
  elsif ($X64)	# Windows 64-bit
  {
    $X = 'Z:\\GETKEY.CMD';
    CreateFile($X, '$HOST.UI.RawUI.ReadKey(“NoEcho,IncludeKeyDown”) | OUT-NULL' . "\n" . '$HOST.UI.RawUI.Flushinputbuffer()' . "\n") or return -1;
    return `$X`;
  }
  else		# DOS 16-bit or Windows 32-bit
  {
    $X = 'Z:\\GETKEY.COM';
    CreateFile($X, "\xB4\0\x24\x24\xCD\x16\x0E\x1F\x0E\7\xBF\0\1\x89\xFA\xAB\xB4\t\xCD!\xC3") or return -1;
    return vec(`$X`, 0, 16);
  }
}
##################################################
#
# Returns an array of 256 numbers. The low 8 bits
# of each byte is the character code, and the high
# 24 bits contain how many times that character
# occurs in the string.
# Usage: ARRAY = CharStats(STRING)
#
sub CharStats
{
  my @A;
  for (my $i = 0; $i < 256; $i++)
  { $A[$i] = $i; }
  defined $_[0] or return @A;
  for (my $i = 0; $i < length($_[0]); $i++)
  {
    $A[vec($_[0], $i, 8)] += 256;
  }
  return sort @A;
}
##################################################
#                                      v2019.12.16
# Converts a hexadecimal number to an integer
# between 0 and 99,999,999,999,999.
# Usage: INTEGER = Hex2Int2(STRING)
#
# Example: Hex2Int2('0x4451C9') --> 4477385
#          Hex2Int2('DEA930100655') --> 86488562796117
#          Hex2Int2('32iyffff') --> 65535
#
sub Hex2Int2
{
  defined $_[0] or return 0;
  (my $L = length($_[0])) or return 0;
  my ($RESULT, $PWR, $MAX, $c) = (0, 1, 99999999999999);
  while ($L--)
  {
    $c = vec($_[0], $L, 8);
    last if ($c < 48 || $c > 102);
    if ($c < 58) { $c -= 48; }
    else
    {
      $c &= 95;
      last if ($c < 65 || $c > 70);
      $c -= 55;
    }
    if ($c)
    {
      $RESULT += $c * $PWR;
      $RESULT < $MAX or return $MAX;
    }
    $PWR *= 16;
  }
  return $RESULT;
}
##################################################
#                                      v2019.12.23
# Encodes binary string to URL-safe string.
# Usage: STRING = EncodeURL(STRING)
#
sub EncodeURL
{
  defined $_[0] or return '';
  length($_[0]) or return '';
  my $S = SwapChars($_[0], "+ \n:");
  my $ALLOWED = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$.-:/+_';
  my $NOT_ALLOWED = InvertCharSet($ALLOWED);
  my $ESC = '|=!';
  my $c;
  my $p;
  my $OUTPUT = '';
  for (my $i = 0; $i < length($S); $i++)
  {
    $c = substr($S, $i, 1);
    $p = index($NOT_ALLOWED, $c);
    if ($p < 0)
    { $OUTPUT .= $c; }
    else
    { $OUTPUT .= substr($ESC, $p >> 6, 1) . substr($ALLOWED, $p & 63, 1); }
  }
  return $OUTPUT;
}
##################################################
#                                      v2019.12.24
# Decodes an URL string to binary string.
# Usage: STRING = DecodeURL(STRING)
#
sub DecodeURL
{
  my $S = defined $_[0] ? $_[0] : '';
  (my $L = length($S)) or return '';
  my $ALLOWED = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$.-:/+_';
  my $INDEX = substr($ALLOWED, 0, 64);
  my $NOT_ALLOWED = InvertCharSet($ALLOWED);
  my $ESC = '|=!';
  my $OUTPUT = '';
  my $c;
  my $p;
  my $EXPECT_ESCAPE = -1;
  for (my $i = 0; $i < $L; $i++)
  {
    $c = substr($S, $i, 1);
    if ($EXPECT_ESCAPE >= 0)
    {
      $p = index($INDEX, $c);
      if ($p >= 0)
      {
        $p = ($EXPECT_ESCAPE << 6) + $p;
        if ($p >= length($NOT_ALLOWED)) { $p = length($NOT_ALLOWED) - 1; }
        $c = substr($NOT_ALLOWED, $p, 1);
      }
      $EXPECT_ESCAPE = -1;
    }
    else
    {
      $p = index($ESC, $c);    
      if ($p >= 0)
      {
        $EXPECT_ESCAPE = $p;
        next;
      }
      else
      {
        $p = index($ALLOWED, $c);
        if ($p < 0) { next; }
      }
    }
    $OUTPUT .= $c;
  }
  return SwapChars($OUTPUT, "+ \n:");
}
##################################################
#                                      v2019.12.21
# This function swaps characters in a string.
# The second argument must be a string that holds
# byte pairs that will replace each other.
#
# Example: SwapChars(" Aa f-b", "aA -") --> "-aA-f b"
# In the above example, all lowercase "a" get swapped
# out with uppercase "A" and all uppercase "A" get
# replaced with lowercase "a". Also, space and "-"
# get swapped out with each other.
#
# Usage: STRING = SwapChars(STRING, CHARACTER_PAIRS)
#
sub SwapChars
{
  my $S = defined $_[0] ? $_[0] : '';
  (my $L = length($S)) || return '';
  my $PAIRS = defined $_[1] ? $_[1] : '';
  (my $P = length($PAIRS)) || return $S;
  if ($P & 1) { $PAIRS = substr($PAIRS, 0, $P & 0xFFFFFe); }
  for (my $i = 0; $i < $L; $i++)
  {
    $P = index($PAIRS, substr($S, $i, 1));
    $P < 0 or vec($S, $i, 8) = vec($PAIRS, $P & 1 ? $P - 1 : $P + 1, 8);
  }
  return $S;
}
##################################################
#                                      v2019.12.21
# Returns a list of characters that make up
# the input string.
# Usage: STRING = CharSet(STRING)
#
sub CharSet
{
  my $S = defined $_[0] ? $_[0] : '';
  my $L = length($S);
  my $OUTPUT = '';
  while ($L) { vec($OUTPUT, vec($S, --$L, 8), 8) = 1; }
  for (my $i = $L = 0; $i < length($OUTPUT); $i++)
  { if (vec($OUTPUT, $i, 8)) { vec($OUTPUT, $L++, 8) = $i; } }
  return substr($OUTPUT, 0, $L);
}
##################################################
#                                        v2021.2.5
# Returns a list of 256 characters minus the ones
# that occur in the input string.
# Usage: STRING = InvertCharSet(STRING)
#
sub InvertCharSet
{
  my @SET;
  for (my $i = 0; $i < 256; $i++) { $SET[$i] = chr($i); }
  my $FULL = join('', @SET);
  defined $_[0] or return $FULL;
  my $L = length($_[0]);
  $L or return $FULL;
  for (my $i = 0; $i < $L; $i++) { $SET[vec($_[0], $i, 8)] = ''; }
  return join('', @SET);
}
##################################################
#
# This function escapes a string using escape
# character(s) provided.
#
# Usage: STRING = EscapeString(STRING, ESCAPE_CHARS, CHARSET)
#
#sub EscapeString
#{
#  my $INPUT = defined $_[0] ? $_[0] : ''; (my $L = length($INPUT)) || return '';
#  my $ESCAPE = defined $_[1] ? $_[1] : ''; (my $E = length($ESCAPE)) || return $INPUT;
#  my $CHARSET = defined $_[2] ? $_[2] : ''; length($CHARSET) || return $INPUT;
#  my $MISSING = InvertCharSet($CHARSET); length($MISSING) || return $INPUT;
#  my ($OUTPUT, $LAST, $c, $p) = ('', 0);
#  for (my $i = 0; $i < $L; $i++)
#  {
#    $c = substr($INPUT, $i, 1);
#    $p = index($MISSING, $c);
#    if ($p < 0) { $OUTPUT .= $c; next; }
#    if ($E == 1)
#    {
#      $OUTPUT .= $ESCAPE;
#      $OUTPUT .= sprintf('%.2X', vec($INPUT, $i, 8));
#    }
#    else
#    {
#      $OUTPUT .= substr($ESCAPE, int($p / length($CHARSET)), 1)
#                . substr($CHARSET, $p % length($CHARSET), 1);
#    }
#  }
#  return $OUTPUT;
#}
##################################################
#                                      v2019.12.16
# This function is same as the tr() function.
# It translates characters in a string from OLDSET to NEWSET.
# Usage: STRING = TR(STRING, OLDSET, NEWSET)
# Example: TR("abc", "a", "A")  --> "Abc"
#
sub TR
{
  my $S = defined $_[0] ? $_[0] : '';
  defined $_[1] || return $S;
  defined $_[2] || return $S;
  length($_[1]) || return $S;
  (my $N = length($_[2])) || return $S;
  my $L = length($S);
  my $P;
  while ($L--)
  {
    $P = index($_[1], substr($S, $L, 1));
    next if ($P < 0 || $P >= $N);
    vec($S, $L, 8) = vec($_[2], $P, 8);
  }
  return $S;
}
##################################################
#                                      v2019.12.17
# This function encrypts a string with a password
# hash using the XOR operator. Note: This is not
# like the simplest form of XOR encryption.
# If the password changes even just a little bit,
# the output will be entirely different.
# Usage: STRING = XORSTR(STRING, [PASSWORD])
#
sub XORSTR
{
  my $S = defined $_[0] ? $_[0] : '';
  my $W = defined $_[1] ? $_[1] : '';
  my ($j, $L, $X) = (0, length($S));
  $L or return '';
  my $SL = $L >> 2;
  my $WL = length($W) >> 2;
  vec($W, ++$WL, 32) = $X = 0x9542716B;
  for (my $i = 0; $i <= $WL; $i++)
  { $X = (($X + vec($W, $i, 32)) * 777 + 333) % 0x1B497F0C; }
  for (my $i = 0; $i <= $SL; $i++)
  {
    $X = ($X >> 3) + (($X & 3) << 29);
    $X += vec($W, $j, 32) + $L;
    $X <= 4294967295 or $X %= 4294967296;
    vec($W, $j, 32) = $X;
    vec($_[0], $i, 32) = vec($_[0], $i, 32) ^ $X;
    ++$j < $WL or $j = 0;
  }
  return substr($_[0], 0, $L);
}
##################################################
#                                      v2019.12.17
# This function compresses a text to binary string
# by removing the highest 0 bit from every byte
# thus shrinking the output by 8:7 ratio.
# Usage: STRING = Compress8to7(TEXT)
#
sub Compress8to7
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my $BINARY = ((($L-1) & 7) == 0) || ((($L-2) & 7) == 0) ? '1' : '0';
  for (my $i = 0; $i < $L; $i++)
  {
    $BINARY .= sprintf('%.7b', vec($_[0], $i, 8) & 127);
  }
  return pack('B*', $BINARY);
}
##################################################
#                                      v2019.12.17
# This function expands a binary string to a text
# by inserting a '0' in the high bit of each byte,
# thus expanding the output by a 7:8 ratio.
# Usage: TEXT = Expand7to8(STRING)
#
sub Expand7to8
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my $OUTPUT = '';
  my $BINARY = unpack('B*', $_[0]);
  $L = length($BINARY) - 1;
  for (my $i = 1; $i < $L; $i += 7)
  {
    $OUTPUT .= pack('B*', '0' . substr($BINARY, $i, 7));
  }
  vec($BINARY, 0, 8) & 1 or chop($OUTPUT);
  return $OUTPUT;
}
##################################################
#                                      v2019.12.16
# Returns the least number of digits required to
# represent a positive integer in any base.
# Usage: INTEGER = NumberLength(NUMBER, BASE)
#
# Example: NumberLength(117, 16) --> 2
#          NumberLength(117, 62) --> 2
#          NumberLength(117, 10) --> 3
#          NumberLength(117, 2)  --> 7
#
sub NumberLength
{
  @_ == 2 or return 0;
  my ($N, $BASE) = @_;
  if ($N < $BASE) { return 1; }
  my $LENGTH = 0;
  for (my $PWR = 1; $PWR <= $N; $LENGTH++)
  {
    $PWR *= $BASE;
  }
  return $LENGTH;
}
##################################################
#                                      v2019.12.16
# This function converts a positive integer to a
# fixed length URL-safe string (base 62).
# The number must be between MIN and MAX.
# Usage: STRING = EncodeIntRange(MIN, MAX, INTEGER)
#
# Example: EncodeIntRange(20, 100, 45) --> 'az'
#   The first and second numbers indicate that we are
#   going to encode an integer which can be between 20 and 100.
#   The third number is the integer which we are encoding.
#
sub EncodeIntRange
{
  @_ == 3 or return '';
  my ($MIN, $MAX, $N) = @_;
  if ($N < $MIN) { $N = $MIN; }
  if ($N > $MAX) { $N = $MAX; }
  my $LEN = NumberLength($MAX - $MIN, length($MYSET));
  return EncodeInteger($N - $MIN, $MYSET, $LEN);
}
##################################################
#                                      v2019.12.16
# This function converts an encoded integer and
# returns the number that is between MIN and MAX.
# Usage: INTEGER = DecodeIntRange(MIN, MAX, STRING)
#
# Example: DecodeIntRange(20, 100, 'az') --> 45
#   The first and second numbers indicate that we
#   expecting an integer which is between 20 and 100.
#   The third argument is the encoded string.
#
sub DecodeIntRange
{
  @_ == 3 or return '';
  my ($MIN, $MAX, $S) = @_;
  my $RESULT = DecodeInteger($S, $MYSET) + $MIN;
  return ($RESULT > $MAX) ? $MAX : $RESULT;
}
##################################################
#                                      v2019.12.16
# Converts a 47-bit integer (0-99,999,999,999,999)
# to any base using a custom digit set.
# Usage: STRING = EncodeInteger(INTEGER, DIGITSET, [LENGTH])
#
# Example:
#   print EncodeInteger(123456789, '0123456789ACBDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');
#   # Outputs '8M0kX'
#
sub EncodeInteger
{
  my $LENGTH = defined $_[2] ? $_[2] : 1;
  $LENGTH > 0 or $LENGTH = 1;
  defined $_[1] or return '';
  (my $L = length($_[1])) > 1 or return '';
  my $ZERO = substr($_[1], 0, 1) x $LENGTH;
  defined  $_[0]  or return $ZERO;
  length  ($_[0]) or return $ZERO;
  isNumber($_[0]) or return $ZERO;
  my $N = int($_[0]);
  my $MAX = 99999999999999;

  # Fix overflow.
  $N > 0 or return $ZERO;
  $N < $MAX or $N = $MAX;

  my $C;
  my $OUTPUT = '';
  while ($N >= $L)
  {
    $C = $N % $L;
    $OUTPUT .= substr($_[1], $C, 1);
    $N = int(($N - $C) / $L);
  }

  # Save last byte.
  if ($N) { $OUTPUT .= substr($_[1], $N, 1); }

  # Add padding
  $LENGTH -= length($OUTPUT);
  $LENGTH < 1 or $OUTPUT .= substr($ZERO, 0, $LENGTH);

  return scalar reverse $OUTPUT;
}
##################################################
#                                      v2019.12.16
# Converts an encoded number composed of digits
# found in the second argument and returns an integer.
# Usage: INTEGER = DecodeInteger(STRING, DIGITSET)
#
sub DecodeInteger
{
  defined $_[1] or return 0;
  defined $_[0] or return 0;
  length($_[0]) or return 0;
  (my $L = length($_[1])) > 1 or return 0;
  my ($PWR, $RESULT, $MAX, $i, $DIGIT) = (1, 0, 99999999999999, length($_[0]));
  while ($i--)
  {
    ($DIGIT = index($_[1], substr($_[0], $i, 1))) >= 0 or next;
    if ($DIGIT)
    {
      $RESULT += $DIGIT * $PWR;
      $RESULT < $MAX or return $MAX;
    }
    $PWR *= $L;
  }
  return $RESULT;
}
##################################################
#                                      v2019.12.22
# Converts a hex string to a string of ones and zeros. No Limit!
# Usage: STRING = Hex2Bin(STRING)
#
sub Hex2Bin
{
  my $X = defined $_[0] ? $_[0] : '';
  my ($B, $j, $i, $c) = ('', 0, 0);
  while ($i < length($X))
  {
    $c = vec($X, $i++, 8);
    next if ($c < 48 || $c > 102);
    $c |= 32;
    $c -= $c > 96 ? 87 : 48;
    vec($B, $j++, 32) = vec('0000000100100011010001010110011110001001101010111100110111101111', $c, 32);
  }
  return $B;
}
##################################################
#
# Returns 1 if STRING is strictly made up of characters
# found in KNOWNSET. Returns 0 if string contains
# one or more characters not found in KNOWNSET.
# Returns -1 if STRING is empty or undefined!
# Usage: INTEGER = isFromCharSet(STRING, KNOWNSET)
#
# Written by Zsolt Nagy-Perge <zsnp500@cox.net>
# Created: 2019.12.24     Last modified: 2020.7.8
#
sub isFromCharSet
{
  defined $_[0] or return -1;
  defined $_[1] or return 0;
  length($_[1]) or return 0;
  (my $L = length($_[0])) or return -1;
  while ($L--)
  {
    index($_[1], substr($_[0], $L, 1)) >= 0 or return 0;
  }
  return 1;
}
# SHORT VERSION:
# This function returns 1 if string S is strictly made up of characters listed in string KNOWN. Returns 0 if string S contains any "unknown" characters.
# Usage: INTEGER = isFromCharSet(STRING, KNOWNSET)
# sub isFromCharSet { defined $_[0] or return -1; defined $_[1] or return 0; length($_[1]) or return 0; (my $L = length($_[0])) or return -1; while ($L--) { index($_[1], substr($_[0], $L, 1)) >= 0 or return 0; } return 1; }
#
##################################################
#                                      v2019.12.24
# This function analyzes a string and returns a pattern.
# Usage: STRING = StringPattern(STRING)
#
sub StringPattern
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my ($OUTPUT, $MODE, $c) = ('', 0);
  for (my $i = 0; $i < $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    if ($c > 126)
    { if ($MODE != 1) { $OUTPUT .= 'b'; $MODE = 1; } }
    elsif ($c < 33)
    { if ($MODE != 2) { $OUTPUT .= ' '; $MODE = 2; } }
    elsif ($c > 47 && $c < 58)
    { if ($MODE != 3) { $OUTPUT .= 'd'; $MODE = 3; } }
    elsif (($c > 64 && $c < 91) || ($c > 96 && $c < 123))
    { if ($MODE != 4) { $OUTPUT .= 'A'; $MODE = 4; } }
    else
    { $OUTPUT .= 's'; $MODE = 0; }
  }
  return $OUTPUT;
}
##################################################
# Returns an encrypted character code.
# Usage: ASCII_CODE = EncryptChar(ASCII_CODE)
#
sub EncryptChar
{
  my $c = defined $_[0] ? $_[0] & 255 : 0;
  $RND[0] *= $RND[2] + $RND[3];
  $RND[0] -= int($RND[0] / $RND[4]) * $RND[4];   # FMOD($RND, $c)
  $c = (($c & 3) << 6) | ($c >> 2);              # ROR($c, 2)
  return (($c ^ $RND[1]) - int($RND[0])) & 255;  # XOR($c, 170)
}
##################################################
# Decrypts an encrypted character code.
# Usage: ASCII_CODE = DecryptChar(ASCII_CODE)
#
sub DecryptChar
{
  my $c = defined $_[0] ? $_[0] & 255 : 0;
  $RND[0] *= $RND[2] + $RND[3];
  $RND[0] -= int($RND[0] / $RND[4]) * $RND[4];   # FMOD($RND, $c)
  $c = (($c + int($RND[0])) & 255) ^ $RND[1];    # XOR($c, 170)
  return (($c & 63) << 2) | ($c >> 6);           # ROL($c, 2)
}
##################################################
#                                      v2019.12.24
# Returns an encrypted string. The "password" consists
# of four decimal numbers stored in a global array
# named @RND, and $RND[0] is the initial seed.
# Usage: STRING = EncryptString(STRING)
#
sub EncryptString
{
  my $c;
  my $S = defined $_[0] ? $_[0] : '';
  my $L = length($S);
  while ($L--)
  {
    $RND[0] *= $RND[2] + $RND[3];
    $RND[0] -= $RND[4] * int($RND[0] / $RND[4]);
    $c = vec($S, $L, 8);
    $c = (($c & 3) << 6) | ($c >> 2);
    vec($S, $L, 8) = ($c ^ $RND[1]) - int($RND[0]);
  }
  return $S;
}
##################################################
#                                      v2019.12.24
# Decrypts a string. The "password" consists
# of four decimal numbers stored in a global array
# named @RND, and $RND[0] is the initial seed.
# Usage: STRING = DecryptString(STRING)
#
sub DecryptString
{
  my $c;
  my $S = defined $_[0] ? $_[0] : '';
  my $L = length($S);
  while ($L--)
  {
    $RND[0] *= $RND[2] + $RND[3];
    $RND[0] -= $RND[4] * int($RND[0] / $RND[4]);
    $c = ((vec($S, $L, 8) + int($RND[0])) & 255) ^ $RND[1];
    vec($S, $L, 8) = (($c & 63) << 2) | ($c >> 6);
  }
  return $S;
}
##################################################
#                                      v2019.12.24
# This function encodes a string into B64 format
# using a non-standard algorithm.
# Usage: STRING = EncodeB64(STRING)
#
sub EncodeB64
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my ($OUTPUT, $SHIFT, $k, $i, $j, $c) = ('', 6, -4, 0, 0);
  for (; $i < $L; $i++, $j++)
  {
    if ($SHIFT > 5)
    {
      $j++;
      $k += 4;
      $SHIFT = 0;
      vec($OUTPUT, $k, 8) = 0;
    }
    $SHIFT += 2;
    $c = vec($_[0], $i, 8);
    vec($OUTPUT, $j, 8) = $c;
    vec($OUTPUT, $k, 8) += ($c & 0xC0) >> $SHIFT;
    vec($OUTPUT, $j, 8) &= 63;
  }
  while ($j--)
  {
    vec($OUTPUT, $j, 8) = vec($B64, vec($OUTPUT, $j, 8), 8);
  }
  return $OUTPUT;
}
##################################################
#                                      v2019.12.24
# This function decodes a B64 string to binary string.
# Usage: STRING = DecodeB64(STRING)
#
sub DecodeB64
{
  defined $_[0] or return '';
  (my $L = length($_[0])) or return '';
  my ($OUTPUT, $i, $j, $c, $H) = ('', 0, 0);
  for (; $i < $L; $i++)
  {
    $c = index($B64, substr($_[0], $i, 1));
    $c >= 0 or next;
    if ($i & 3)
    {
      $H <<= 2;
      vec($OUTPUT, $j++, 8) = $c + ($H & 0xC0);
      next;
    }
    $H = $c;
  }
  return $OUTPUT;
}
##################################################
#                                      v2020.06.16
# This funciton encodes a binary string that
# contains mostly plain text and numbers.
# Usage: STRING = EncodeText(STRING)
#
my $XSET = "2nMeFxr3XphG4WkQv6IwqYBz7cT\$NgoACZyaPjd0H9mVtSOblKfE+1U5LiJRu8sD./!\x1A^_\xCB\xBA\xFC\xF2\x12\1\xBF\xFD\xB2\xE6\x19\4\xBD\xE9\xF7\xC1\xED\x86\x85\x8D\x98\x10\"\xCD\xF6\x89\x0C \xC8\x1E\xFF\xDF&\xD7\xA0\x80\x7F\x94\xC7\xEF\xFA\xB1\x1D:,{\xD1\xC9@\xB5)\xB6\xE2\x9B\x9E\x83\xF3]\xEE\x8A\x9F\xCE\xAF\xEB\xA7\6\xD0(\x9A\'\xD9\xAA\x13\x8E\xF1\xEA\x8C%\xB3\xE1>[\xFB=\xCA?\xAB\x0E\xB8\xCC\xB9\\*\n\x8F;\xF0\xBC\xDA\xA2|\xA6\xD2\x82\xD3\xDE\xEC\xDC\x95\xC2\xC0`\x1F\t\xE3\xDB\x91\xC4\x90\x8B\x9D\x0F\xD6\xC3\x87\xC5-\x93\x1B\xF8\xCF\xAD\xA3\xE8\x84\x11\5\xE7\xB7\xA9\xC6\x99\x0B\xBB\xD8\x96#\x14\xE0\xB4\xA4\xD5\x15\xF4\x97\xF9\xFE\xD4\xE5~\xDD\xE4\x9C\r\xF5\x08\xBE\x18\xAC<\x1C\2\xAE}\xA8\0\7\x88\x92\xB0\x81\x17\xA1\x16\xA5\3";

sub EncodeText
{
  defined $_[0] or return '';
  (my $i = length($_[0])) or return '';
  my ($OUTPUT, $C, $P) = ('');
  while ($i--)
  {
    $C = substr($_[0], $i, 1);
    $P = index($XSET, $C);
    if ($P < 64)
    {
      $OUTPUT .= substr($XSET, 63-$P, 1);
      next;
    }
    $OUTPUT .= substr($XSET, $P & 63, 1);         # Encoded character
    $OUTPUT .= substr($XSET, ($P >> 6) + 63, 1);  # Escape character
  }
  return $OUTPUT;
}
##################################################
#                                      v2020.06.16
# This funciton decodes a plain text string and
# returns a binary string.
# Usage: STRING = DecodeText(STRING)
#
sub DecodeText
{
  defined $_[0] or return '';
  (my $i = length($_[0])) or return '';
  my ($OFFSET, $OUTPUT, $C, $P) = (0, '');
  while ($i--)
  {
    $C = substr($_[0], $i, 1);
    $P = index($XSET, $C);
    if ($P < 64)
    {
      $OUTPUT .= ($OFFSET ? substr($XSET, $OFFSET + ($P & 63), 1) : substr($XSET, 63-$P, 1));
      $OFFSET = 0;
      next;
    }
    $OFFSET = (($P - 63) & 3) << 6;
  }
  return $OUTPUT;
}
##################################################
#                                      v2019.08.25
# Removes all whitespace from a string and returns
# a new string. (Whitespace is here defined as a byte
# whose ASCII value is 32 or less. That includes tab,
# space, new line characters, esc, bel, null, etc.
# Usage: STRING = NOSPACE(STRING)
#
sub NOSPACE
{
  my $X = defined $_[0] ? $_[0] : '';
  !length($X) || $X =~ tr| \t\r\n\0\1\2\3\4\5\6\7\x08\x0B\x0C\x0E\x0F\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1A\x1B\x1C\x1D\x1E\x1F||d;
  return $X;
}
##################################################
#                                        v2020.1.9
# This function doubles backslash characters in a
# DOS string so when it is inserted into a string
# it becomes a single backslash.
# Usage: STRING = QuotePath(STRING)
#
sub QuotePath
{
  my $P = defined $_[0] ? $_[0] : '';
  $P =~ s/\\/\\\\/g;
  return $P;
}
##################################################
#                                        v2020.1.7
# This function returns 0 if the given file name
# contains ASCII characters only. Returns 1 if
# UTF8 characters were found. Returns 2 if
# invalid characters were found.
# Usage: INTEGER = IsUTFFileName(STRING)
#
sub IsUTFFileName
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L or return 0;
  my $N = $_[0];
  my $P;
  my $D = -1;
  return 2 if ($N =~ m/[\<\>\|\*]/);
  my $ASCII = '.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%&{}()[]\'`^~+=-_,:;/\\ ';
  for (my $i = 0; $i < $L; $i++)
  {
    $P = index($ASCII, substr($N, $i, 1));
    return 1 if ($P < 0);  # UTF8 characters?
  }
  return 0;
}
##################################################
#                                        v2020.1.7
# This function returns 1 if the given file name is
# a valid DOS 8+3 file name. Returns 0 otherwise.
# Usage: INTEGER = IsFileName83(STRING)
#
sub IsFileName83
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L < 13 or return 0;   # Name may be no longer than 12 bytes
  $L or return 0;
  my $N = $_[0];
  my $P;
  my $D = -1;
  my $VALID = '.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%&{}()\'`^~-_';
  for (my $i = 0; $i < $L; $i++)
  {
    $P = index($VALID, substr($N, $i, 1));
    return 0 if ($P < 0);  # Invalid character?
    if ($P)
    {
      # The file name cannot be longer than 8 bytes, and
      # the file extension cannot be longer than 3 bytes.
      if ($D < 0) { $i < 8 or return 0; }
      else { $i - $D <= 3 or return 0; }
    }
    else
    {
      # The period cannot be the 1st or 10th character
      return 0 if ($i == 0 || $i > 8);
      return 0 if ($D > 0);   # Two periods are not allowed!
      $D = $i;
    }
  }
  return 1;
}
##################################################
#                                       v2020.1.10
# Converts a string to hexadecimal numbers.
# A second argument may be provided to serve as a
# pattern for the output. In the pattern string,
# every # sign represents a hex digit. Whatever comes
# before the first # sign will be treated as a separator.
# And any character that is not a # sign will be
# inserted into the output.
#
# Usage: STRING = fStr2Hex(STRING, [STRING])
#
# Example:
#   fStr2Hex('Hello')          --> '48656C6C6F'
#   fStr2Hex('ABCDE', '-##')   --> '41-42-43-44-45'
#   fStr2Hex('zzzzz', ' ####') --> '7A7A 7A7A 7A'
#   fStr2Hex('012', '  #-#')   --> '3-0  3-1  3-2'
#
sub fStr2Hex
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L or return '';
  my $PATTERN = defined $_[1] ? $_[1] : '';
  my $j = index($PATTERN, '#');
  my $HEX = uc(unpack('H*', $_[0]));
  $j >= 0 or return $HEX;
  $L = length($HEX);
  my ($i, $z, $RUN, $OUTPUT, $p, $c) = (0, 0, 1, '');
  while ($RUN)
  {
    while ($j < length($PATTERN))
    {
      $p = vec($PATTERN, $j++, 8);
      if ($p == 35)
      {
        $RUN or last;
        $c = vec($HEX, $i++, 8);
        $i < $L or $RUN = 0;
      }
      else { $c = $p; }
      vec($OUTPUT, $z++, 8) = $c;
    }
    $j = 0;
  }
  return $OUTPUT;
}
##################################################
#                                       v2020.1.16
# Returns a list of logical drives in DOS/Windows.
# Usage: ARRAY = GetDriveList()
#
sub GetDriveList
{
  $OS == 2 or return ();
  my $TXTFILE = 'Z:\\drvlst49.txt';
  my $JSFILE = 'Z:\\getdrv51.js';
  my $JS = "try{FSO=new ActiveXObject('Scripting.FileSystemObject');}catch(e){WScript.Quit(0);}A=[];function toHexLong(N){N|=0;var i,X='';for(i=0;i<32;i+=4)X='0123456789ABCDEF'.charAt((N>>i)&15)+X;return X;}for(i=0;i<26;i++){L=String.fromCharCode(i+65)+':';if(FSO.DriveExists(L)){D=FSO.GetDrive(L);if(D.IsReady){S=toHexLong(D.SerialNumber)+'*'+D.FileSystem+'*'+D.VolumeName+'*'+D.TotalSize+'*'+D.FreeSpace;}A.push(L+D.DriveType+'*'+S);}}try{F=FSO.CreateTextFile('$TXTFILE',1,0);F.Write(A.join(\"\\r\\n\"));F.Close();}catch(e){WScript.Quit(0);}WScript.Quit(1);";
  CreateFile($JSFILE, $JS) or return ();
  system($JSFILE) or return ();
  local *FH;
  open(FH, "<$TXTFILE") or return ();
  my @A = <FH>;
  close FH;
  foreach (@A) { $_ = Trim($_); }
  return @A;
}
##################################################


# This command queries the registry:
#
# reg query "HKLM\System\CurrentControlSet\Control\Session Manager\Environment" /v PROCESSOR_ARCHITECTURE

CENTER('W E L C O M E');
CENTER('-' x 70);

PrintSubs();
PrintTime();
PAUSE();
PrintTime();
print '"Testing Str2Hex():  ';
my $TEST = "Hello?";
print "$TEST -> ", Str2Hex($TEST); 
print "\nlocaltime() --> ", localtime();
print "\nLocalTime1() --> ", LocalTime1();
print "\nLocalTime2() --> ", LocalTime2();
print "\nLocalTime3() --> ", LocalTime3();
print "\nLocalTime4() --> ", LocalTime4();
print "\nLocalTime5() --> ", LocalTime5();
print "\nLocalTime6() --> ", LocalTime6();
print "\nLocalTime7() --> ", LocalTime7();

PAUSE();
print "\n\nEnvironment variables:\n";
foreach (sort keys %ENV)
{
  print "  $_ = $ENV{$_}\n";
}

print "\n       Script : ", Self('FULL');
print "\n         Size : ", Commify(Self('SIZE')), ' bytes';
print "\nLast Modified :", Self('DATE');
print "\n Current time :", FormatDate(time);
print "\n           OS : $OS";
print "\n";

#my $SAMPLE = substr(Self(), 0, 2000);
#PAUSE();
#TextDump($SAMPLE);
#PAUSE();
#HexDump($SAMPLE);
#PrintTime();

#print "\n\n", StrBefore("xyz0123", "z");
#print "\na=$a\nb=$b\n";

cprintf 0x2B, 'Hello World!!!';
print "\n\n", join(' x ', GetConsoleSize());
PAUSE();
SetBgColor(0x2F);

my $SELF = Self('CONTENT');
my $SHRUNK = CompactPerl($SELF);
print "\n\n", length($SELF), ' -> ', length($SHRUNK);
print $SHRUNK;

About();

################################################
# This function decrypts a cookie value and returns a binary string.
# Usage: STRING = DecodeCookie(STRING, SEED)
#
sub DecodeCookie
{
  defined $_[0] or return '';
  my $SEED = defined $_[1] ? $_[1] : 137;
  my $S = BackwardShuffle($_[0], $SEED);
  $S = ShiftRStr($S, -$SEED, $COOKIEJAR);
  my $c = vec($S, 0, 8);
  $S = substr($S, 1);
  if ($c == 98) { $S = DecodeB64($S); }
  elsif ($c == 101) { $S = UnescapeString($S, $COOKIEJAR); }
  return $S;
}
##################################################
#
# This function converts any binary string to text
# format that contains nothing but letters and numbers.
#
# Generally, the output string will be about 20% larger
# than the input string, because repeated characters
# will be compressed. The output will look nothing
# resembling the input string, so to some degree,
# the output will appear to be encrypted as well.
#
# HOW IT WORKS:
#
# According to a study at Cornell University, the most
# frequently used letter in the English alphabet is the
# letter E, followed by TAOINSRHDLUCMFYWGPBVKXQJZ.
# This function uses the above information to encode
# input data in the smartest manner by grouping the most
# frequently used characters together with space, period,
# forward slash, and the "|" character. All of these are
# frequently used together. In the second group, we have
# every other symbol along with \0 \r \n and \xFF.
# In the last 3 groups, we have all other remaining characters.
#
# The encoding assumes that we are starting with group 1.
# If a character is encountered which is in group 2, an
# escape character will be inserted before the character.
# If the exact same escape character appears twice next
# to each other, it signals a compressed character.
# Each extra escape character stands for two characters.
# Thus, 8 spaces followed by "!" will become "gkkkgUD"
# where "g" stands for the space from group 1, and "k"
# is the escape character which expands into 6 characters
# when decoded. The "!" is found in group 2, therefore we
# insert a letter "U" which is the escape character for
# group 2. And then letter "D" is the code for "!"
# The escape characters are the last 5 bytes of the
# $TX global string.
#
# The advantage of converting data to "abc format" is
# that abc data can be safely inserted into an URL
# argument or HTML file, or it can be enclosed with
# single or double quotes in Perl or JavaScript.
# It can also be passed as an argument to a program.
#
# Written by Zsolt Nagy-Perge <zsnp500@cox.net>
# on Feb. 2, 2021. Last modified: Feb 5, 2021
#
# Usage: STRING = Str2Txt(STRING)
#
sub Str2Txt
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  my $P;
  my $c = -1;
  my $ESC = 0;
  my $REPEAT = 0;
  my $OUT = '';
  my $prev_char;
  my $prev_esc;
  my $output_char;

  for (my $i = 0; $i < $L; $i++)
  {
    $prev_char = $c;
    $c = vec($_[0], $i, 8);
    if ($c == $prev_char)
    {
      if (++$REPEAT < 2)
      {
        $OUT .= $output_char;
      }
      else
      {
        substr($OUT, length($OUT) - 1) = '';
        $OUT .= substr($TX, $ESC + 697, 1);   # ESCAPE CHARS
        $REPEAT = 0;
      }
    }
    else
    {
      $REPEAT = 0;
      $P = vec($TX, $c + 256, 8);   # REVERSE INDEX
      if ($P < 0)
      {
        $ESC = $P = 0;
      }
      else
      {
        $prev_esc = $ESC;
        $ESC = int($P / 57);
        $P -= $ESC * 57;
        if ($ESC != $prev_esc)
        {
          $OUT .= substr($TX, $ESC + 697, 1);  # ESCAPE CHARS
        }
        $output_char = substr($TX, $P + 640, 1);  # OUTPUT_SET
        $OUT .= $output_char;
      }
    }
  }
  return $OUT;
}
##################################################
#                                        v2021.2.4
# This is the opposite of the Str2Txt() function. 
# This function converts a string that contains
# nothing but numbers and letters to a binary string.
# This function requires a global variable named $TX
# which contains character sets and index tables.
# Usage: STRING = Txt2Str(STRING)
#
sub Txt2Str
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  my $c;
  my $P;
  my $ESC = 0;
  my $prev_esc;
  my $OUT = '';
  my $output_char = '';

  for (my $i = 0; $i < $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    $P = vec($TX, $c + 512, 8);    # OUTPUT_IDX
    if ($P >= 57)
    {
      $prev_esc = $ESC;
      $ESC = $P - 57;

      if ($prev_esc == $ESC)
      {
        $OUT .= $output_char;
        $OUT .= $output_char;
      }
    }
    else
    {
      $P += $ESC * 57;
      $output_char = ($P < 256) ? substr($TX, $P, 1) : ' ';  # REVERSE_SET
      $OUT .= $output_char;
    }
  }
  return $OUT;
}
##################################################
#                                        v2021.2.5
# This function removes all characters from a string
# that do not occur anywhere in the character set
# (second string). Example:
# StrFilter('-123w.98fx5', '0123456789') --> '123985'
#
# Usage: STRING = StrFilter(STRING, CHARSET)
#
sub StrFilter
{
  defined $_[0] or return '';
  defined $_[1] or return '';
  my $i;
  my $c;

  # Create 256-byte reference table
  my $TABLE = "X" x 256;
  my $L = length($_[1]);
  for ($i = 0; $i < $L; $i++)
  {
    $c = vec($_[1], $i, 8);
    vec($TABLE, $c, 8) = 0;  # ALLOW THIS CHAR
  }

  # Remove characters
  my $CUT = 0;
  my $OUTPUT = '';
  $L = length($_[0]);
  for ($i = 0; $i < $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    if (vec($TABLE, $c, 8))  # REMOVE THIS CHAR
    {
      $CUT == $i or $OUTPUT .= substr($_[0], $CUT, $i - $CUT);
      $CUT = $i + 1;
    }
  }
  return $CUT ? $OUTPUT . substr($_[0], $CUT) : $_[0];
}
##################################################
# Returns 1 if STRING contains any digits.
# Returns 0 if STRING does not contain any digits.
# Usage: INTEGER = ContainsDigits(STRING)
sub ContainsDigits
{
  my $X = defined $_[0] ? $_[0] : '';
  return $X =~ /[0-9]/ ? 1 : 0;
}
##################################################
# This function returns the percentage of letters
# (A-Z) vs all other characters in a string.
# This will be an integer between 0 and 100.
# Usage: INTEGER = PercentageOfText(STRING)
#
sub PercentageOfText
{
  my $X = defined $_[0] ? $_[0] : '';
  my $ORIGINAL_LENGTH = length($X);
  $X =~ tr|a-zA-Z||cd;
  return int(length($X) / ($ORIGINAL_LENGTH + 1) * 100);
}
##################################################
#                                       v2021.2.13
# This function will sometimes return an integer,
# and sometimes a string. Normally, it returns 1
# if string ends with a certain suffix, or 0 otherwise.
# This function can also enforce the presence/absence
# of the suffix depending on the third argument:
# CMD=0x00 : Returns an integer that tells whether the string ends with suffix or not
# CMD=0x01 : Returns a string making sure it does end with suffix
# CMD=0x02 : Returns a string making sure it doesn't end with suffix
# CMD=0x10 : Ignore case
#
# Usage: X = Suffix(STRING, SUFFIX, [CMD])
#
sub Suffix
{
  my $STRING = defined $_[0] ? $_[0] : '';
  my $SUFFIX = defined $_[1] ? $_[1] : '';
  my $CMD = defined $_[2] ? $_[2] : 0x10;
  my $LS = length($STRING);
  my $LX = length($SUFFIX);
  my $FOUND = ($LS < $LX) ? 0 : 1;
  if ($FOUND)
  {
    my $EXISTING_SUFFIX = substr($STRING, $LS - $LX);
    if ($CMD & 16)
      { $FOUND = (uc($EXISTING_SUFFIX) eq uc($SUFFIX)) ? 1 : 0; }
    else
      { $FOUND = ($EXISTING_SUFFIX eq $SUFFIX) ? 1 : 0; }
  }
  $CMD &= 3;
  my $WITHOUT_SUFFIX = ($FOUND) ? substr($STRING, 0, $LS - $LX) : '';
  if ($CMD & 2) { return $FOUND ? $WITHOUT_SUFFIX : $STRING; }
  if ($CMD & 1) { return $FOUND ? $WITHOUT_SUFFIX . $SUFFIX : $STRING . $SUFFIX; }
  return $FOUND;
}
##################################################
# This function converts a string that holds a
# dollar amount to a number, and performs strict
# syntax checking. If the number seems invalid,
# then a blank string is returned instead.
# Usage: NUMBER = toNumber(STRING)
#
sub toNumber
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  my $prev;
  my $c = -1;
  my $N = '';
  my $PAR = 0;
  my $SIGN = '';
  my $DIGIT = 0;
  my $PLUS_COUNT = 0;
  my $MINUS_COUNT = 0;
  my $DIGIT_COUNT = 0;
  my $DECIMAL_POINT = 0;
  for (my $i = 0; $i < $L; $i++)
  {
    $prev = $c;
    $c = vec($_[0], $i, 8);
    $c > 32 or next;  # Ignore space \r \n \t \f \0 etc.

    if ($c == 32 || $c == 9) # Space or tab
    {
      # We allow a space or tab anywhere in the number.
    }
    elsif ($c == 10 || $c == 13) # New line character
    {
      # A new line may mark the end of a number, so
      # we return whatever we may have up to this point.
      return $N;
    }
    elsif ($c > 47 && $c < 58)  # Digit!
    {
      # If a number is given as (####.##), then digits
      # are not allowed after the closing parentheses.
      $PAR < 3 or return '';
      $DIGIT_COUNT++;
      $DIGIT = 1;
      $N .= substr($_[0], $i, 1);
    }
    elsif ($c == 44) # Comma
    {
      # A number cannot start with a comma.
      $DIGIT_COUNT or return '';
      # Commas are not allowed after the decimal point.
      if ($DECIMAL_POINT) { return ''; }
      # Two commas cannot be next to each other.
      $c != $prev or return '';
    }
    elsif ($c == 46) # Decimal point
    {
      # Only one decimal point is allowed!
      ++$DECIMAL_POINT < 2 or return '';
      # If we've had no digits yet, then insert a zero.
      $DIGIT_COUNT or $N .= '0';

      $N .= '.';
    }
    elsif ($c == 43) # Plus sign
    {
      # Only one plus sign is allowed.
      ++$PLUS_COUNT < 2 or return '';
      # A plus sign may occur only at the beginning
      # of a number before the decimal point.
      $DECIMAL_POINT == 0 or return '';
      $DIGIT_COUNT == 0 or return '';
      # We can't have a plus and a minus sign in the same number.
      $MINUS_COUNT == 0 or return '';
    }
    elsif ($c == 45) # Minus sign
    {
      # Only one minus sign is allowed.
      ++$MINUS_COUNT < 2 or return '';
      # A minus sign may occur only at the beginning
      # of a number before the decimal point.
      $DECIMAL_POINT == 0 or return '';
      $DIGIT_COUNT == 0 or return '';
      # We can't have a plus and a minus sign in the same number.
      $PLUS_COUNT == 0 or return '';
      $SIGN = '-';
    }
    elsif ($c == 40) # (
    {
      $PAR++ == 0 or return '';
    }
    elsif ($c == 41) # )
    {
      $PAR++ == 1 or return '';
      $SIGN = '-';
    }
    else
    {
      return '';
    }
  }
  return $SIGN . $N;
}
##################################################
#                                       v2021.2.23
# This function splits a string along paragraphs.
# Each paragraph is to be separated by one blank
# line. If a paragraph contains more than two
# lines, then it splits those lines as if
# each were individual paragraphs.
# Usage: ARRAY = SplitParagraphs(STRING)
#
sub SplitParagraphs
{
  my @A;
  defined $_[0] or return @A;
  @A = split(/\n\s*\n/, $_[0]);
  my $REP = 0;
  for (my $i = 0; $i < @A; $i++)
    { if (CountStr($A[$i], "\n") > 1)
      { $A[$i] =~ tr|\n|\0|; $REP = 1; } }
  return ($REP) ? split(/\0/, join("\0", @A)) : @A;
}
##################################################
# This function returns the current date and time
# in the following format:  Mmm D YYYY HH:MM:SSmm
# Usage: STRING = TimeStamp()
#
sub TimeStamp
{
  my @D = localtime();
  my $M = substr('JanFebMarAprMayJunJulAugSepOctNovDec', $D[4] * 3, 3);
  my $A = $D[2] > 11 ? 'pm' : 'am';
  $D[2] or $D[2] = 12;
  $D[2] < 13 or $D[2] -= 12;
  return sprintf("%s %d %d %d:%.02d:%.02d%s", $M, $D[3], 1900+$D[5], $D[2], $D[1], $D[0], $A);
}
##################################################
#                                        v2021.3.3
# This function cuts a text to a certain length
# and adds '...' at the end if it was too long.
# Usage: STRING = TruncateStr(STRING)
#
sub TruncateStr
{
  my $S = defined $_[0] ? Trim($_[0]) : '';
  my $MAXLEN = defined $_[1] ? $_[1] : 20;
  my $SUFFIX = '...';
  $MAXLEN > 3 or return $SUFFIX;
  return ($MAXLEN > length($S)) ? $S : substr($S, 0, $MAXLEN - 3) . $SUFFIX;
}
##################################################
#                                        v2021.3.3
# This function expects a date in MM/DD/YYYY format
# and returns a date in MmmDD format. Example:
# ShortDate("03/26/2020") --> "Mar26"
# Usage: STRING = ShortDate(STRING)
#
sub ShortDate
{
  my $DATE = defined $_[0] ? $_[0] : '';
  $DATE =~ /([01]*[0-9])\/([0-3]*[0-9])[\/0-9]*/;
  my $MONTHS = 'JanFebMarAprMayJunJulAugSepOctNovDec';
  return (defined $1 && defined $2) ? substr($MONTHS, ($1 * 3), 3) . ($2 * 1) : '';
}
##################################################
# Converts all adjacent whitespace characters
# to a single space.
# Usage: STRING = CollapseSpace(STRING)
#
sub CollapseSpace
{
  my $STR = defined $_[0] ? $_[0] : '';
  $STR =~ s/[ \t\n\r\f\0]+/ /g;
  return $STR;
}
##################################################
#                                       v2021.1.19
# Converts base 10 positive number N to a string
# of 1s and 0s. No Limit!!!
#
# Usage: STRING = toBinUnlimited(NUMBER, [LENGTH])
#
sub toBinUnlimited
{
  my $N = defined $_[0] ? $_[0] : 0;
  my $L = defined $_[1] ? $_[1] : 32;

  my $OUTPUT = '';
  my $Z = length($N);
  my @M = (1, 2, 4, 8, 16, 32,
  0x40, 0x80, 0x100, 0x200,
  0x400, 0x800, 0x1000, 0x2000,
  0x4000, 0x8000, 0x10000, 0x20000, 
  0x40000, 0x80000, 0x100000, 0x200000,
  0x400000, 0x800000, 0x1000000, 0x2000000,
  0x4000000, 0x8000000, 0x10000000, 0x20000000,
  0x40000000, 0x80000000);

  if ($Z < 17)  # TREAT AS FLOAT
  {
    # TREAT AS 32-BIT INT
    if ($L < 33 || ($N >= -2147483648 && $N <= 4294967295))
    {
      $N |= 0;
      while ($L--) { $OUTPUT .= ($N & $M[$L]) ? 1 : 0; }
      return $OUTPUT;
    }
    if ($N <= 9007199254740991)
    {
      $N = int($N);
      $OUTPUT = sprintf('%.28b', $N & 0x0FFFFFFF);
      while ($L < 28) { $OUTPUT = '0' . $OUTPUT; }
      $OUTPUT = sprintf('%.28b', int($N/268435456) & 0x0FFFFFFF) . $OUTPUT;
      while (length($OUTPUT) < $L) { $OUTPUT .= '0' . $OUTPUT; }
      return Slice($OUTPUT, -L);
    }
  }
  $OUTPUT = BigInt2Bin($N);
  while (length($OUTPUT) < $L) { $OUTPUT .= '0' . $OUTPUT; }
  return Slice($OUTPUT, -L);
}
##################################################
#                                       v2021.3.17
# Converts an integer to a string of N bytes.
# Usage: STRING = Int2Str(INTEGER, [N])
#
sub Int2Str
{
  my $N = defined $_[0] ? $_[0] : 0;
  my $L = defined $_[1] ? $_[1] : 4;
  my $S = '';
  while ($L-- > 0)
  {
    $S .= chr($N & 255);
    $N >>= 8;
  }
  return $S;
}
##################################################
#                                       v2021.3.17
# Converts a string to a positive integer.
# Usage: INTEGER = Str2Int(STRING)
#
sub Str2Int
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  my $N = 0;
  while ($L--)
  {
    $N *= 256;
    $N += vec($_[0], $L, 8);
  }
  return $N;
}
##################################################
#                                       v2021.3.18
# This function returns the hexadecimal value of
# the Nth character of STRING, or returns 16 if
# that character is not a valid hexadecimal digit.
# INTEGER = HexDigitAt(STRING, POINTER)
#
# This function does almost exactly as :
#     hex(substr($STRING, $POINTER, 1))
# However, when the hex() function receives an
# invalid character, it displays an error
# message instead of returning a value.
#
sub HexDigitAt
{
  # This function uses a lookup table to translate
  # hex characters to values. The lower 4 bits of this
  # table hold the hex value, while the 5th bit is used
  # to signal whether the character is valid or invalid.

  # DO NOT MODIFY THE FOLLOWING STRING, OR IT WILL BREAK THIS FUNCTION:
  return vec('````````````````````````````````````````````````0123456789```````:;<=>?``````````````````````````:;<=>?', vec($_[0], $_[1], 8), 8) & 31 ^ 16;
}
##################################################
#                                       v2021.3.18
# This function converts a hexadecimal number to
# decimal format. When a second argument is given,
# the second argument will be the return value of
# the function in case an invalid character is
# encountered. If the second argument is omitted,
# then invalid characters will be silently ignored.
# Usage: INTEGER = Hex2Int3(STRING, [STRICT])
#
sub Hex2Int3
{
  defined $_[0] || return 0;
  my $STRICT = defined $_[1];
  my ($L, $E, $i, $c) = (length($_[0]), 0, 0);

  if ($L == 1)        # Just one hex digit?
  {
    $c = HexDigitAt($_[0], 0);
    return ($c < 16) ? $c : ($STRICT ? $_[1] : 0);
  }
  if ($L < 9)         # up to 8 hex digits?
  {
    while ($i < $L)
    {
      $c = HexDigitAt($_[0], $i++);
      if ($c < 16) { $E = ($E << 4) | $c; }
      elsif ($STRICT) { return $_[1]; }
    }
  }
  elsif ($L < 13)     # up to 12 hex digits?
  {
    while ($i < $L)
    {
      $c = HexDigitAt($_[0], $i++);
      if ($c < 16) { $E *= 16; $E += $c; }
      elsif ($STRICT) { return $_[1]; }
    }
  }
  else               # 3000 hex digits or more?
  {
    while ($i < $L)
    {
      $c = HexDigitAt($_[0], $i++);
      if ($c < 16)
      {
        $E = ADD($E, $E);  # $E <<= 4
        $E = ADD($E, $E);
        $E = ADD($E, $E);
        $E = ADD($E, $E);
        $E = ADD($E, $c);  # $E += $c
      }
      elsif ($STRICT) { return $_[1]; }
    }
  }
  return $E;
}
##################################################
#                                        v2021.3.1
# This function joins two or more paths and returns
# a complete path string in localized format.
# Usage: STRING = FormatPath(STRINGs...)
#
sub FormatPath
{
  my $P = '';
  foreach (@_)   # Trim SPACEs, double quotes, TAB, CR, LF, etc.
  { $P .= '/' . TrimChar($_, " \"\t\r\n\0\f"); }
  $P = substr($P, 1);
  $P =~ tr|\\|/|;            # Convert to Linux format
  $P =~ tr|/||s;             # Remove duplicate '//'
  $P =~ s/\/[^\/]+\/\.\.//;  # Resolve '/directory_name/..'
  if ($^O =~ /DOS|WIN/i)
  { $P =~ tr|/|\\|; }        # Convert to DOS format
  return $P;
}
##################################################