CoprimeSubordinates[q_]:=Select[Range[q],CoprimeQ[#,q]&];
FareySum[{p_,q_},{r_,s_}]:={p+r,q+s};
FareyMinus[{p_,q_},{r_,s_}]:={Abs[p-r],Abs[q-s]};

maxDenominator = 12;

(*Highest denominator always listed last!*)
SiblingTriangles[Δ_]:={{Δ[[1]],Δ[[3]],FareySum[Δ[[1]],Δ[[3]]]},{Δ[[2]],Δ[[3]],FareySum[Δ[[2]],Δ[[3]]]}}

newTriangles = {{{0,1},{1,1},{1,2}}};
finishedTriangles = {};

For[i=1,i<maxDenominator,i++,
finishedTriangles=Join[finishedTriangles,newTriangles];
newTriangles=Flatten[Map[SiblingTriangles,newTriangles],1]]
finishedTriangles=Join[finishedTriangles,newTriangles];

colours=CreateDataStructure["HashTable"];
colours["Insert",{1,0}->0];
colours["Insert",{0,1}->0];
colours["Insert",{1,1}->2];
Map[Function[Δ,colours["Insert",Δ[[3]]->(Mod[8-colours["Lookup",Δ[[1]]]colours["Lookup",Δ[[2]]]-colours["Lookup",FareyMinus[Δ[[1]],Δ[[2]]]],3])]],finishedTriangles];
colours["KeyDrop",{1,0}];

fractionPoint[{p_,q_}]:={12p/q,q/72}
graphicsLines=Map[Polygon[{fractionPoint[#[[1]]],fractionPoint[#[[2]]],fractionPoint[#[[3]]]}]&,finishedTriangles];

polygons=Graphics[{EdgeForm[{Thin,Black,Opacity[0.2]}],FaceForm[Opacity[0]],graphicsLines}]

fractions=Keys[colours["Elements"]];
points=Map[Graphics[{Opacity[0.8],PointSize[Medium],colours["Lookup",#]/.{0->Red,1->Blue,2->Green},Point[fractionPoint[#]]}]&,
fractions];

Show[points,polygons]