module HRayPerlin, which contains functions used for creating a perlin noise material intended for usage with the other modules in the HRay package author: Kenneth Hoste, 2004-2005 part of a masters thesis at the University of Ghent, Belgium ========================================================================= > module HRayPerlin where > import HRayMath (Point3D, Vector, (<+>), (*>), clip) > import HRayEngine (Color) determines the noise value at a certain intersection point > noise :: Double -> Point3D -> [Int] -> [Color] -> Double > noise gridSize (xt,yt,zt) pList gList = res > where > (x,y,z) = (xt/gridSize,yt/gridSize,zt/gridSize) > > s_curve t = t*t*(3-2*t) > lerp t a b = a + t*(b-a) > > (tx,ty,tz) = (x+256,y+256,z+256) > > (bx0,bx1,rx0,rx1) = (mod (floor tx) 256, mod (bx0+1) 256, x - fromIntegral (floor x), rx0 - 1) > (by0,by1,ry0,ry1) = (mod (floor ty) 256, mod (by0+1) 256, y - fromIntegral (floor y), ry0 - 1) > (bz0,bz1,rz0,rz1) = (mod (floor tz) 256, mod (bz0+1) 256, z - fromIntegral (floor z), rz0 - 1) > > (i,j) = (pList !! bx0, pList !! bx1) > > (b00,b10,b01,b11) = (pList !! mod (i+by0) 256, > pList !! mod (j+by0) 256, > pList !! mod (i+by1) 256, > pList !! mod (j+by1) 256) > > (t,sy,sz) = (s_curve rx0, s_curve ry0, s_curve rz0) > > at3 (qx,qy,qz) (rx,ry,rz) = rx*qx + ry*qy + rz*qz > > u1 = at3 (gList !! mod (b00+bz0) 256) (rx0,ry0,rz0) > v1 = at3 (gList !! mod (b10+bz0) 256) (rx1,ry0,rz0) > a1 = lerp t u1 v1 > > u2 = at3 (gList !! mod (b01+bz0) 256) (rx0,ry1,rz0) > v2 = at3 (gList !! mod (b11+bz0) 256) (rx1,ry1,rz0) > b1 = lerp t u2 v2 > > c = lerp sy a1 b1 > > u3 = at3 (gList !! mod (b00+bz1) 256) (rx0,ry0,rz1) > v3 = at3 (gList !! mod (b10+bz1) 256) (rx1,ry0,rz1) > a2 = lerp t u3 v3 > > u4 = at3 (gList !! mod (b01+bz1) 256) (rx0,ry1,rz1) > v4 = at3 (gList !! mod (b11+bz1) 256) (rx1,ry1,rz1) > b2 = lerp t u4 v4 > > d = lerp sy a2 b2 > > res = lerp sz c d > perlin noise frequency sum > semiTurbulence :: Int -> Double -> Point3D -> Double > semiTurbulence 0 gridS intPt = noise gridS intPt getPList getGList > semiTurbulence freq gridS intPt = coef + (semiTurbulence (freq-1) gridS intPt) > where > coef = (1/(2^freq))*(noise gridS (intPt *> (2^freq)) getPList getGList) perlin noise absolute frequency sum > turbulence :: Int -> Double -> Point3D -> Double > turbulence 0 gridS intPt = abs (noise gridS intPt getPList getGList) > turbulence freq gridS intPt = coef + (turbulence (freq-1) gridS intPt) > where > coef = (1/(2^freq))*(abs (noise gridS (intPt *> (2^freq)) getPList getGList)) perlin noise with solid base color > perlinSolid :: Color -> Double -> Point3D -> Color > perlinSolid base gridS intPt = base *> (((noise gridS intPt getPList getGList)+1)/2) perlin noise sum with solid base color > perlinSemiTurbulence :: Color -> Int -> Double -> Point3D -> Color > perlinSemiTurbulence base freq gridS intPt = base *> (((semiTurbulence freq gridS intPt)+1)/2) absolute perlin noise sum with solid base color > perlinTurbulence :: Color -> Int -> Double -> Point3D -> Color > perlinTurbulence base freq gridS intPt = base *> (turbulence freq gridS intPt) perlin noise fire effect > perlinFire :: Color -> Color -> Int -> Double -> Point3D -> Color > perlinFire addColor base freq gridS intPt = clip (addColor <+> (perlinTurbulence base freq gridS intPt)) perlin noise plasma when perlinNoise is really random, and not the same all the time, this can be simplified > perlinPlasma :: Double -> Point3D -> Color > perlinPlasma gridS intPt = (noise1,noise2,noise3) > where > noise1 = (((noise gridS intPt getPList getGList) +1)/2) > noise2 = (((noise gridS intPt getPList2 getGList) +1)/2) > noise3 = (((noise gridS intPt getPList3 getGList) +1)/2) perlin noise marble > perlinMarble :: Color -> Int -> Double -> (Double,Double,Double) -> Double -> Point3D -> Color > perlinMarble base freq gridS (xf,yf,zf) pow intPt@(x,y,z) = base *> (((sin (x*xf+y*yf+z*zf + pow*turb))+1)/2) > where > turb = turbulence freq gridS intPt perlin noise marble with base color > perlinMarbleBase :: Color -> Color -> Int -> Double -> (Double,Double,Double) -> Double -> Point3D -> Color > perlinMarbleBase base addColor freq gridS (xf,yf,zf) pow intPt = clip (addColor <+> (perlinMarble base freq gridS (xf,yf,zf) pow intPt)) perlin noise wood > perlinWood :: Color -> Int -> Double -> Double -> Double -> Point3D -> Color > perlinWood base@(r,g,b) freq gridS xyFact pow intPt@(x,y,z) > | (sinVal < 0.5) = clip (r+sinVal,g+sinVal,b+sinVal) > | otherwise = (r,g,b) > where > sinVal = 0.25 * (abs (sin (xyFact*(sqrt ((x*x+y*y+z*z)) + pow*turb)))) > turb = turbulence freq gridS intPt functions which provide the 'random' lists needed in the noise function > getPList :: [Int] > getPList = [156,75,107,52,93,1,39,80,70,140,42,161,86,82,47,121,158,30,148,27,29,143,201,164,59,209,63,134,34,217,171,19,187,115,208,111,163,60,241,144,65,238,8,170,193,87,45,147,92,133,250,125,184,10,254,197,243,234,103,212,20,251,43,178,173,123,13,236,139,192,200,242,185,4,252,22,16,88,54,181,96,159,132,168,3,104,36,62,95,221,120,206,12,167,219,58,182,229,14,15,97,227,175,78,145,35,40,223,94,98,237,141,255,146,44,245,235,9,49,69,142,231,247,199,166,124,191,179,152,114,188,126,31,230,61,122,84,99,57,7,83,202,117,17,66,56,211,51,25,71,180,24,246,129,183,226,224,225,213,218,253,28,50,5,18,210,137,38,100,204,118,160,11,48,127,153,101,72,81,102,119,198,0,53,41,135,32,89,248,128,26,136,108,194,74,110,165,85,151,176,222,177,244,249,155,232,205,157,21,23,112,169,207,240,172,203,113,6,131,116,149,195,154,73,214,109,64,150,55,215,130,76,239,91,106,2,138,79,228,37,220,186,189,190,233,90,33,174,67,105,77,46,162,68,216,196] > getPList2 :: [Int] > getPList2 = [68,7,60,70,35,136,137,66,139,4,29,172,159,222,44,21,235,128,219,157,19,129,195,201,178,14,6,142,144,151,17,110,231,11,252,246,63,145,192,199,119,84,114,248,193,203,38,229,233,143,208,127,188,164,37,51,34,93,27,3,30,207,130,97,104,111,224,133,118,59,43,230,131,90,206,152,183,138,227,239,171,237,10,218,77,243,100,101,210,177,55,182,147,78,181,25,33,23,91,124,215,168,99,253,197,225,12,251,135,255,242,174,120,238,160,98,154,102,204,95,116,250,31,64,123,109,167,39,86,46,45,28,15,8,180,244,153,196,88,89,191,94,74,202,67,0,36,214,83,73,121,96,122,48,156,176,72,62,52,22,194,175,81,200,20,146,245,234,169,236,16,113,249,187,117,1,166,189,108,254,241,185,217,232,186,32,76,141,105,24,132,13,80,18,9,61,140,26,240,173,125,107,115,190,150,106,112,205,53,87,161,228,65,134,213,82,69,220,58,41,223,184,221,75,57,50,162,170,179,148,5,216,42,56,103,47,49,165,209,247,2,155,92,158,211,126,54,85,40,226,212,163,198,71,149,79] > getPList3 :: [Int] > getPList3 = [222,172,15,58,36,53,213,19,219,63,151,189,128,249,156,201,99,32,97,123,73,90,143,33,111,173,91,28,95,6,57,64,61,14,133,50,220,176,9,234,169,193,144,0,43,153,38,214,235,145,59,252,102,92,76,141,125,106,166,244,155,164,187,239,254,250,81,51,159,177,60,115,241,148,87,218,212,11,29,224,221,47,25,230,46,245,86,110,17,217,181,136,71,3,134,139,175,135,21,200,113,227,118,225,67,206,209,121,253,150,199,13,240,138,84,62,185,1,79,208,131,18,41,55,49,94,165,198,170,20,146,247,124,120,31,205,204,68,75,174,101,140,152,103,83,228,142,147,231,26,119,251,88,80,126,202,30,184,2,179,69,180,105,171,4,168,66,186,65,238,246,160,226,117,216,12,127,114,191,243,182,163,223,45,215,157,8,100,42,161,195,229,248,40,109,78,196,130,27,10,44,112,178,35,24,237,255,132,104,129,188,149,107,183,48,190,54,37,23,194,5,207,74,70,122,167,158,108,93,116,7,39,154,203,72,16,89,211,22,56,192,137,232,34,98,236,52,210,162,82,233,96,197,242,77,85] > getGList :: [Vector] > getGList = [(-0.4634008664963077,0.6286133493341217,0.6245837765819799),(0.43585568358313037,0.6779977300182028,-0.5919027801746215),(0.6250574787860281,0.7181511458392663,-0.3058791917463542),(0.8135826709105591,0.5768258090053701,-7.317939367978575e-2),(0.8102836947024236,0.33306139598197776,0.48219336433211707),(-0.8219416017916845,0.5525657827170988,-0.1381414456792747),(0.12290483850784734,-0.9695826148952401,-0.21166944409684818),(0.3907853884556271,0.6495836589560424,0.6521716416610466),(0.653487309627378,9.718529220099467e-2,0.7506726018283727),(0.20692854077259132,0.8449582081547479,-0.49317968884134267),(0.5866653947647505,-0.7476406555233711,-0.31121883746666645),(0.6057779397784332,0.7049052390149041,0.36897383604686385),(0.5770184070730312,-0.35910188099757795,0.7335499962258216),(-2.0090358683846572e-2,0.7483658609732847,0.6629818365669369),(0.2992716739795579,-0.6760333349716798,0.6733612664540053),(0.9482677859648617,-0.128144295400657,0.29046040290815583),(0.7345179471496381,-0.4916773197246557,0.467693060225892),(-0.3283486703678434,-0.6758244477474058,0.6598851919043066),(-0.6563929338136774,-0.6792903617374103,-0.3281964669068387),(0.9519853475042687,-0.11899816843803358,-0.2820697325938574),(-0.7276529864219791,0.43829390410212776,0.5276547971714937),(0.48088800920698377,-0.6640834412858347,0.5724857252464093),(0.3583826193080968,0.3162199582130266,0.8783887728139628),(0.46536043035070707,-0.6605115785622939,-0.5892063513311372),(0.7533034799434275,0.6576458951887065,-5.97859904717006e-3),(-0.14104019215200714,0.7584828111285717,-0.6362479779301655),(-0.8026376828487632,6.627283619852173e-2,0.5927737015534444),(0.749177587697674,0.3983722093313028,-0.529180994484865),(-0.37701284859676626,0.15851676588727673,-0.9125424630808092),(0.6393297075616597,-0.59651745035887,-0.4852055816316168),(-0.4410228345484034,0.8869459228140113,0.1372071040817255),(0.913204829352515,-0.3842693588859593,0.13562447960680915),(0.36848266548445074,-0.6004902696783642,-0.709670318710794),(0.3218646979799666,-0.8754719785055092,0.3604884617375626),(5.5982268245459724e-2,0.6388564729187757,-0.7672863824230657),(-0.8480955459415358,-0.454336899611537,-0.2726021397669222),(-0.7926276375139397,-0.6030862459345193,-8.960138511027144e-2),(0.5421365580279602,-0.6265676613273966,-0.559911527143631),(-0.713354593519309,7.98957144741626e-2,0.6962340832748456),(-0.628828647337837,0.625354455916081,0.46206745909354874),(-0.28874012328916265,0.9223642827292696,-0.2566578873681446),(-5.437754783897633e-3,-0.7232213862583852,0.6905948575549994),(0.41144386020951107,0.2549792936509646,0.8750425759385376),(0.37180144391637504,-0.3563097170865261,0.8572088845849758),(-0.2748176998042737,0.9498085414288056,0.1494622577882892),(-0.21756086223891782,0.9324036953096478,0.28860114378631957),(-0.26691469746914426,-0.9633952361776925,2.5023252887732272e-2),(-0.20920802010140857,-0.6879043372825976,-0.6949961345741708),(0.847882935691488,-0.3491282676376715,0.3990037344430532),(0.2271631333745012,-0.6382202318616939,0.7355758604507657),(-0.592382011041402,0.11626189001747142,-0.7972243886912327),(0.76585513461521,0.6368690066800168,8.867796295544537e-2),(-0.12653619804509905,0.9701108516790928,-0.20705923316470756),(0.889904549324724,0.2251565727207133,-0.39670443765078056),(-0.3626509825924703,-0.675395866663041,0.642125134315108),(-0.3757202342849532,0.6427610619585563,0.6676020691840078),(-9.446769167000744e-3,0.6927630722467213,-0.7211033797477235),(-0.6024071619888135,0.6515832568450431,-0.46102588927715316),(0.6066694021538221,-0.7890424126172411,9.676935249079371e-2),(0.7184143150243675,-0.4555798095276477,-0.5256690109934397),(-0.5499984410497121,-0.5999982993269587,-0.5809507342689599),(0.565131689477802,-0.1266674476415763,-0.8152187014880937),(0.1738902175481343,-0.5578977813002642,0.8114876818912935),(-1.3570632358703896e-2,-0.9499442651092728,0.3121245442501896),(0.5796148950595086,0.5350291339010848,-0.6146465645411272),(0.3525789014949555,0.8402581297309688,0.4118912400642004),(-0.4195972942125916,-0.817786563210255,-0.3939076639546778),(0.8630690012043962,0.22588134015896308,0.45176268031792616),(0.33917693997389664,0.559846274414745,0.7559967939177213),(0.8029504988635409,0.4959400140039517,-0.33062667600263446),(-0.82489689433191,0.5649293882394293,1.9997500468652365e-2),(-0.5873656615794404,-0.5229449115997599,0.6176813086287019),(0.674305927100485,0.4680476435168072,0.5711767853086461),(0.39560567798776436,-0.9152071654940818,7.675931065434234e-2),(0.33078363377166053,0.6929046644269521,0.6406756696209004),(-0.6796880424946163,-0.7267433685134744,9.9339021595367e-2),(0.6255520917145204,0.4525270450700786,-0.6355343059440075),(0.5555476822360781,-0.5828138261495053,0.5930386301170404),(3.1884995581813735e-2,0.7420508062676651,0.6695849072180884),(-0.3826877903138114,0.6250567241792253,-0.6803338494467758),(0.7090281371617104,0.6901207201707316,-0.14495686359750526),(-0.14631124493166056,0.7559414321469129,0.6380795959519642),(0.7571459658272776,0.6523103705588853,3.4945198422797426e-2),(-0.5884180662449523,-0.763911173721517,-0.264960181876382),(0.5030489248048373,0.6148375747614677,-0.6073849980976924),(5.4365842885224454e-2,0.7899037172147317,0.6108162347692865),(0.3412569003471914,0.9384564759547764,5.332139067924866e-2),(0.5798245325734733,0.6876988642150498,0.43689104314838456),(-0.513804404202253,0.6870298890475841,0.513804404202253),(-0.6163246413943037,0.46673128183257945,0.6342758445417106),(-0.12464211362686843,-0.7270789961567325,-0.6751447821455373),(-0.5476596298214216,0.7982835282142755,0.2506238983928539),(-0.49389773650771324,0.4326391025222604,0.7542469309458877),(-0.6216210956407131,0.24103675137088876,0.745311007528406),(0.3892647784833973,-0.4923054551407672,-0.7785295569667946),(-0.5144957554275265,-0.8231932086840423,-0.24009801919951235),(0.8808895871984485,5.551825129401986e-2,0.4700545276227015),(-8.974452955710893e-2,8.974452955710893e-2,-0.9919132214206777),(-0.46125358714308906,-0.6378478176493003,0.6167619393799019),(-0.107300150387041,0.41578808274978385,-0.9031095990909284),(0.44957071606417937,0.5046201915006095,-0.7370513100099811),(0.26461408801082403,0.28866991419362625,-0.9201353514921836),(-0.7110543723962668,2.5096036672809414e-2,0.7026890268386636),(-0.6023056672991455,0.6170560101717776,-0.5064284386270366),(-0.307970416434183,0.7628190314754378,-0.5685607688015686),(-0.8177770089795866,-0.13629616816326443,0.559163766823649),(-1.117964118175896e-2,-0.8943712945407168,-0.4471856472703584),(-0.6043991523488209,0.7188686887785218,-0.3434086092891028),(-0.9552357026015896,-0.16318609919443822,0.2467692231720773),(-0.5928165666406283,-0.6354652404996664,-0.49472461676484086),(-0.5104239604648815,9.496259729579191e-2,0.8546633756621272),(0.5796273126824756,-0.49562335432269644,-0.6468304793702988),(-6.689730287799096e-2,0.6052613117532516,0.7932108769818929),(0.8646494312593326,-0.32096834948263103,0.38647209427500473),(-4.450228396058756e-2,0.5374506601394036,-0.8421201426388106),(0.3281220021482102,0.7048546712813405,-0.628900504117403),(0.12024122368609878,0.8346155526446857,0.5375490000084416),(0.2624174380561661,0.4373623967602768,-0.8601460469618777),(0.3745614500057702,-0.11157149574639962,0.9204648399077969),(-0.7034195842885712,0.6659038731265141,0.2485415864486285),(0.6737504311483288,0.2844110426568765,-0.6820342479247427),(-0.2669341008999655,0.5524052921402064,0.7896800484957313),(-0.5862797614630307,-0.36078754551571124,-0.7253332946305444),(-0.6060432152628561,-0.7342446646453834,0.30593527693557643),(0.5939513859122539,-0.774392313278002,-0.2180327872336122),(0.8277621201319056,0.1464764245500903,0.5416221279875432),(0.39046761083480547,0.8785521243783123,0.2751021803608857),(8.110849338581397e-2,0.7812028573475767,-0.6189858705759487),(-0.7531008727607394,-0.10336678645735639,0.649734086303383),(0.1710343857312061,-0.4357304588866441,-0.8836776596112315),(0.777465131462145,-0.5483570492438318,-0.3079813564246178),(-0.20076323572995633,0.5152923050402213,0.8331674282793188),(0.7699499314842428,-0.5145704987642218,0.3773516990937626),(0.1413841819385486,0.9705833030376039,-0.19488089942881023),(0.17477342688942704,0.3495468537788541,0.9204733816176491),(0.7135903152997383,-0.6589460118758845,0.23786343843324612),(-0.7566535227522645,0.4431230575234256,-0.48074671335088626),(-0.6749413541043249,0.6240529186758242,-0.39371578989418954),(0.8135083195168874,3.2671016848067765e-3,-0.5815440998956063),(-0.6433314281494985,0.36693718494452876,0.671923936067254),(0.1602165143081764,0.5955874771021341,-0.7871507007314754),(-0.7094407780723715,-0.5521299968476282,0.43800256733163806),(-6.619347516577881e-2,0.3699047141617051,-0.9267086523209033),(-0.3686998540924837,0.531361554427403,-0.762702639348177),(-0.40459364116157837,0.6342278699289607,-0.6588315372968946),(0.6414128794195922,9.377381278064213e-2,0.7614433597788142),(0.91635097414675,-0.2290877435366875,-0.3283590990692521),(0.8134344345567368,-0.3120502787739206,0.4908656070600998),(-0.6942673149736415,0.15362510799416748,-0.703130301973305),(-0.6235409359014416,-4.2838690252770796e-2,-0.7806161334949345),(0.5316366869934472,0.8468548996355797,1.4114248327259663e-2),(0.37973865183871736,-0.7673069666019443,0.5167577530176359),(-6.336347940953027e-2,-0.9702532784584323,0.2336528303226429),(0.8622553900225496,-0.3546372975092744,-0.3615909700094563),(5.446224937577672e-2,-9.077041562629454e-3,-0.9984745718892399),(-0.7065618047809735,-0.23552060159365787,0.6673083711820306),(-0.13569070631055166,-0.7802215612856721,0.6106081783974825),(0.48032525337147763,0.47724624533704507,-0.7358829202293792),(0.3773270957040923,0.4934277405361207,0.7836793526161917),(-0.14333120333184565,-0.8328705058472111,-0.5345866502647216),(2.5896477766233644e-2,0.7930796315909053,-0.6085672275064906),(0.7047777170117738,-0.7077895875972943,4.818992936832642e-2),(-0.6455791529870523,-4.210298823828602e-2,-0.7625318980934024),(0.28876831313241136,-0.681057342293423,-0.6728846541859019),(0.5549893897993612,-0.7273724578431021,0.4036286471268081),(0.5753164920729048,0.2876582460364524,-0.7656785666558513),(4.4614135635061274e-2,-3.9037368680678614e-2,-0.9982412848344959),(-0.8117807156413794,-0.5109869683278326,-0.2826736420536946),(0.7034358462564636,0.4378529247106559,-0.5598775102857567),(-0.8964469089202429,-0.4427794448917799,1.814669856113852e-2),(0.74034193688776,0.672230478694086,0.0),(-0.8302389420915597,0.4879474484222325,0.2694635162928746),(0.1656914962471534,-0.803603756798694,-0.5716356620526792),(5.888979223614891e-3,-0.5005632340072658,0.865679945871389),(0.5924190356676485,-0.6994827168124044,-0.3997044096070882),(-0.40908156114292343,0.5408196910025089,0.7349600929008455),(-0.60576300789061,0.34294519494336123,-0.7179413426851674),(-0.10180318074302291,0.7397697800659665,-0.6651141141877497),(-0.5386706239008539,0.5510065923871329,-0.6373583717910866),(0.63157591843216,0.7645392696810358,0.12880824652234843),(0.7892023356285827,1.9486477422927966e-2,0.6138240388222309),(-0.5529373873424747,-0.7151323542962672,0.42760491287818037),(-0.5314402884414319,-0.6128091364324645,-0.584838594935547),(0.908379410352939,-0.4159868327784487,4.244763599780089e-2),(0.16202092850385774,-0.7908164367450199,-0.5902190966926246),(-0.3602405233139769,-0.8201220424382027,0.4445521351534183),(0.5142949713279265,0.32759885159929564,0.7925778667724894),(-0.9525128068265735,5.291737815703186e-2,-0.2998651428898472),(0.6565884633026523,0.45903087257442066,-0.5984832895590548),(0.12271981244438597,0.7708338219162993,0.625104044638591),(-0.6826155860103779,0.48850688856666846,0.5435043528423861),(-6.395859981091866e-2,0.58273390938837,-0.8101422642716363),(-0.37986493543401506,0.7287204883836207,-0.5697974031510226),(-0.6376631059903642,-0.3816997465435279,-0.6690972027645371),(0.8678983685961432,0.20852103661076168,-0.45085629537461985),(0.9357809733432827,-0.17155984511293518,-0.3080279037254972),(0.610995665542666,-0.5395805877519648,-0.5792556309690211),(-0.5111334100566033,0.6002845862292666,0.6151431155913771),(0.8791306287808245,-0.2712745940237973,0.39184108025659603),(0.679728163091276,0.6997201678880783,0.21991205276482462),(-0.6128932644299215,0.2615531765401576,-0.7456217420771657),(0.16377449574589417,-0.8188724787294709,-0.5501143318644137),(0.8215670697539412,0.4146957590186561,-0.3912224141685435),(-0.534234229136161,-0.17957453080207095,0.8260428416895264),(-0.6518811198847961,-0.7363842280180104,0.1810780888568878),(0.14676947392042217,0.8219090539543641,-0.5503855272015831),(-0.46203346615158325,0.5734165338845543,0.6765490040076755),(0.1400637354848092,-0.8900824480808842,0.4337457615013446),(-0.9296984743221126,4.067430825159243e-2,-0.3660687742643319),(-0.9416366314963587,0.33491199780025127,3.397657948698202e-2),(-0.37496383625045837,0.9165782663900093,0.13887549490757717),(0.49729065222930485,0.8181233310869209,-0.2887494109718544),(0.3548819345758441,9.08843978791796e-2,-0.9304831211439815),(0.5159143363118958,-0.3933846814378205,0.7609736460600462),(-0.19582093200357792,-0.276703490874621,0.9407918689737113),(-0.6342530151141949,-0.6437668103409078,-0.4281207852020815),(0.8692840535434653,0.48852326975996396,7.543374018352385e-2),(0.10369715823742881,0.6722436465047109,-0.733031635816307),(0.5477083230489346,0.5722325763197824,0.6103814147411012),(-9.311114793883159e-2,0.6397636939022944,-0.7629106960149427),(-0.6142510719777644,-0.3604024146808311,0.702001225117445),(-0.9274749843799155,0.3684489663975007,6.352568386163805e-2),(-0.52446882788379,-0.38198307695582395,-0.7609345421897763),(3.691843631728479e-2,0.992695732086991,0.11485735743155269),(5.2970840542959224e-2,0.6687568618548602,0.7415917676014291),(-0.6545011330066678,0.6594973248616804,0.3697181972709421),(-0.7661045485684261,-0.5528589525751528,-0.32776637902669775),(0.7312694891319046,0.3772791631827024,-0.5682476284974035),(-0.38842121143594915,0.9078216685886719,-0.15807840000300258),(-0.3709951793578669,0.4288568128356994,-0.8236773706844385),(0.5147990812824593,0.5026144876426378,0.6945218374698269),(-0.6073542836083838,0.3795964272552399,0.6978734316461718),(0.44935605722680466,-0.4752182763477718,-0.7564699092882898),(-0.6540911945904198,-0.66090464453407,-0.36792629695711115),(-0.37102177884896653,0.3544088633781173,0.8583339659938778),(0.4810266182378922,0.14999754762256853,-0.8637789811368602),(0.6198338632077788,-0.41451389602020206,-0.6663214029483622),(0.6155080037411411,0.16513629368664762,-0.7706360372043555),(-0.2575061713069756,-0.8113873699672628,0.5247295566255352),(-0.10111561737561009,3.370520579187003e-2,0.994303570860166),(0.6197306037839875,0.1070443770172342,-0.7774802120199115),(0.24030301255873365,-0.38448482009397383,0.8913057193087576),(0.6252144815496288,-0.7755825214159953,-8.705518097526477e-2),(0.364614053701737,-0.5280617329473433,0.7669468026139985),(-0.13732820033006526,0.7641081915801067,-0.6303012271559405),(0.6305193663883901,0.7005770737648779,-0.334121373641711),(-0.2277672332425418,-0.49442155508746877,0.8388500541371661),(0.8628965392546408,-0.15828279714138382,0.4799542881061316),(0.6217049841833915,0.41786728445113197,-0.6624725241298434),(0.8205476791132401,0.0,-0.5715780841686245),(0.1173090030747732,0.9611769929352384,0.24975465170758163),(-0.6589925661940386,0.5375991987372419,0.5260379256461185),(0.8035155023932737,-0.5499999160766793,0.22773434025050004),(0.7719661916265194,-0.6339977658890138,4.5989475245835194e-2),(0.13834567131894154,-0.6640592223309194,0.7347692321161562),(0.2562911149706711,0.2462404830110369,0.9347087722459768)] }