My daughter introduced me to Worldle earlier today. Read this carefully, I said Worldle, not Wordle... (For Wordle, take a look at this blog post: Wordle the Wolfram Way.)
Worldle is at this Worldle web site.
The premise is to try to guess the country from the outline of the country’s boundary in 6 guesses. Somewhat harder than Wordle...
Worldle is at this Worldle web site.
The premise is to try to guess the country from the outline of the country’s boundary in 6 guesses. Somewhat harder than Wordle...
But, I had to say to my daughter, as I did the last time when I was shown Wordle, "I think that I can make a Mathematica version pretty quickly". So I spent a couple of hours and created this:
Here’s the notebook that produces this... Enjoy!
(You can also download it at the end of this post.)
(You can also download it at the end of this post.)
In[]:=
Module{game,$countryNames},$countryNames=WithallCountriesEntityClass=,DeleteDuplicatesSort@FlattenallCountriesEntityClass,allCountriesEntityClass;game=Framed[#,RoundingRadius5,FrameStyleLightGray]&@DynamicModule{countryName="",polygon={},randomCountry,randomCountryPolygon,randomCountryGraphic,distance,direction,showMe=False,guesses={},allDone=False,nGuesses=6,youGuessedIt=False,showHint=False},randomCountry=RandomChoice[$countryNames];randomCountryPolygon=CountryDataStringTrim[randomCountry],;randomCountryGraphic=GeoGraphics[{EdgeForm[Black],Blue,randomCountryPolygon},ImageSize{250,250},GeoBackgroundNone];distance=∞;direction=0;GridLabeled[Framed[Dynamic[randomCountryGraphic],RoundingRadius5,FrameStyleLightGray],"Guess me!",Top,LabelStyle{14,FontFamily"Arial"}],ColumnButton"New",showMe=False;randomCountry=RandomChoice[$countryNames];randomCountryPolygon=CountryDataStringTrim[randomCountry],;randomCountryGraphic=GeoGraphics[{EdgeForm[Black],Blue,randomCountryPolygon},ImageSize{250,250},GeoBackgroundNone];distance=∞;direction=0;guesses={};allDone=False;youGuessedIt=False;countryName="";polygon={};showHint=False,Method"Queued",ImageSize90,Framed[#,RoundingRadius5,FrameStyleLightGray]&@(InputField[Dynamic[countryName,(countryName=#;showHint=False)&],String,FieldCompletionFunctionFunction[x,Select[$countryNames,StringMatchQ[#,___~~StringTrim[x]~~___,IgnoreCaseTrue]&]],BaseStyle{12,FontFamily"Arial"},EnabledDynamic[!allDone&&!youGuessedIt]]),ButtonDynamic[If[!allDone,"Guess","All Done!"]],Catch@If[allDone,Throw[Null]];If[!MemberQ[$countryNames,StringTrim[countryName]],Throw[Null]];polygon=CountryDataStringTrim[countryName],;distance=GeoDistance[CountryData[countryName,"CenterCoordinates"],CountryData[randomCountry,"CenterCoordinates"]];youGuessedIt=TrueQ[CountryData[countryName,"CenterCoordinates"]===CountryData[randomCountry,"CenterCoordinates"]];direction=If[youGuessedIt,"You have arrived!",GeoDirection[CountryData[countryName,"CenterCoordinates"],CountryData[randomCountry,"CenterCoordinates"]]];guesses=Append[guesses,countryName];If[Length[guesses]===nGuesses,allDone=True];showHint=False,Method"Queued",ImageSize90,EnabledDynamic[!allDone&&!youGuessedIt],Dynamic[If[polygon==={},Spacer[1],GeoGraphics[{EdgeForm[Black],Green,polygon},ImageSize{250,250},GeoBackgroundNone]],TrackedSymbols{polygon}],Column[{Row[{"Distance: ",Dynamic[distance]},BaseStyle{Darker[Blue],12,FontFamily"Arial"}],Row[{"Direction: ",Dynamic[direction]},BaseStyle{Darker[Blue],12,FontFamily"Arial"}],Spacer[1],Dynamic[Column[Flatten[{Style["Your guesses",Darker[Blue],12,FontFamily"Arial"],guesses}],AlignmentLeft,BaseStyle{Black,12,FontFamily"Arial"}]],Button[Dynamic[If[!allDone,"Show me ","All Done!"]],showMe=True,ImageSize100],Dynamic[If[TrueQ[showMe]||TrueQ[allDone]||TrueQ[youGuessedIt],Style[randomCountry,11,Gray,FontFamily"Arial"],""]]}],Item[#,AlignmentCenter]&@Column[Button["Show Hint",showHint=True,ImageSize100],Dynamic[If[TrueQ[showHint]&&!(polygon==={}),Framed[#,RoundingRadius5,FrameStyleLightGray]&@GeoGraphics[ Flatten@{EdgeForm[Black],Green,polygon,EdgeForm[Black],Blue,randomCountryPolygon,AbsoluteThickness[2],Red,GeoPath[{CountryData[countryName,"CenterCoordinates"],CountryData[randomCountry,"CenterCoordinates"]}]},ImageSize{250,250},GeoBackgroundNone],Spacer[1]]]],SpanFromLeft,Alignment{Left,Top},SaveDefinitionsTrue;CreateDocument[{TextCell[game,"Text",ShowStringCharactersFalse]},Deployed->True];
