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

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

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

gr::usage = "triangle test piece"
tn::usage = "cardboard thickness"
th::usage = "toothwidth paramter"

lot::usage="stuff"
uot::usage="stuff"
uit::usage="stuff"
lit::usage="stuff"
le ::usage="stuff"
re ::usage="stuff"
uts::usage="stuff"
lts::usage="stuff"
sc ::usage="stuff"
tl ::usage="stuff"
tp ::usage="stuff"
eps::usage="stuff"
tw ::usage="total width"

ppiece ::usage="function"

linrev  ::usage="function" 
fldrop	::usage="function"
dupd 	::usage="function"
toothrow::usage="function"
flipx   ::usage="function"
fliy    ::usage="function"

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

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

(* PARAMETERS *)
(* units are inches *)
(* thickness *)
tn = .15;
(* tooth depth squeeze parameter *)
sq = 0;
so = 1.5;
(* tooth width parameter (absolute) 0 is rectangular tooth *)
tp = 1/32;
eps = .0048;
(* width of flat piece for triangular tube *)
tw = 3*so + 2*tn;
(* tooth spacings, number *)
sp = {{1/4, 9}, {1/2, 5}};
th = 1/4;
(* length of tube is derived parameter *)

(* DRAFTING *)
j = 1;
(* tube length *)
tl = sp[[j, 1]] sp[[j, 2]];
(* lower outer teeth *)
y = 0;
lot = Table[
   Line[{{(i - 1) sp[[j, 1]], y}, {i sp[[j, 1]], y}}], {i, 1, 
    sp[[j, 2]], 2}];
(* upper outer teeth *)
y = tw;
uot = Table[
   Line[{{(i) sp[[j, 1]], y}, {(i + 1) sp[[j, 1]], y}}], {i, 1, 
    sp[[j, 2]] - 1, 2}];
(* upper inner teeth *)
y = tw - 2*tn;
uit = Table[
   Line[{{(i - 1) sp[[j, 1]], y}, {i sp[[j, 1]], y}}], {i, 1, 
    sp[[j, 2]], 2}];
(* lower inner teeth *)
y = 2*tn;
lit = Table[
   Line[{{(i) sp[[j, 1]], y}, {(i + 1) sp[[j, 1]], y}}], {i, 1, 
    sp[[j, 2]] - 1, 2}];
(* piece edges *)
le = Line[{{0, 0}, {0, tw - 2*tn}}];
re = Line[{{tl, 0}, {tl, tw - 2*tn}}];
(* tooth points *)
(* upper tooth sides *)
y = tw;
uts = Table[{Line[{{(i) sp[[j, 1]], y}, {(i) sp[[j, 1]] - tp, 
       y - 1/2 tn}, {(i) sp[[j, 1]] + tp, 
       y - 3/2 tn}, {(i) sp[[j, 1]], y - 2 tn}}], 
    Line[{{(i + 1) sp[[j, 1]], y}, {(i + 1) sp[[j, 1]] + tp, 
       y - 1/2 tn}, {(i + 1) sp[[j, 1]] - tp, 
       y - 3/2 tn}, {(i + 1) sp[[j, 1]], y - 2 tn}}]}, {i, 1, 
    sp[[j, 2]] - 1, 2}];
(* lower tooth sides *)
y = 2*tn;
lts = Table[{Line[{{(i) sp[[j, 1]], y}, {(i) sp[[j, 1]] - tp, 
       y - 1/2 tn}, {(i) sp[[j, 1]] + tp, 
       y - 3/2 tn}, {(i) sp[[j, 1]], y - 2 tn}}], 
    Line[{{(i + 1) sp[[j, 1]], y}, {(i + 1) sp[[j, 1]] + tp, 
       y - 1/2 tn}, {(i + 1) sp[[j, 1]] - tp, 
       y - 3/2 tn}, {(i + 1) sp[[j, 1]], y - 2 tn}}]}, {i, 1, 
    sp[[j, 2]] - 1, 2}];
(* scoring *)
y1 = so + tn;
y2 = 2 so + tn;
sc = {Dashing[{tp, 2 tp}], Line[{{0, y1}, {tl, y1}}], 
   Line[{{0, y2}, {tl, y2}}]};

gr = Graphics[{lot, uot, uit, lit, le, re, uts, lts, sc}]

linrev[line_] := Line@(Reverse @@ line);
fldrop[ls_] := Drop[ls, {1, -1, Length[ls] - 1}];
dupd[ls_] := ls //. {a___, x_, x_, b___} -> {a, x, b};
toothrow[n_] := Module[{nt, y, lot, lit, ltsl, ltsr, ir, ir1, ir2},
   nt = 2 n + 1;
   y = 2 tn;
   lot = Table[
     Line[{{(i - 1) th + eps, y - 2 tn}, {i th - eps, y - 2 tn}}], {i, 1, nt, 
      2}];
   lot = {Line[{{th/2, y - 2 tn}, {th , y - 2 tn}}]}~Join~
     Drop[Drop[lot, 1], -1]~
     Join~{Line[{{(nt - 1) th , y - 2 tn}, {(nt - 1/2) th, 
         y - 2 tn}}]};
   lit = Table[
     Line[{{(i) th + tp - eps, y}, {(i + 1) th - tp + eps, y}}], {i, 1, nt - 1, 2}];
(*
   ltsl = 
    Table[Line[
      Reverse[{{(i) th + tp, y}, {(i) th - tp/2, y - 2/3 tn}, {(i) th + tp/2, 
         y - 4/3 tn}, {(i) th - tp, y - 2 tn}}]], {i, 1, nt - 1, 2}];
   ltsr = 
    Table[Line[{{(i + 1) th - tp, y}, {(i + 1) th + tp/2, 
        y - 2/3 tn}, {(i + 1) th - tp/2, y - 4/3 tn}, {(i + 1) th + tp, 
        y - 2 tn}}], {i, 1, nt - 1, 2}];
*)
   ltsl = 
    Table[Line[
      Reverse[{{(i) th + tp - eps, y}, {(i) th - tp/2 - eps, y - 2/3 tn}, {(i) th + tp/2 - eps, 
         y - 3/2 tn}, {(i) th - eps, y - 2 tn}}]], {i, 1, nt - 1, 2}];
   ltsr = 
    Table[Line[{{(i + 1) th - tp  + eps, y}, {(i + 1) th + tp/2  + eps, 
        y - 2/3 tn}, {(i + 1) th - tp/2  + eps, y - 3/2 tn}, {(i + 1) th + eps, 
        y - 2 tn}}], {i, 1, nt - 1, 2}];
   ir = Flatten[
     Append[Transpose[{Drop[lot, -1], ltsl, lit, ltsr}], lot[[-1]]]];
   ir1 = Flatten[List @@@ ir, 2];
   ir1 = ir1 - Table[{th/2, 0}, {Length[ir1]}];
   ir2 = Line[ir1 //. {a___, x_, x_, b___} -> {a, x, b}];
   (* Translate[ir2, {-th/2,0}] *)
   ir2
   ];
flipx[gp_] := 
  GeometricTransformation[gp, ReflectionTransform[{1, 0}]];
flipy[gp_] := 
  GeometricTransformation[gp, ReflectionTransform[{0, 1}]];

Clear[ppiece]
ppiece[{nn_, ns_, ne_, nw_}, {one_, onw_, ose_, osw_, oen_, oes_, 
    own_, ows_}] := 
  Module[{os1, os5, trn, trs, tre, trw, osne, osnw, osse, ossw, osen, 
    oses, oswn, osws, wn, ws, we, ww}, os1 = th - tn;
   os5 = 2 th - tn;
   {osne, osnw, osse, ossw, osen, oses, oswn, 
     osws} = {one, onw, ose, osw, oen, oes, own, ows} /. {1 -> os1, 
      5 -> os5};
   trn = toothrow[nn];
   trs = toothrow[ns];
   tre = toothrow[ne];
   trw = toothrow[nw];
   wn = 2 nn th;
   ws = 2 ns th;
   we = 2 ne th;
   ww = 2 nw th;
   {flipy[trs], Line[{{ws, 0}, {ws + osse, oses}}], 
    Translate[Rotate[flipy[tre], Pi/2, {0, 0}], {ws + osse, oses}], 
    Line[{{ws + osse, we + oses}, {ws + osse - osne, 
       oses + osen + we}}], 
    Translate[
     Line@(Reverse @@ trn), {-ossw + osnw, oses + osen + we}], 
    Line[{{-ossw + osnw, oses + osen + we}, {-ossw, osws + ww}}], 
    Translate[Rotate[linrev[trw], Pi/2, {0, 0}], {-ossw, osws}], 
    Line[{{-ossw, osws}, {0, 0}}]}];

End[]

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