(* ::Package:: *)

BeginPackage["PTrends`"];

(* Notes
Braille sizing information from http://www.brailleauthority.org/sizespacingofbraille/. Height 
of dots should be 0.48, spacing of dots within a character 2.34 mm and spacing between characters
is 6.2 mm.  
*)
$PTrendsVersion = "1.0.1";
$PTrendsFont = "Impact"; 
$PTrendsMinHeight = 0.3;
$PTrendsTemporary = Null;
(* Entities don't work nicely with this code, so shut them off *)
SetSystemOptions[SystemOptions["DataOptions"] /. True -> False];

getInfo::usage = "getInfo[string] returns a list of data to visualize.";
cleanInfo::usage = "cleanInfo[list] scales a list of data that was generated manually.";
createElement::usage =  
	"createElement[element, height, letter height, options] " <> 
	"makes a single element";
makeSTL::usage = "makeSTL[data, blocksize] creates the periodic table.";
group::usage = "group[column] is a helper function that makes "<>
	"it easy to select a group of elements for printing.  For example " <>
	"one can write makeSTL[data, group[5]] instead of " <>
	"makeSTL[data, #[[2] == 5 &].";
period::usage = "period[row] is a helper function that makes "<>
	"it easy to select a period of elements for printing.  For example " <>
	"one can write makeSTL[data, period[4]] instead of " <>
	"makeSTL[data, #[[1] == 4 &].";
pretty::usage = "pretty[object] makes the graphics or meshregion more " <>
	"aesthetically pleasing by removing edges.";
createText::usage = "createText[string, textheight, scalingfactor] " <>
  "creates a string of extruded text.";
quickPreview::usage = "quickPreview[data] creates a dot plot of data.";

Begin["`Private`"];

Clear[getInfo];
Options[getInfo] = {
	setZeroHeight -> False, keepMissing -> False, dontRescale -> False,
  maxHeight -> 18, minHeight-> 0.3, fullTable->False
};
getInfo[prop_String, op_Function:(#&), OptionsPattern[]]:= Module[
	{data, maxZ},
	(* Changes the number of elements obtained *)
	maxZ = If[OptionValue@fullTable==True,118,86];
	(* Get data *)
	data = Table[
		Map[ElementData[i,#]&,{"Period","Group",prop,"Symbol"}],{i,maxZ}
	];
	(* If all elements are to be printed, some group/period reorganizing is needed *)
	If[OptionValue@fullTable,(
		data[[57;;70]]=MapIndexed[ReplacePart[#1,{1->9,2->First@#2+2}]&,data[[57;;70]]];
		data[[89;;102]]=MapIndexed[ReplacePart[#1,{1->10,2->First@#2+2}]&,data[[89;;102]]];
		)];
	(* Cull Missing if needed and keepMissing = False *)
	If[OptionValue[keepMissing]==False,
		(
			data = DeleteCases[data,x_/;MemberQ[Head/@x,Missing]];
			data[[All,3]] = op/@data[[All,3]];
		),
		(* Otherwise, apply op to entire dataset *)
		data[[All,3]] = op/@data[[All,3]];
	];
	(* Provide option to skip rescaling *)
	If[OptionValue[dontRescale]==False,
		data[[All,3]] = Rescale[
			data[[All,3]], Through[{Min, Max}[data[[All, 3]]]],
			(* Some designs may benefit from no block *)
			{OptionValue@minHeight, OptionValue@maxHeight}
		];
	];
	data
]

Clear[cleanInfo];
cleanInfo[info_List, op_Function:(#&),OptionsPattern[getInfo]]:=Module[{data},
	data = info;
	(* Cull Missing if needed and keepMissing = False *)
	If[OptionValue[keepMissing]==False,
		(
			data = DeleteCases[data,x_/;MemberQ[Head/@x,Missing]];
			data[[All,3]] = op/@data[[All,3]];
		),
		(* Otherwise, apply op to entire dataset *)
		data = op@data;
	];
	data[[All,3]] = Rescale[ data[[All,3]], Through[{Min,Max}[data[[All,3]]]],
	{OptionValue@minHeight, OptionValue@maxHeight}
	];
	data
]

Clear[createElement]
(* Be careful with repairing - it crashes Mathematica in some versions *) 
Options[createElement]={
	rasterSize -> 300, textScale -> 0.55, font :> $PTrendsFont,
	blockSize -> 8, repair -> False, noText -> False,
	overrideScalingFactor -> 1
	};
createElement[element_String, height_Real, 
							textheight_Real, OptionsPattern[]] := Module[
	{size,base,rawletter,regbnd,scalingFactor,letter},

	(* Ensure that the size of block is Real instead of Integer *)
	size = 0. + OptionValue@blockSize;
	(* Base for the element cube *)
	base = DiscretizeGraphics@Rectangle[{0,0}, {size, size}]; 
	(* Only print blocks *)
	If[OptionValue@noText,
    Return@TransformedRegion[
      (* Put object together, bottom/top and sides *)
      DiscretizeGraphics@Show[{
        (* base *)
        RegionProduct[base, Point[{0.}]],
        (* sides *)
        RegionProduct[RegionBoundary@base, Line[{{0.}, {height}}]],
        (* top *)
        TransformedRegion[RegionProduct[base,Point[{0.}]],
          TranslationTransform[{0,0,height}]]
      }], RotationTransform[90 Degree, {0,0,1}]]
		];	
	(* Initial element region *)
	(* scaling factor is hack to make Braille look a bit nicer *)
	rawletter = ImageMesh@ColorNegate@Rasterize[
		Style[
		If[OptionValue@overrideScalingFactor =!= 1 && StringLength@element==1,
		element <> " ", element], FontFamily -> OptionValue@font],
		RasterSize -> OptionValue@rasterSize
	]; 
	(* Determine bounds of letter, 
		 which are not consistent through the alphabet *)
	regbnd = RegionBounds@rawletter; 
	(* Calculate a scaling factor *)
	scalingFactor = OptionValue@textScale size / 
		(First@Differences@Last@regbnd); 
		
	(* Hack to make the braille text scale properly *)	
	If[OptionValue@overrideScalingFactor =!= 1,
		scalingFactor = OptionValue@overrideScalingFactor;
	];
	
	$PTrendsTemporary = scalingFactor;
	(* Transform the letter region by first scaling it and then 
		 translating it *)
	letter = TransformedRegion[rawletter,
		TranslationTransform[
			size/2 - Mean/@regbnd]@*ScalingTransform[{
				scalingFactor,scalingFactor},
			Mean/@regbnd]
	];
	(* Whole object needs to be rotated *)
	TransformedRegion[
		(* Put the object together *)
		DiscretizeGraphics@Show[{
			(* base *)
			RegionProduct[base, Point[{0.}]],
			(* shell of block *)
			RegionProduct[RegionBoundary@base, Line[{{0.}, {height}}]],
			(* top of block with letters cut out *)
			TransformedRegion[RegionProduct[
				RegionDifference[base, letter],
				Point[{0.}]
			], TranslationTransform[{0,0,height}]],
			(* Extruded letters *)
			TransformedRegion[RegionProduct[
				RegionBoundary@letter, (*Line[{{0.},{textheight}}]*)
				MeshRegion[{{0}, {textheight}}, Line[{1,2}]]
				
			],TranslationTransform[{0, 0, height}]],
			(* Letters on top *)
			TransformedRegion[RegionProduct[
				letter,
				Point[{0.}]], TranslationTransform[{0,0, height + textheight}]]
		}],
		RotationTransform[90 Degree,{0,0,1}]] // 
			If[OptionValue[repair]===True,RepairMesh[#,"FlippedFaces"]&,#&]
			
	]

Clear[makeSTL]
Options[makeSTL] = {includeBase -> True, baseHeight -> 1, baseRim -> 3};
makeSTL[data_, textheight_Real:2., 
				opts:OptionsPattern[{createElement,makeSTL}]]:= Module[
	{obj, base, out, rim},
	(* Create cubes for each element in data and place it in the 
		 correct spot on the periodic table *)
	obj = { 
		Map[TransformedRegion[
			createElement[#[[4]],#[[3]]+0.,textheight,
				FilterRules[{opts},Options@createElement]],
			TranslationTransform[
				OptionValue[blockSize]{#[[1]],#[[2]],0}]]&,
		data]
	};
  (* If a base is requested, us it *)
  rim = OptionValue@baseRim;
  If[OptionValue@includeBase == True,
    obj = Join[obj,
      {RegionProduct[Rectangle@@(Transpose@Most@RegionBounds@
        DiscretizeGraphics@obj+{{-rim,-rim},{rim,rim}}),
        Line[{{0.- OptionValue@baseHeight},{0.}}]]}
    ]];

  DiscretizeGraphics@Show@obj
];


(* Helper functions to select portions of the periodic table *)
Clear[group]
group[val_] := #[[2]] == val &;

Clear[period]
period[val_] := #[[1]] == val &;

(* Helper function to add minor shadowing for better visualization *)
Clear[pretty]
pretty[obj_] := Show[obj, 
  ViewPoint->{0.59,1.91,2.73},
  ViewVertical->{-1.9,0.28,6.05},
  Lighting->{{"Point",LightBlue,{25,25,125}}}] /. 
  {EdgeForm[{_}] -> EdgeForm[{}]};

(* Used to add Title to the object *)
Clear[createText];
Options[createText] = { rasterSize -> 600, 
  font :> $PTrendsFont, 
  position -> {0,0,0}};
createText[text_String, textheight_Real, scalingfactor_Real, 
  OptionsPattern[]] := Module [
  {rawletter, size,out},
  rawletter = ImageMesh@ColorNegate@Rasterize[
    Style[text, FontFamily -> OptionValue@font], 
    RasterSize -> OptionValue@rasterSize];
  out = TransformedRegion[
    RegionProduct[
      TransformedRegion[ rawletter, 
        RotationTransform[90 Degree, {0, 1}]@*
        ScalingTransform[{scalingfactor, scalingfactor}]],
      Line[{{0.}, {textheight}}]
    ], TranslationTransform[OptionValue@position]
  ];
  out = Import[Export[FileNameJoin[{$TemporaryDirectory,"ptrendstmp.stl"}],out]];
  DeleteFile[FileNameJoin[{$TemporaryDirectory,"ptrendstmp.stl"}]];
  out
]

(* Creates a cityscape-type plot to quickly preview trend *)
Clear[quickPreview];
quickPreview[data_]:= Module[{},
	ListPointPlot3D[data[[All,{1,2,3}]],
		Filling->Bottom, Axes->None, Boxed->False,
		ColorFunction->"Rainbow", PlotRange->All,
		FillingStyle->Thick, PlotStyle->PointSize[0.02],
		ViewPoint->{2.33038,1.15444,2.16485},
		ViewVertical->{-0.0736665,0.0111161,2.49305}]
]
End[];
EndPackage[];
