BeginPackage["bgth`"] (* -*-Fundamental-*- *)

Off[General::spell1]
Off[General::spell]
Off[LUDecomposition::luc]
Off[LinearSolve::luc]

(**********************************************************************)
(* USAGES *)

traf::usage = "traf[grph, trfm] := (GeometricTransformation[# , trfm] &) @@ grph";
rotn::usage = "rotn[grph, thet] := traf[grph, RotationTransform[thet, {0, 1, 0}]]";
trns::usage = "trns[grph, vec] := traf[grph, TranslationTransform[vec]]";
scle::usage = "scle[grph, fac] scales graphics (about (0,0,0)) by factor fac";
refl::usage = "refl[grph, vec] reflects graphics through origin normal to vector vec";
bcub::usage = "bcub[{x0, y0, z0}, {x1, y1, z1}]"
ncub::usage = "ncub[{x0, y0, z0}, {x1, y1, z1}]"
bcyl::usage = "bcyl[r,h] boolean cylinder, lower face centered at origin, radius r, height h"
ncyl::usage = "ncyl[r,h] negated boolean cylinder, lower face centered at origin, radius r, height h"

rs::usage = "rounded square"
rr::usage = "round rectangle"
crs::usage = "concentric rounded squares"
dline::usage = "dline[ls] gives Line[FoldList[Plus, ls[[1]], Drop[ls,1]]]"

(**********************************************************************)
Begin["`Private`"]

SetDirectory["C:/Documents/fabl"]; (* same as package *)

{xx,yy,zz} = {Global`x, Global`y, Global`z};
vg = {xx,yy,zz}; (* global vector *)

(* Aux *)

(* traf[grph_, trfm_] := Graphics3D[(GeometricTransformation[# , trfm] &) @@ grph]; *)
traf[grph_, trfm_] := Head[grph]@((GeometricTransformation[# , trfm] &) @@ grph);
rotn[grph_, thet_] := traf[grph, RotationTransform[thet, {0, 1, 0}]];
rotn[grph_, thet_, vec_] := traf[grph, RotationTransform[thet, vec]];
trns[grph_, vec_] := traf[grph, TranslationTransform[vec]];
scle[grph_, fac_] := traf[grph, ScalingTransform[{fac,fac,fac}]];
scle[grph_, vec_List] := traf[grph, ScalingTransform[vec]];
refl[grph_, vec_] := traf[grph, ReflectionTransform[vec]];

bcub[{x0_, y0_, z0_}, {x1_, y1_, z1_}] := 
  x0 <=  Global`x <=  x1 && y0 <=  Global`y <=  y1 && z0 <= Global`z <=  z1;
ncub[{x0_, y0_, z0_}, {x1_, y1_, 
    z1_}] := ! (x0 <=  Global`x <=  x1 && y0 <=  Global`y <=  y1 && z0 <= Global`z <=  z1);
orpr[v_] := 
  Which[v == {1, 0, 0}, {{0, 1, 0}, {0, 0, 1}}, 
   v == {0, 1, 0}, {{1, 0, 0}, {0, 0, 1}}, True, 
   Drop[Orthogonalize[{v, {1, 0, 0}, {0, 1, 0}}], 1]];
bcyl[r_,h_]:= (Global`x^2 + Global`y^2 <= r^2) && (0 <= Global`z <= h);
bcyl[r_,h_,vec0_,veca_]:= Module[{van, v0n, vc, vd, dv},
 {vc,vd} = orpr[veca];
 {van,v0n} = {Normalize[veca], Normalize[vec0]};
 dv = vg - vec0;
 Dot[dv,vc]^2 + Dot[dv, vd]^2 <= r^2 && 0 <= Dot[dv,van] <= h];
(* vec0 = {x_0, y_0, z_0}, veca = {x_a,y_a,z_a} axis *)
ncyl[r_,h_]:= !(bcyl[r,h]);
ncyl[r_,h_, vec0_, veca_]:= !(bcyl[r,h,vec0,veca]);

(* two possible routes: (i) focus on boolean primitives with few parameters and use
transformations to get paramters, (ii) build parameters into analytical primitive calls *)

(***PART 2***)
rs[sl_, cr_] := Module[{ssegs, csegs},
    (* square segments *)
   ssegs = {Line[{{cr, 0}, {sl - cr, 0}}], 
     Line[{{sl, cr}, {sl, sl - cr}}], 
     Line[{{sl - cr, sl}, {cr, sl}}], 
     Line[{{0, sl - cr}, {0, cr}}]}; 
    (* circular segments *)
   csegs = {Circle[{cr, cr}, cr, {Pi, 3 Pi/2}], 
     Circle[{sl - cr, cr}, cr, {3 Pi/2, 2 Pi}], 
     Circle[{sl - cr, sl - cr}, cr, {0, Pi/2}], 
     Circle[{cr, sl - cr}, cr, {Pi/2, Pi}]};
   Graphics[{ssegs, csegs}]];
rs[sl_, cr_, ec_] := Module[{ssegs, csegs},
    (* square segments *)
   ssegs = {Line[{{cr, 0}, {sl - cr, 0}}], 
     Line[{{sl, cr}, {sl, sl - cr}}], 
     Line[{{sl - cr, sl}, {cr, sl}}], 
     Line[{{0, sl - cr}, {0, cr}}]}; 
    (* circular segments *)
   csegs = {Circle[{(cr - ec), (cr - ec)}, cr, {Pi, 3 Pi/2}], 
     Circle[{sl - (cr - ec), (cr - ec)}, cr, {3 Pi/2, 2 Pi}], 
     Circle[{sl - (cr - ec), sl - (cr - ec)}, cr, {0, Pi/2}], 
     Circle[{(cr - ec), sl - (cr - ec)}, cr, {Pi/2, Pi}]};
   Graphics[{ssegs, csegs}]];
rr[{slx_,sly_}, cr_] := Module[{ssegs, csegs},
    (* square segments *)
   ssegs = {Line[{{cr, 0}, {slx - cr, 0}}], 
     Line[{{slx, cr}, {slx, sly - cr}}], 
     Line[{{slx - cr, sly}, {cr, sly}}], 
     Line[{{0, sly - cr}, {0, cr}}]}; 
    (* circular segments *)
   csegs = {Circle[{cr, cr}, cr, {Pi, 3 Pi/2}], 
     Circle[{slx - cr, cr}, cr, {3 Pi/2, 2 Pi}], 
     Circle[{slx - cr, sly - cr}, cr, {0, Pi/2}], 
     Circle[{cr, sly - cr}, cr, {Pi/2, Pi}]};
   Graphics[Riffle[csegs, ssegs]]];
(* concentric rounded squares *)
(* origin at the lower right of the first square listed *)
crs[{sl1_, cr1_}, {sl2_, cr2_}] := 
  Show[rs[sl1, cr1], 
   trns[rs[sl2, cr2], {(sl1 - sl2)/2, (sl1 - sl2)/2 }]];

dline[ls_] := Graphics@Line[FoldList[Plus, ls[[1]], Drop[ls, 1]]]; (* line defined by differential vectors *)


(* PARAMETERS *)

End[]

EndPackage[]
(**********************************************************************)