## Around the Sphere build 2020-09-22

UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Around the Sphere build 2020-09-22

A 3D visualization of moving a text around a sphere.

Thanks to dodicat for some functions which I've used. ^^

Code: Select all

`'Coded by UEZ build 2020-09-22'Thanks to dodicat for some funtions I used from his code :-) and Martijn van Iersel for the CreateGradientSphere function. ^^#include "file.bi"#Include "fbgfx.bi"Using FBDeclare Function LZW_Decode Alias "fb_hDecode" (Byval in_buffer As Any Ptr, Byval in_size As Integer, Byval out_buffer As Any Ptr, Byref out_size As Integer) As Integer#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)#Define Round(x)                                              ((x + 0.5) Shr 0)Const w = 1200, h = 800, w2w = w Shl 1, w2 = w \ 2, h2 = h \ 2, pi = Acos(-1), pi2 = Acos(-1) / 2, radius = 350Const phi0 = 0.0, phi1 = pi, theta0 = 0.0, theta1 = 2.0 * pi, radians = pi / 180, deg = 180 / pi, cc1 = -270 * radians, cc2 = 1025 * radiansUnion _Color   As Ulong argb   Type      As Ubyte b, g, r, a   End TypeEnd UnionType vec3   As Single x, y, z End TypeDim Shared As Const vec3 eyepoint = Type(w2, h2, h)Type vec5   As Single x, y, z    As _Color colEnd Type'Taylor series'Sum n = 0 to inf (-1)^n * x^(2n) / (2n)! = 1 - x^2 / 2! + x^4 / 4! -x^6 / 6! + ...Function Cos_(x As Single) As Single    If x < 0 Then x = -x    While x >= 3.141592653589793 'pi        x -= 6.283185307179586 '2 * pi    Wend   Dim As Single xx = x * x    Return 1.0 - (xx / 2) * (1 - (xx / 12) * (1 - (xx / 30) * (1 - xx / 56))) 'approximation of Taylor serieEnd FunctionFunction Sin_(x As Single) As Single    Return Cos_(x - 1.570796326794897) 'pi / 2End FunctionSub Object3Dto2D(wa() As vec5, result() As vec5, angle As vec3, centre As vec3, rad As Single = 1.0, flag As Boolean = True) 'by dodicat   Dim As Single dx,dy,dz,ww   Dim As Single SinAX=Sin_(angle.x)   Dim As Single SinAY=Sin_(angle.y)   Dim As Single SinAZ=Sin_(angle.z)   Dim As Single CosAX=Cos_(angle.x)   Dim As Single CosAY=Cos_(angle.y)   Dim As Single CosAZ=Cos_(angle.z)      For z As Uinteger=Lbound(wa) To Ubound(wa)      dx=wa(z).x-centre.x      dy=wa(z).y-centre.y      dz=wa(z).z-centre.z      Result(z).x=rad*((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x      result(z).y=rad*((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y      result(z).z=rad*((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z      If flag Then         ww = 1 + (result(z).z/eyepoint.z)         result(z).x = (result(z).x-eyepoint.x)/ww+eyepoint.x         result(z).y = (result(z).y-eyepoint.y)/ww+eyepoint.y         result(z).z = (result(z).z-eyepoint.z)/ww+eyepoint.z      Endif      result(z).col=wa(z).col   Next z   result(Ubound(wa)).z = -radius 'center sphere, which is the last entry, always in the middleEnd SubSub QsortZ(array() As vec5, begin As Integer, Finish As Uinteger) 'by dodicat    Dim As Integer i = begin, j = finish    Dim As vec5 X = array(((I + J) \ 2))    While I <= J        While array(I).z > X .z : I += 1 : Wend        While array(J).z < X .z : J -= 1 : Wend        If I <= J Then Swap array(I), array(J) : I += 1 : J -= 1   Wend   If J > begin Then QsortZ(array(), begin, J)   If I < Finish Then QsortZ(array(), I, Finish)End Sub'CreateGradientSphere function by Martijn van Iersel -> http://www.helixsoft.nl/articles/sphere/sphere.htmlFunction CreateGradientSphere(centerX As Single, centerY As Single, r As Single, longitude As Single, latitude As Single) As Any Ptr   Dim As Any Ptr pImage, imgData   Dim As Integer pitch, iw, ih   pImage = Imagecreate(r Shl 1, r Shl 1, 0, 32)   Imageinfo(pImage, iw, ih, , pitch, imgData)   Dim As Single x, y, z, lightx, lighty, lightz, q_cos, light, c, lati1, lati2, longi1, longi2   lati1 = Cos_(latitude)   lati2 = Sin_(latitude)   longi1 = Cos_(longitude)   longi2 = Sin_(longitude)      'calculate the light vector   lightx = longi2 * lati1   lighty = Sin_(latitude)   lightz = longi1 * lati1      For y = -r To r      q_cos = Cos_(-Asin(y / r)) * r      For x = -q_cos + 1 To q_cos - 1         z = Sqr(r * r - x * x - y * y)         c = (x / r * lightx + y / r * lighty + z / r * lightz)         light = Iif(c < 0, 0, c) * 255         Pset pImage, (x + centerX, y + centerY), Rgba(light / 6, light / 4, light, 255 - light)      Next   Next   Return pImageEnd FunctionFunction Base128Decode(sString As String, Byref iBase128Len as UInteger) As Ubyte Ptr   If sString = "" Then       Error 1      Return 0   EndIf   Dim As String sB128, sDecoded    sB128 = "!#\$%()*,.0123456789:;=@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_abcdefghijklmnopqrstuvwxyz{|}~¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎ"   Dim i As UInteger   Dim aChr(0 To Len(sString)) As String   For i = 0 To UBound(aChr)      aChr(i) = Mid(sString, i + 1, 1)   Next   Dim As Long r, rs = 8, ls = 7, nc, r1       For i = 0 To UBound(aChr) - 1      nc = InStr(sB128, aChr(i)) - 1      If rs > 7 Then         rs = 1         ls = 7         r = nc         Continue For      EndIf      r1 = nc      nc = ((nc Shl ls) And &hFF) or r      r = r1 Shr rs      rs += 1      ls -= 1      sDecoded &= Chr(nc)   Next   iBase128Len = Len(sDecoded)        'workaround For multiple embedded file other crash will occure    Static As Ubyte aReturn(0 To iBase128Len - 1)    Redim aReturn(0 To iBase128Len - 1) As Ubyte      For i = 0 to Len(sDecoded) - 1 'convert result string to ascii code values      aReturn(i) = Asc(sDecoded, i + 1)   Next   Return @aReturn(0) 'return pointer to the arrayEnd FunctionScreenres w, h, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVESScreenSet 1, 0#Define PixelGet(_x, _y)                      *Cptr(Ulong Ptr, imgDataTxt + (_y) * pitchTxt + (_x) Shl 2)Dim As Any Ptr pImageTxt = Imagecreate(500, 39), imgDataTxt, pImageSphere = CreateGradientSphere(radius, radius, radius, -pi / 8, -pi / 4)Dim as string sFile = CurDir & "/Text_500x39.bmp"If FileExists(sFile) = 0 Then   Dim As UInteger iLines, iCompression, iFileSize, iCompressedSize   Dim As String sBaseType, sBase128, aB128(1)   Restore __Label0:   Read iLines   Read iCompression   Read iFileSize   Read iCompressedSize   Read sBaseType   For i As Ushort = 0 To iLines - 1      Read aB128(0)      sBase128 &= aB128(0)   Next   Dim As UInteger l    Dim As Ubyte Ptr aBinary = Base128Decode(sBase128, l)   Dim As Boolean bError = False   If iCompression Then       If iCompressedSize <> l Then bError = TRUE   Else      If iFileSize <> l Then bError = TRUE   Endif   If bError <> False Then       '? "Something went wrong"      'Sleep      End -1   End If   Dim As Integer hFile   hFile = Freefile()   Open sFile For Binary Access Write As #hFile   If iCompression Then      Dim As Ubyte Ptr aBinaryC = Allocate(iFileSize)       LZW_Decode(aBinary, iCompressedSize, aBinaryC, iFileSize)      Put #hFile, 0, aBinaryC[0], iFileSize      Deallocate(aBinaryC)   Else      Put #hFile, 0, aBinary[0], iFileSize   Endif   Close #hFile   aBinary = 0   Bload(sFile, pImageTxt)Else   Bload(sFile, pImageTxt)end ifDim As Integer pitchTxt, iw, ihImageinfo(pImageTxt, iw, ih, , pitchTxt, imgDataTxt)Dim As Uinteger particles = 10000, i, ubDim As Single x, y, theta, rho, phi, f1, f2, ang, z1, z2, px, py, pz, c1, zoom = 1.0Dim As Ulong iCol, iCounter = 0Dim As vec5 aParticles(particles - 1), aResult(particles - 1)Dim As Boolean b1 = False, b2 = FalseDim As Single dimx = 0, dimy = 0For xx As Short = 0 To iw - 1   For yy As Short = 0 To ih - 1      If PixelGet(xx, yy) <> &hFF000000 Then         If xx > dimx Then dimx = xx         If yy > dimy Then dimy = yy      End If   NextNext'Map string to sphere formFor xx As Short = dimx To 0 Step -1   theta = Map(-cc2 + xx / 4, 0, dimx, theta0, theta1)   For yy As Short = dimy To 0 Step -1      iCol = PixelGet(xx, yy)      If iCol <> &hFF000000 Then               phi = Map(cc2 + yy / 16, 0, dimy, phi0, phi1)         c1 = radius * Sin_(phi)         px = c1 * Cos_(theta)          py = c1 * Sin_(theta)         pz = radius * Cos_(phi)         aParticles(iCounter).x = w2 + px         aParticles(iCounter).y = h2 + py         aParticles(iCounter).z = pz         aParticles(iCounter).col.argb = iCol         iCounter += 1      End If   NextNext'blue sphere coordinateaParticles(iCounter).col.argb = 0Redim Preserve aParticles(iCounter)Redim Preserve aResult(iCounter)ub = Ubound(aParticles)Dim As String sWintitle = "Around the Sphere coded by UEZ"Windowtitle(sWintitle & " / " & Str(ub) & " Pixel")Imagedestroy(pImageTxt)Dim As Ulong iFPSDim As Uinteger cfps = 0, s = 4Dim As Single fTimer = TimerDo   Line (0, 0) - (w, h * 0.75), &hFF404040, BF   Line (0, h * 0.75 + 1) - (w, h), &hFF808080, BF      ang += .0033   Object3Dto2D(aParticles(), aResult(), Type<vec3>(cc1, 2 * ang, 0), Type<vec3>(w2, h2, 0), zoom)   Qsortz(aResult(), 0, ub)      For i = 0 To ub      If aResult(i).col.argb <> 0 Then aResult(i).col.a = Map(aResult(i).z, -2500, 600, &hF0, &h02)      Line (aResult(i).x, aResult(i).y) - (aResult(i).x + s, aResult(i).y + s), aResult(i).col.argb, BF'      aResult(i).col.a \= 2'      aResult(i).col.r \= 1'      aResult(i).col.g \= 1'      aResult(i).col.b \= 1'      Line (aResult(i).x, aResult(i).y) - (aResult(i).x + s, aResult(i).y + s), aResult(i).col.argb, B      'Pset (aResult(i).x, aResult(i).y), aResult(i).col.argb      'If aParticles(iCounter).col.r < &hC0 Andalso aParticles(iCounter).col.g < &hC0 Andalso aParticles(iCounter).col.b < &hC0 Then      '   Circle (aResult(i).x, aResult(i).y), 2.5, aResult(i).col.argb, , , , F      'Else      '   Circle (aResult(i).x, aResult(i).y), 5, aResult(i).col.argb, , , , F      'End If'      If aResult(i).z < -radius Then Circle (aResult(i).x, aResult(i).y), s, Rgba(&h20, &h20, &h20, Map(aResult(i).z, -2500, -radius, &hF0, &h20))      If aResult(i).col.argb = 0 Then Put (w2 - radius, h2 - radius), pImageSphere, Alpha   Next   Draw String(1, 1), iFPS & " fps", Rgb(&hFF, &hFF, &hFF)      Flip   cfps += 1   If Timer - fTimer > 0.99 Then      iFPS = cfps      cfps = 0      fTimer = Timer   End If   Sleep(1)Loop Until Len(Inkey())Imagedestroy(pImageSphere)'Code below was generated by: FB File2Bas Code Generator v1.05 build 2020-08-08 beta'Text_500x39.bmp__Label0:Data 24,8,20578,10151,"Base128"Data "nJ:7*J#!lJ;.b!#J7|l\$mH(!(±0R7D((|J7.V!:J7Pl)¿L³.(LoB8hp!!N!!\$¯t!!*!:#!7!S\$!R!¦(!¯!h0!¯#7:!!(|P!!0!z!!;lG#!V!j\$!¯!\$)!|#71!l%d;!l,JS!!7J¡!!L!R#!t!¡\$!B#V)!l\$³1!J)¯=!!2¿U!!Al¦!!Zl]#!³!·\$!|#¤)!Z%d2!!,.A!l5lX!!H¯«!!j!i#!!#Ì\$!.\$!*!J(33!¯.ZB!!97[!!O!²!!xls#!F#9%!l\$T*!7)¯3!l1¦C!l=¯^!!VJ·!!¨!~#!d#Q%!Ç\$¢*!!*_4!J3!E!!CZb!!^l¼!!·lª#!¢#h%!Z%Í*!¿*.5!!5RF!lF!e!!f¯Á!!Å!¶#!¿#}%!·%R,!¯,ª5!¯6|G!!J|g!!m!Ç!!(mÀ#!3\$µ%!J(~,!|.Z6!l8ÇH!lMJj!!tJÌ!!9#Ë#!R\$Ê%!¦(Ë,!l0(7!J:JJ!!Q¿l!!{l\$#!Jm*\$!p\$7(!7)P.!Z1¦7!!=tK!lTlo!!¤¯,#!X#8\$!¯\$"Data "O(!t)|.!J2V8!¯@¿L!!X7r!!«!4#!hmE\$!Ë\$f(!!*É.!73!9!lBBN!l[¯t!!³J9#!v#P\$!B%{(!d*N0!!4¢9!JDlO!!aZw!!ºlA#!¦mZ\$!_%³(!¿*z0!¿4R:!!F·P!ld!z!!Á¯F#!µ#g\$!|%È(!R,Ç0!¯5Ë:!¯G7R!!h||!!È!L#!Ãmq\$!»%5)!¯,L1!|6|;!lIdS!lkJ¡!!!KQ#!\$\$|\$!.(M)!B.x1!l7N=!JK¯T!!o¿£!!,mV#!7n¨\$!N(d)!|.Å1!Z8Ç=!!M.V!lrl¦!!5°[#!H\$´\$!l(y)!.0J2!J9x@!¯NZW!!v7©!!=#c#!Vn¾\$!ª(±)!l0v2!7:JA!lP¦X!ly¯«!!FKh#!f\$É\$!Ç(Æ)!Ç0Ã2!!;ÃA!JR!Z!!}Z¯!!Mmm#!tn(%!;)3*!Z1H3!¿;tB!!TR[!l¢!²!!T°r#!¤\$6%!Z)K*!·1t3!¯=FC!¯U|]!!¦|´!![#x#!³nC%!x)b*!J2Á3!|@¿C!lWÇ^!l©J·!!dK}#!Á\$N%!·)"Data "w*!¦2F4!lApD!JYJa!!®¿¹!!km¤#!!oX%!(*¯*!73r4!ZBBE!![tb!l±l¼!!r°©#!5%e%!J*Ä*!t3¿4!JC»E!¯]¿c!!µ7¿!!y#°#!Foo%!h*1,!!4D5!7DlF!l_Be!l¸¯Á!!¢Kµ#!T%z%!¦*I,!d4p5!!E;G!Jblf!!¼ZÄ!!©mº#!do¦%!Ã*_,!¿4½5!¿E·G!!d·g!l¿!Ç!!±°¿#!r%²%!7,u,!R5B6!¯FhH!¯e7i!!Ã|É!!¸#Å#!¢o¼%!V,¬,!¯5n6!|G7I!lgdj!lÆJÌ!!¿KÊ#!±%Ç%!t,Â,!B6»6!lH³I!Ji¯k!!Ê¿Î!!Æm!\$!¿o\$(!³,..!|6@7!ZIdJ!!k.m!lÍl\$#!Í°)\$!Í%4³M¿JGt,Éml|7N(4KNR0]nz7;;)SK1l8J)L!=(*qK]·3Lo¹7E;*À#1°C¯!½|H³,ÌKlR79p*}H;!l#oKcB)7(Lp0aLz·:nn1nÍ¯F3\$|t=fqZ}VN2SK(¯9¦4¯%fl,¼L².CTrt78ZHË,l°9]r¨8cÃ4mM"Data "Mt#R)joÈZ7hKÀRH~sD}p7\$C%G±H1t(~m_.=!¢lcJ6;\$1l7[N4011%V%Î¯B;#5SO]uX~6¢!t\$«#i·.@9x(;§NBlU¿6toQJ!(OSuT¨s.!PZE¢,6K)¦vµ~i;!·\$»mkl1P!¨pAÄO¦.#t(_%¦N@ÈOq0CÉ!ÁnÎJH¦.iS2t%Nl9p!3#Vl\$|:¤!@¯!BK)¯)¦\$ÁlH|*¦!%!.±!xlE|*B#§SxZ\$d!¢NTV#E\$,±!·l3l%)!5J1d%µ!9!\$.!%!).#!~7;!p!VJ)7zh(#!%x#;Jg±mJlBl(;!Ft!d#·lº°,d#4!39!@l4l)ÇPX!lÁ8f}¼|:°!GJ3t%Ç!Cl\$(R¹0aÁm\$l5Z*ª!4Tmd!r!G¿f»#KJf\$8¢!CJ3=K%J)7%XsH¯)l!X¹.T!j!G|,ª#Slt1¡Dl:|*¿#gJ0d!l|%|(¢#c!1Z|\$!.¿\$ÇJ,l0¦%X,G¿%tRH.qÁ\$½lA!(³.,¯)|!@=5(#_Q)!*!¥ª!4ZU#Kg!j7u(==Ã!!#]!5Ç\$hl)!Y8.%¯)7%~£2£]«R"Data "il4¿#*!3¯*Ã#@º¶f¢½l@!%F*¬mDJn(l;J=B*wl!l%»n±J.;K@lGB2D%¿lF·*R°:t!h7B¯8;*ªmbZ37nAZ!R\$kKT¿!ªpnZC¯\$,¹p.!¤#»!9ZMfn@!1;%½!E7*Hm;¯\$X\$z!*7K*¯:R3lnH¯fO1!°_d,J¡0=2d*XK3Z¡9lZ¿=³*xQe.4n\$UJi0K\$!,Z,t\$ª¿CË*²K_R1nm]£J;!{!cZ6¨nm7A|*,xad1!mlqJR#Zm[R(Ë¢0m\$V(¥#JÇ¬1(7|7(*°#Â05\$%r|)!N(JZJ4h#:_#¿\$Vma¯ht%·7;ª\$*w.Á#±m«7F3,©°]R1h#0ZSG!v!Qd3_oÀ7F;*#mr±m1!K79B*¨#cl3¨\$a!(Ç%X°8¿8*!:l7B*UVe!5Ç\$k¿)¦SLL,l*±\$·lEt*j#Nd%.m¢¯6Ë!62mÇ#7nW!\$t#*°V.4d%·¯@Z(R!FE81l¥¿I¢,§¯r\$%*n¬¿DÇ*~#Yl0@#U¤x´#NKa75Ã¥~¤¢8,©#P.\$(\$»lFBaY¼5²4H%¨JAÇ,¤K©1n5!alGp,"Data "¼!#R)noÆZ33K(¯7.3Ë%4;§Ì,À°K!#hp(¯2(,vy*n5¨m~|!¼!rneÇ6¨\$4¤J7!¦mk!5\$@\$!,N*¡y*±6¨%ÊZG!%N.\$7*ªoÂ|4t.:n*t2Ç%¤!(ÃJ2¯JZ6½%i|¬=!q¯Z·6|©Î¯IV*u!X%n\$!:|9l,,½k·6BoQ|WyM¬mpÊ6¬%s¯%7.\$J:¿4³%b!t¼Zf°kl4\$m\$K\$l%·mpg6l\$v;PÇ,ÊmKÇ½Ílª!§KcÌ#]Z)T¡7¢!Ã#£°mº6;%S!H£1Bmil½Ëo®¿yy.E!Vd¿Ë%Ç¯G»,3#pB#Å#AÆ¯y,=#0·z5!]lEFdÆKf¯6JoF¯}y.Ê!j¿4Án_(«i,Ä![±m*!uJ%8*NJ1±!xmÄ¿¯¸,b#5!¶R!tlHÃ,Ã#h.6µ%É|Hª,ÇKj¦6Ç%1;Hx)[!L76Í%Í|¹GIG¾ÈÈ5³%sQIÃ,ÀmGÇ6»%EZ(W!2°jd5Zm7]F.bM·172Á%ÍlEV).°MÇ2@«ÄJ3lQ\$J7¦3ÉoÌZCd(F°_¦6ÍoÂ|E¿,Æ#iÉ!ªoÎJA¢c6¼bw5\$¤;¿@¿,Ími¯3Vnw¯B³h"Data "D·eB)¬©ZJ¬}cH\$,73Ë%¨Z(ÃJ,JI¦Ã]nÆq.p*Ë°¸U4±n¢7C·,u4b¿(p|!!%J)Èm*¹6~%®7=¦)©#jÇ6Å%²l*7.*l@!59©ÂJBR)b#c|Ë¬ohZU4!¥JdJ6¹m´q%=#a°kJ6R¨Bm7R,t¼fR3¢n¦¯E·eË°VJ{D!D¶µ4ljl]tÎ½%ºZ@V)u#il![%W¿kÈ.V¯Vl»Ão¹Z@;*Â#]Â6hoZ|c¸0ÆJh¦\$¼nt|7V)µmk|6|n»ÅL¢(,Zkd4h\$slAV,fXj·,1p,¿6NMÍ#fJ3¤n¨¯EBdU¿Qd\$\$l#¯,»*D·f·2Pn}JDª,uy]!²l|qJ¶Kd¥#UÇ05o,ÇId,Ì¯{Â8Nl¼PCe%35¡f(Z%(QGª)QmYZ5\$°¨¯8@.B!Rd6¦ou73!%±!Cd*~#b¯4l%Â!IÈ)¯l%J,|*Ì#g¯.h#A\$Cf8ªJBZ*¤#d¯5Ë\$i¯f¯6@nk¤J¿!U°k¿3Él@±FtilzI.6É%§7.|!*J\$¿#N\$Æ|¸aq7¯QR6Ço©¿*J!5¯.70LF³rH;U}¾k¯2T®*¤FRPiU#Ç,Á%ÎlER%"Data "LJ|!\$N#¯JÈ4,r!0f!jmÅZ¬Ìs¿±Z¿6É\$:|%)!¿JiÇ6±n6|W¿)ª{eR,~l2Z\$!#¢JX.67©·JJ´!@°#¢6Fogl*»!:!*!%ËmÂ¿I¯,B°Áf!lmÀ¯Ip,WK6·#Rl3l,J)È6^.%vp8¦HÃ%z4,¨#]MÎ¿43!#!;d5Ë%Í|B_\$I¯(Z#¨lf¯D7VÌ#G7=Ç¯8_%|)ÌmkR5Ím=¿\$|!JJ=¿1ªouAA¿tI·%¦,¿~ÃZ7B#A¯,.)»\$É!§À*wl#.!Íl·JªW%El\$R!R!T¿DFi¦!T9!TmÅZ§8(R¯%t!b!QÈ!¬,¼!md!]mÀ¿I·,p#8¿#R!3¿)¿%§#°v5½m#!(()°~]t(Vµ.|(R%ª°ª;3!µ6¢8·e¼#N.%Tl,7(¿\$q°Îº59#·£J(%D·)v3hF:;(F)É°j¯3L#3J\$»!clJ75ËoË7:¿!Å¼a:5V#7*(W!ÇJg|6pn8e(´!^°kZ3p!8¢*_*ÎmUJ{d#Ã¿E\$Kd!aÇ6RoE¯MÇ!Q#j¿5Ã#[;.³d¨m6¯rF!l7_Í,¿°j;ÌËM5p!·*U7*7!¨lÄÇFJ\$"Data "#T!Ç#¢nÎ¿E»#99AR8£®0m%³tomn·mnmkQBJ#1JK!9s%L7gL0d!RZ3Dn7;#¢%ÁKkÇ4Çm:Ç}«\$K:ed)(!(¿3B,Á°Id=2p5!@³,É°I7#p¯¿¯H3(P»p¿!f\$4p7J!LJZ|m¬n4¯O[!°!WB3L³1¿W*K3¯FÇ!u%RJiG!aJO.3.n«Ã%Ä#|mk|5¯#o£#B%¡°·¡1Tl.|:ª,ÁKGt)2(ZZ¸S*Y.*¦3¤Jc|jL!ÌRi.*.(AJBË,Æ#TÇGKp2¿2|)Z#:¯!¤#ÄJI¿)aJCE(3%Ì7AlkJ.Ml»¹%g¿v9.=JP¦.8%ifLt!q°¸E3¯µ£eRS%¼mkl3!m»e!¦\$©mk¯5¦#Ç;%3)Ç°ËVIm|1¿93{6#~Êm.!k7IN,¢l.Á(¬oUQFÄ\$1ÃZ%n(!TZH¯,G°QM71!Y!Vv)\$ÃK°)Wn{¢JB#hm*É5r·ÍÇL@0v°¸g\$7!q¿I³,Em9£:x¬½Z*7Y©J5i8§I¿T)ÇJ~l_²3¨!C¿BÃ,ÉmKRY2p(!(¿¦H±0Ç2Í%Ä¯5;e(n*R1F®qZ\$N!¾JfÇ5¤#}vMx\$"Data "¨mkJ3¨!\$¯1Z¡,°MWµJ\$³*9d!µ!gÇ6t%L!Y)!;!,·7V!mÉ%)!S!Z¿6·ox!·¬0F¯}G8|m¼¤AZ#XT[^1L%[J#»!xKkl4¯!dÅ#x*ÌKiB((lV7Î0*Çts¦(ÃoÈl~=!¹!²N45maA!x!C!#J\$³nS¢3x¨(\$.d1½o¦7((Kw£k·1_lOO(!*Ë#g|(QpR7GÇ,j#8lw@%YU(£!Q°]M,~½NK6xrÍbm¦X©UÉ¸([#§Kk!6TmÆ¨%£#s¡RÇPe|(l77¨}!m.ZAR6¢#x%ÈmdB*F¨8J¹e*hlz|1rKR¯}¸\$CYry;tR5g!RmÆK6.#ZºÄ7ÄÀJ4!Ç£4±VeÃ@§tH±*Ç21«=¯%#\$5¢_J%z#XRA;#¤[Xw,·Ft7;z.(¯@!5Å%©ltµ%¼mg|*d»4J;¯,«°:l!Rm¿¿HRNHtHd!Y\$;Jh¬,Í¯P(nª¼DA(C!±!f¯6.%.F*[(wXIRek7BJ¨Ä(yÇs2,¿%Ìl53!H#]Ê)fNTJCi\$©nW7¸ÅmO·M;\$~°kZ27[6m(x)ÆKTdUi|p|Id,µY,D!|#Ê¯I»("Data "n1)t1n·X¯!Ã%ÊmiÇ,tÀ6#,h,90FH8h!}lIR,h:mt#nnÊ¯«HKt!c7½L#»ºMR!bmkÇ47Z6¢\$ª)Î#cÇf¶.#E(£!1mj|4LmO´#¦(_Ã9¿B!oÎ¯E³#Gt,.7ÀYÍ¦p@^O°t´(¤!¸¯IF¯G·%¿.|F´0·°\$»°\$*ÄÉ\$1Q4Ê._JTW4ÇlnlH·,8#{a²bnÎ¯F¯#J·!R(DX°¯)V!\$Kh¿5~#5g\$N(Âmel*@!S!Fª,3#qÄ8d½ÎJ:|#k#k75N#ohL!±i¿,n!ÃmÎÅ9¢gSR!!17Ea¯,ÊJx¯b^.;»\$K0ls6°#dQÎ%I|%0!®¯]¡(µq¸¿I3,t¯.±)¬µÌ§%G#f#jZ1fl7Ã7¿,ÃÇ,D)ÍG¥!%;.cJl_3r³E79)*k_.n!t_Ë¯:VgU\$=·5Ço¤!6°!IKO5iy7,J7l,¥bUËm(l_!b1(Q!)¿!Dl)7#F!)JvZ\$zo²DZ8®%b¬¹#Z!4|8lnr¯~D!9\$xd2l5}°kJ3pÁ0K!d*ÌmY¤k¼«xZ³¨\$h¯b·69ois%u!A°kd4JV8¢!hµ}em¦#Å\$Í¿C_#"Data "Ht1lWO%HJ9ËIA#8t(hm[J1!\$Ul(·!;!tC(0![JN.,d]t)0¢*Ë°X|\$B!qlHd,·!s)#n²¹r#p\$®°i¿.FÃ0À2pd@#5BËj%b7.l\$²lA¦(¿l7¿#Z!0!Ef|i7\$l%_V)°jd6h\$M!0¿\$²¯;.(¦!2JbI!yDpl0ÍI_7ÈÁJ{lww,j^H|Æ])9¯CÅ6H(gc4(}89.75Í%À¿2(\$}lÅ¤(¹l7!\$!¾w.EÇ5Í%u¿e¾Zo#j71¯Q7³7»,e¨,T(foÎ|@¿{L))~,|~)!9·,À°CR|0(0Z87¨º!.n\$½Áº¯r92H£Ojnj!QdI¯(É@pl#bÇ³µIt,¨°Y.19nj!7Ë(É#h·,5¢!gHJ%GR\$.,|o¬l,¦%ÈKc·Cº¡n¿u¥[{¯)h2Xb6KA»,je·(xQp#7F¶,¤!3R4Ë%ÀJTv»°§a¦t^9yWsÁ»f#k!55mOÇ(·¤x°4B.5K0sIV,}mP|%½ÇÆb5Z,È#R·#D!u|n@%¬4mJ#B\$ÉlEd\$,¯:Ç4Ç%¦!=ÂJ©lÃÊ.±!®7ÎudÇKdÇ2Ë#4lJ!±5mtb(¤oÁl,¯%"Data "J9O¶5H%z¿.·¼(±I¦°8\$6z%}#~4NÇ!f7F¯Rj)0lsÌ6(J:¹4»dT5,drOFÎ¿HÇ*kKG!IomIu=texZ[l6j\$^Ç%4(PhG½mÅÃÎl=ZZ6!eÇ6|o{;!ª#±KkZ3ËÉ7;%J)ÎKc!(l|\$|6«,³!Tf#_\$ÊltIKc¯cl½omgÊPa)D½_^5;m58¯¹,Ëlu¼#ªnÍ¯C!\$°¯id5ª#s*#h(ÎKd·(ttI¸=¢¸GRW|6¿Y,¿Q¨Â)±!t4À%QZ%Ç¦ÁmjI8P!{¿I¦*jHµj)JÂozJ»!0«h..Zg5p)B*!©2Zmsh½¸=xÅQtºvT²%elH¹(ÉKg.*¬U67=³,z°3B!¨fS6gÅJ±!A_.r!À§»oyµ!TÁbÈ%¥|%[!4#}=)pmÃZ¿Â,dmiÆmfm2.AR#DÇ,.½¤nÌªJ(\$¿#kR01l¤!§0(G.#!,rgZh¿:¨³JÈv4Ío´JAÎÉ@}QJÈg|l7IFÀ.Ë~º0p}W7Î}(:L\$BM¶oÌD(È!kmk!4DÂ5_¥Ì,(#bc#;G4¾(0!Ê¯wË3Å!Ê4!(!{!²»4¢\$«JBJ*yK_J4]%ÁZh±)"Data "8gTÅ6(%½¾M!\$RfZ!%9#Ä|H_(I¦1l2Í%´lFÊ\$Î½SJ{f|§7·AU5!ÊVÃA»²¿Ãa#bH(;2vfV#;tÉMFµb·YNWIÎi*]2,~%Jo7È%³#9=hl*;!4!*B\$¥!D¦,Ç\$Ì¯I¢(vË.9!b!aJ¨iÄMÁ%ÇE§oWJi4!¹Je¯6n\$yO¾¾,L#%Â8µmhË4B!¿!A³3¬l*J(³#xlAÇ*7\$]sH¢´¬\$]Ê5Ë!AÄ\$Z*wY6!%h»ÅZ5J!b^8d)z#k¯@.JL°¿¼mZ!~¿H¦,E°.ÎmX!ª¯PÉ^.¹I!È¨m#¿2³k©mn,n¸m4ANA!Ä¯·Ê2±l*l(³#zJB!,Ln3QFl\$#J0Çu«og7M64u#nqÊe7ËvÆÊ.Æ¼j.6¢#(#%·¤©m¯5!·!r§BÇÉ[v1Z4Å%¬l¹ÊJr!v52;p1|9¢,¤®01#FnM·R©rSl[¿6\$o9J!Z!@¯,Z\$¦!E!6J,yÊB4Z{¬{lHy.¦!³¾1nl87¶¼)WËn£)t%Î¯Ä19~YUB±e7^1Îb!Gj_¿ÈMr|eG_!\$J6tÎ¨%Q¯O}!L°kR4;ËTÎ¹®t¨jÍw6_\$Sh!3%"Data "¹°kZ0J!0J:Flwm0.|R!~!QÂ\$DB¥1(¦n4¬I¢*xu(Z1Í%Å|2RYH!X|½b#(7¾Î*DRfZ)nLR{Ã«\$j²^BÀD\$1«,7q:¸Ys»É%¬¿lÎdTJed7ql.¯8»,Ìm_B¬Pp37:¯,·°CR¹e|1¦m:,ºlc:¡¬lVB#³Í·°PÅ8Bl·¯À*\$\$¯,7¼½oj¿L9!P¾g¯4%!0VCK({a!d(t«©¿Kd!ÎJ·c3Ã!5³)V*Ç°P|¿k|j!It,«¯¨2*]H½!*!0¥¯§:0!§0¿kH,%±,D!¹!¼!I_)jD.v\$*¼¶lF¥!:#iZÌ{7A¿BÇ,Ì°LR¹gÁu|~¥\$X1\$l,»%Å|3_R#¤*\$6Z\$yqJZ!\$KÉ¤,1l#J6¢f¯¯kx\$xSÅ¯5¢P²¯*c2±f6m=³,Çc%Z%¼%i!¸=!Í¯·Â2N;*¿=Ç,;½n²8B!S!q¤*Ã0¡]ÄcÅVI}²¦¯¯^«#jnË|§µPmJPµ6vn5¿J4!À¼k!§I_\$¿(B(s:(»3Tml´\$x}¹E.·8(!9¯9¦,ÌKTJ{ÁÌ¾7§4*d!X2!*mkyD(¸*lkÊ6¦o^|#Ã.@¯RBHAnl´¼¹J"Data "Æ°VÇ\$@8Ç@Hle4¯!J%t«Ì¯;F#,T#B*noÍ|B¢#Dd©d0µOÁl4¢!RS!R#j\$¸71J.#¯5·3Ã%~!5A!À¯L_3@A%!®XjµlRa!¨lÂÅGl®x±bXv~m%|K(!:;kl6(\$0O!¦#¦=jJ2D¨6s\$¿%·#u£¿k|i¿HÃ,}#9lÃ9!V¯¹Å,1K¾¹SÈ%ÁZ0!ª³!cj0Hº]b,lZJ#¨Y7Vl@IFJ©;¯MJ6r%Y7\$Ç0jn{¦!;lÉ«b²\$8XfB(x»\$K!Z\$·°j|0hizirb*³em¯)ÍNu¥Ih*ÅJ7l%¬#Á¯IZ*TÅº.|m%dl(Z!9l3Ç1½%Î!Bdp°J·_¢i7~!It,´T%tuÎoÈ¿ef!,¯*·*JÍÉZ4_Q_l]BAqoi7.¦#~lR.ÀHRÉpS§ÉEg¤{·¾%%SG»%M!#.!Nlk!Au*k¯mÉ*¯J1Æ3¦#_JE¯)¾%XJ%ÆJ*l1Z,Ddy,Fl(ua¤6¸¤J¥J0x#gJD·2¿oÍ!DB¸OLUsÇPH´l1t!M\$3Ç1¿%Í!;|QrnU¦.ºo~l0p#j¯¡Ë6Bo;|J|!AtmÃ6~oi¿.|#¯l[55@m*m°Íu"Data "·zE7Fªm¥uGN%Êg,T\$ËnÎ¥Hp)®l5B(¦½ÍZ5³nq¢i|6vnAJ\$R!N!GÇ:¾oX|G¼!QmÁw6@\$Nl*N\$)KlªÀ¯Y¾k%N)*Xh·0@#CZ0.{ÊKZd¯«pPZ©mÎ¸J6¦%jm©¿Î´,DmnÎm¿mqÇI_,D°=t%¹lQJ:tjÌ°YJ{5,A,@|·¬k1t8Yo7yh2\$¬Ki|0*¾5N\$¿(Ç°eZ)1l0Z8x,É°dR4]zx:Â|*}#Vd)hÌ6Ã!RfÍ#YB\$Í§2|CÇ,§#FYEL~¦¿y¬\$r9[¦3ÁIÍ¯F¿NÍ°gd.bp(¯3(,Ìmf.3v\$¤7Dhl½KC7r]mI§8ÉJ~aiR¤D!ÂT%¼,}°S¿0¿\$A,ÍUz*J9l~QªÃJEpgD.a¿¡k70¿0drÂ!RJ6³o¤l5l%¶¯7¿»_iÍZCx)C6g·2L\$o!=Ë¤ÉK,Y7JllJG·JÇmbt4@«Íl;!ÈIt\$l*1oqt¤z){!7UPGeÅ¿D(,v¾k!5|#[;¾Î*Å#V·3PH¾7=J(4°Z¦.woV7G)!YlC£m¨%¹lF³kÄK=!tB!Î|Il*g#]º6¨o»¿OÉÃÃ¸q.,\$NJuE»*"Data "¸.jR1V!:Ã.t¸D.j!5x%´QE¿r)±0Z3ÇoÌJC_)K#[ÇWÈo¥Zp¾Zo@n%6Z%¸A§e,mhu·\$¿©0sGª*µ°j¿6foX7g9¢4F»;´X±8E:|QJ·G¦Ã9EË¿E.Pt4{:X0pi¿Î£\$Ç1\$d.ÁoÉZ6¿³%½cR6Tn½w%i!4°h¦5zm(J\$N(²¾t¾3Él½{a;*Ì°hd,Åc¤S¹i,_Is7(¦%Í|:¦X|Jc¦6X\$r¿¾SbÍ#aJ)@8Mp@Fl¡4kl3·A\$}yÎ,y°2¿mDnÉ!Îb!µah¦Ã|EÉ!8ÇÉ¬®(!0±«%sDÇ¸[T2R1@o·JD(,ËmjJ5N%·|Bª(k!\$|ÄÈ%¨l5ÃÂDthB4a7Æ!2n.dJXd!=©Í¯Eª\$DB,]!½l90°y,sKBÇV0p]f±Äov4i|1H«9}£{,*#O.À_¬Äl2¹Jrm±W77l]¯*zbÇ#[JÈ6!ËlI¦)½lB¢»P¹a!¥4![lUd!=EÍ7EN%D¦sB#¬m·JÈSbÈ°TtVK@r!AKc¹#EÇ6%lflºGd½K7Q79lb7FÃou¼h¦1(b\$K*_)tGfÂH¸:7¢5VfÁ#°n½¢om¯º5)"Data "Ë#id¯y·X!H³,Nm¬G¿j%ÉZ9t±Ft%J.¯oÅ|~v!,°ÇEÁI%K|Êw1=°L»¡k|#lN¶,(°pZ!¬m´Å_y.[JZ¿5@¦aJDËkM¤[¯)hÌ)Ê)Ë(ic]M6·nKl4m#t°kÇ25d5_3F,x#_¨!Ë\$Ìl;!(µ£]%6.\$**Lp!ÊJÁ²Gy%«J¨}*@¯,]!r#ªz~©)Nl¤¶6zn=Z1Nj¡¼hÇ.hÍ!!)»(¯~*¨6¿\$M|¢2K1J=Ç3~EµJ5F¿FR)J1Çoµ!:!*ÁKjp3Ë#7|K´Ê®mhl*zlo!GppD.dB)XN%!1.*:Ìk¦5N\$:7Ju[É#K·!V#®¿Î¸h¥mF7q,!8|97,Ì7jd2LmÌW.²#L°d·,«%{¯*R~@!F!4ÉK(ÆEJ%~dx¯)!oÎQ%u,mK#Ä5tÂ0}#|\$k°LFÀx%rl(³ºSJLZ5É°©AA_,È#PJ{l7f!N¤)3#Äy»·%±J3h!!uO¦6l\$:wM³!r#k!3r¸8O.JN9m;5{¿#¬@7l!8JK!k¤\$j||;;))H¦,9nY¯ÂÊJ]¯_¿6¿%_¯³Á.J!ft¿j¨.J³6,²ºpl!ÉlW¿)G!"Data "QJ=·,Í#VJ(h¥¹b8l.±\$§|9d\$FJÅh!r#|¿1|·)\$(|%±!(K!3#rJ.t!·lel:ª)O°G·%jÂE°(t\$ÊJJ·)¯lA¯AË,¡#¨Y9*m¬lCª*³#=p½¶{È¯G!)Fl¤¶6dn4l!¦_£mhB6±%±Z3_SGR(J%lmlZ5(\$DJÆ¾m3!Z¿Exw¾°Ql\$Ãb\$Z*V%cl%¯#·!QJ1ª#JJ¹yÆk%Ç¿2N!6J9Z1~%Ê%G3)o¯,X9f!L757(¯J3BPKpC!3¢¸%J,¯(Ámn¿2Z#lb!Ç!³!Y!7x%o¯*Çmw|0J*Ç\$!°E¿%B¢5(#;#ÆlSl2p\$c!*¿³)J,R(¹mo|3³#LJOl0M·8´%J\$ÁlJ|)¯!Y®Mb!]lAÇ,ÁmRZ)V\$¥#jZ0Ë_7N5FnIm*¦\$P#i¯7h%m!©±lam%½W}#¾l4Z]0(\$¯,¿N;KÆ´m@ldJGÃN:!(¯zw%Z!·*!ÄE¹f*l³º7%ÊJ2!´¤5pY¾6)B,ÊKYÇy¸94¿±z*ocpc)¦%Á¿3t!=¯,¿#N(W{Ip(33vd#l!0|Ê{K*l:¯)4ÀQ|¢wKÈÍcÇ5P#Ia#Ã!"Data "HJ\$|m4¡;Ã!¯g¼°(VpÍ!ae9Ç¸J.Fd(k\$SV.4!blZv0*¾5N#Z%·KiJ0LQk!H;,¯!tc²xnÀ¸9h¤%g@.6Á%sZUytÃ°hJ.Fg£N%¿)xkÆyuV#ÅlF7Ä3dL{.hjLN!d#s4kB4»l½I)´Ê®Kg¦(_f²¢*G!ÇXgB¬1}IJWr(3»,É*~}{J12L\$l2l4»oz¯ÂÊ¬µ¯eZ6]n2¯#»%¾#e¿)lh:;]rN®K8Ç¦llFÆCNi=JU·6loI¯B=.D!Y¿6B%SF:§\$»#eJ¹C¿p¬73¬xR%|.F7¬JZ©KÈÍc·57#:ºB#L,!¬²5¦!I;]¨*ÆKMZ#n7b7ÂÌ(~Ç79\$LoÊl;¦!tfBR5¿%|!%_!Ç¯gB5dm~5*)!·Jp23ËÃÇc7ª,aª#|%L%9»ÌEPE¯_z3NÀx³1Z,³#S¶l:ÉnZÇ]LHl¢w5r#yH)´Ê®Kgl(xV²(.G!:°k¯5~!I;]¨*Æ°LlÅ2(al2Í(~Ç7É#µÊ£¯Q%K.JBR5Á%¡J%_!ÄlgB5_m~H*y!a4kB*¿=#¿,B,³Z)ZmÀoplLÊOF¯¼O3rSJ¶1Z,"Data "³#S¶l:ÉnZÇ]LR¯GÌ3Ã!YybQKÈÍc·57#:ºB#L.!´¬5FkDN!.\$¥mil.hj5;4¿nIm;Hpd!©7It)1jnP*x%Ì7=»!3lF·5poU¯§MKvJDÁ3B¦Ç_AVjoJR7z©J²pJÃ!r#k.3rSJ¶1Z,³#S¶lQÂnZÇ]LLJS¬4xÃ5(#d\$8°6|¸¼À´«GJ\$P¤[\$p7lRYG»cit!l(]%Ê¯}*Kµ!AË0NÀK(%B)ÉmXB±k|(!4_ºS°*¦!¯mÅ!Ft\$Id3¹!dnÌ|Hª%IÇv!¤º%{Z^b*Vl[D8jl¶ZIÃ)¬Hµb)¦%Ál¢Ê.K¯[¿6.n½w.q!A°}¢0y·GJCt,5m9,n.!YlF_,sluax!}(¯ÇP,dI4vÆeoÉ|p)K´¯*Î0NÀK¢\$¯(ËKZJ·g]b!G³,Pm*¦!ªmÅ¿Ed\$Id31!.#=jBpÆHn.·4Ë%%QIÃ(«ÎV9\$d%Ì¿@ÇÉB©=¯5t%~½M³#¶ÇI7q0}#¿.J}½°HR#fp!|#³\$Ç¾»¥my=hZGZ,pJÆcx½|)|;6ÇjR.*5¹oiZxÉJ³¯*Î0NÀK;\$tLv°j%n;!dJGª,"Data "I#*|!¦#ÅlEB\$P¤3D!\$\$n=6ÇJ7Jdr[U#²³M;#²Kj72HºÁ31N,±mARIE#nt63¡zt%Ç,;IÈl;Ë\$dJ2R(9n¥SGp%{£0v!DnÇZG!\$D¦[]oBl©ËFh¤aR#7*p%É¯5ÇÉI·B¦°i\$Sh.a!Ålk¿3±f6_#|%ºmid0V!)Z4Z,¨#7B9@l37(33%²¯7\$ll.!=£!xJAd)LmO|.7\$rl;.*B0]Z2p%8XaJ¬ÌÌ0,D|Qr0pt\$x%cFMÆÀO°R¦\$ª¢Z7¯s%®È71!Vlx76Â,¾#d¦4t%nOG(({Ä0±!p\$CY,BPzR%l3ÍoÁ¿%{K)¯CJ5µobJu:.§J§O0HULN#J%ÍK_!¶ÈEglGx,0m(t!Å¨Ê¿DR*wm^J4p5}MÃ.G¤°TB%.!WJEd,»mfd5B6ÂJGl,Âsh·5¢oË¥IpSPlXZ¦mJ²;fO#²KhB.lh:_5V,Äm;Z]E},¯3¦pzªgR2T#7k(a!^#k¿M4:Q¢#7*Ê#Y|m¡|\$|37,·°:d²¼!¾7Ix%OiKÁ(³o¸7§ÍJ1!F|5v%V¦¦y)±°°UÅÌ%µ!._!"Data "\$KªºÉa|Î6l"`

Please use ISO-8859-1 or try UTF-8 format in the code editor otherwise base128 decode will probably fail.

2020-09-17: added blurry pixels and fixed issue with depth of sphere (text flew partly thru the sphere on the right side)
2020-09-22: changed from system font to bitmap for cooler look
Last edited by UEZ on Sep 23, 2020 6:51, edited 7 times in total.
dafhi
Posts: 1357
Joined: Jun 04, 2005 9:51

### Re: Around the Sphere build 2020-09-15

we like dots

Code: Select all

`'Coded by UEZ build 2020-09-15'Thanks to dodicat for some funtions I used from his code :-) and Martijn van Iersel for the CreateGradientSphere function. ^^/' --  modified by dafhi (2020 Sep 16) vec5 -> dotvarscol.argb -> colafter  screenres ..  windowtitle ..  particlesyou can adjust:  focal length, iris, iris z'/type imagevars '2017 Oct 10 - by dafhi  as integer            w,h,bpp,bypp,pitch,rate,  wm, hm, pitchBy 'helpers  as any ptr            im, pixels  as ulong ptr          p32  as string             driver_name  declare sub           get_info(im as any ptr=0)  declare               destructor  as single             midx, midy, diagonal '2017 Oct 10end typeDestructor.imagevars  If ImageInfo(im) = 0 Then ImageDestroy im:  im=0End Destructorsub imagevars.get_info(im as any ptr)  if im=0 then    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name    pixels=screenptr  elseif Imageinfo(im)=0 then    ImageInfo im, w, h, bypp, pitch, pixels    this.im = im:  bpp = bypp * 8  endif: wm=w-1: hm=h-1:  pitchBy=pitch\bypp:  p32=pixels  midx=w/2: midy=h/2:  diagonal = sqr(w*w+h*h)end sub#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26  ret=((_  (fore And &Hff00ff) * a256 + _  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_  (fore And &H00ff00) * a256 + _  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8#EndMacro#define flr(x)        (((x)*2.0-0.5)shr 1)type DotVars          '2017 Nov 15 - by dafhi  union    Type:  As UByte   b,g,r,a    End Type    As ULong          col  end union  as single           x,y,z  as single           rad = 1, slope = 2  as boolean          flagEnd Typetype tView3D  as single           iris  as single           iris_z '' point z tweak prior to calling defocus_drawEnd Type  namespace AaDot            '2020 Sep 17 - by dafhidim as tView3D        viedim as dotvars ptr    pdim as imagevars ptr  imsub render_target(byref buf as imagevars ptr):  im = bufend sub#define sng as singledim sng               dy,dxLeft,salpha,cone_h,coneSq,sq,salpha0,slopedim as long           x0,y0,x1,y1,alph,alpha_maxsub draw(x as single, y as single, col as ulong)  dim as long y0=(y-p->rad):  if y0<0 then y0=0  dim as long y1=(y+p->rad):  if y1>im->hm then y1=im->hm   if y1<y0 then exit sub '2017 Nov 10   salpha0=(col shr 24)/255:  alpha_max=salpha0*256  slope = p->slope   '' slope = 1 .. 1 pixel aa edge  '' slope = 2 .. 1/2 pixel (sharp)  '' slope = 1/p->rad .. max blur  '' slope < 1/p->rad .. rendering artifact   'sq=1/p->rad                   '' clamp prevents artifact  'slope=iif(slope<sq,sq,slope)  ''   cone_h=slope*(p->rad+.5)     'pre-inverted aadot imagined as cone \/  coneSq=cone_h*cone_h    'avoid sqr() at blit corners  sq=(cone_h-1)*(cone_h-1)'avoid sqr() in dot center at max brightness  dim as long x0=(x-p->rad):  if x0<0 then x0=0  dim as long x1=(x+p->rad):  if x1>im->wm then x1=im->wm  dy=(y0-y)*slope: dxLeft=(x0-x)*slope  for py as long ptr = @im->p32[ y0*im->pitchBy ] to @im->p32[ y1*im->pitchBy ] step im->pitchBy    dim as single dx=dxleft, dySq=dy*dy    for px as ulong ptr = @py[x0] to @py[x1]      salpha = dx*dx+dySq      if salpha<sq then          Alpha256(*px,*px,col,alpha_max)      elseif salpha<=coneSq then          alph=(cone_h-sqr(salpha))*alpha_max          Alpha256(*px,*px,col,alph)      endif:  dx+=slope    next: dy+=slope  nextend subdim sng               r_expandim as dotvars        qsub defocus_draw(byref pdv as dotvars ptr)  p = @q '' result -> q  with *pdv    r_expan = vie.iris * abs(.z)    q.rad = .rad + r_expan    q.slope = .slope / q.rad    q.col = .col    q.a = -.5 + 256 * .rad * .rad / (q.rad * q.rad)    draw .x, .y, q.col  End WithEnd Subend namespace'' --------------------------------#Include "fbgfx.bi"Using FB#Define Map(Val, source_start, source_stop, dest_start, dest_stop)   ((Val - source_start) * (dest_stop - dest_start) / (source_stop - source_start) + dest_start)#Define Max(a, b)   (Iif(a > b, a, b))Const w = 1200, h = 800, w2w = w Shl 1, w2 = w \ 2, h2 = h \ 2, pi = Acos(-1), pi2 = Acos(-1) / 2, radius = 350Const phi0 = 0.0, phi1 = pi, theta0 = 0.0, theta1 = 2.0 * pi, radians = pi / 180, deg = 180 / pi, cc1 = -270 * radians/'Union _Color   As Ulong argb   Type      As Ubyte b, g, r, a   End TypeEnd Union'/Type vec3   As Single x, y, zEnd TypeDim Shared As Const vec3 eyepoint = Type(w2, h2, h)/'Type vec5   As Boolean flag   As Single x, y, z   As _Color colEnd Type'/'Taylor series'Sum n = 0 to inf (-1)^n * x^(2n) / (2n)! = 1 - x^2 / 2! + x^4 / 4! -x^6 / 6! + ...Function Cos_(x As Single) As Single    If x < 0 Then x = -x    While x >= 3.141592653589793 'pi        x -= 6.283185307179586 '2 * pi    Wend   Dim As Single xx = x * x    Return 1.0 - (xx / 2) * (1 - (xx / 12) * (1 - (xx / 30) * (1 - xx / 56))) 'approximation of Taylor serieEnd FunctionFunction Sin_(x As Single) As Single    Return Cos_(x - 1.570796326794897) 'pi / 2End FunctionSub Object3Dto2D(wa() As dotvars, result() As dotvars, angle As vec3, centre As vec3, rad As Single = 1.0, flag As Boolean = True) 'by dodicat   Dim As Single dx,dy,dz,ww   Dim As Single SinAX=Sin_(angle.x)   Dim As Single SinAY=Sin_(angle.y)   Dim As Single SinAZ=Sin_(angle.z)   Dim As Single CosAX=Cos_(angle.x)   Dim As Single CosAY=Cos_(angle.y)   Dim As Single CosAZ=Cos_(angle.z)      For z As Uinteger=Lbound(wa) To Ubound(wa)      dx=wa(z).x-centre.x      dy=wa(z).y-centre.y      dz=wa(z).z-centre.z      Result(z).x=rad*((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x      result(z).y=rad*((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y      result(z).z=rad*((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z      If flag Then         ww = 1 + (result(z).z/eyepoint.z)         result(z).x = (result(z).x-eyepoint.x)/ww+eyepoint.x         result(z).y = (result(z).y-eyepoint.y)/ww+eyepoint.y         result(z).z = (result(z).z-eyepoint.z)/ww+eyepoint.z      Endif           result(z).col=wa(z).col      result(z).col=wa(z).col   Next zEnd SubSub QsortZ(array() As dotvars, begin As Integer, Finish As Uinteger) 'by dodicat    Dim As Integer i = begin, j = finish    Dim As dotvars X = array(((I + J) \ 2))    While I <= J        While array(I).z > X .z : I += 1 : Wend        While array(J).z < X .z : J -= 1 : Wend        If I <= J Then Swap array(I), array(J) : I += 1 : J -= 1   Wend   If J > begin Then QsortZ(array(), begin, J)   If I < Finish Then QsortZ(array(), I, Finish)End Sub'CreateGradientSphere function by Martijn van Iersel -> http://www.helixsoft.nl/articles/sphere/sphere.htmlFunction CreateGradientSphere(cx As Ushort, cy As Ushort, r As Ushort, lx As Single, ly As Single) As Any Ptr   Dim As Any Ptr pImage, imgData   Dim As Integer pitch   pImage = Imagecreate(r Shl 1, r Shl 1, 0, 32)   Imageinfo(pImage, , , , pitch, imgData)   #Define PixelSet(_x, _y, colour)              *Cptr(Ulong Ptr, imgData + (_y) * pitch + (_x) Shl 2) = (colour)   Dim As Single x, y, z, lightx, lighty, lightz, q_cos, light, c, c1 = Cos(ly)   lightx = Sin(lx) * c1   lighty = Sin(ly)   lightz = Cos(lx) * c1   For y = -r To r      q_cos = Cos(-Asin(y / r)) * r      For x = -q_cos To q_cos         z = Sqr(r * r - x * x - y * y)         c = (x / r * lightx + y / r * lighty + z / r * lightz)         light = Iif(c < 0, 0, c) * 255         Pset pImage, (Cshort(x) + cx, Cshort(y) + cy), Rgba(light / 3, light / 2, light, 255 - light)      Next   Next   Return pImageEnd FunctionScreenres w, h, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVESScreenSet 1, 0''  dim as imagevars  buf:  buf.get_info  aadot.render_target @bufDim As String sWintitle = "Around the Sphere coded by UEZ"Windowtitle(sWintitle)#Define PixelGet(_x, _y)                      *Cptr(Ulong Ptr, imgDataTxt + (_y) * pitchTxt + (_x) Shl 2)Dim As Any Ptr pImageTxt = Imagecreate(320, 20, 0, 32), imgDataTxt, pImageSphere = CreateGradientSphere(radius, radius, radius, -pi / 8, -pi / 4)Dim As Integer pitchTxtImageinfo(pImageTxt, , , , pitchTxt, imgDataTxt)  'earth mapDraw String pImageTxt, (0, 0), sWintitle, &hFFFFFFFFDim As Uinteger particles = 5000, i, ubDim As Single x, y, theta, rho, phi, f1, f2, CamRotX, CamRotY, CamRotZ, ang, z1, z2, px, py, pz, c1, zoom = 1Dim As Ulong iCol, iCounter = 0Dim As dotvars aParticles(particles - 1), aResult(particles - 1)Dim As Boolean b1 = False, b2 = False''  aadot.vie.iris_z = eyepoint.z * .99 '' added to z prior to defocus_draw  aadot.vie.iris = .002 * eyepoint.z / radiusDim As Ushort dimx = 0, dimy = 0For xx As Short = 0 To 319   For yy As Short = 0 To 19      If PixelGet(xx, yy) > 0 Then         If xx > dimx Then dimx = xx         If yy > dimy Then dimy = yy      End If   NextNext'Map string to sphere formFor xx As Short = dimx To 0 Step -1   For yy As Short = dimy To 0 Step -1      iCol = PixelGet(xx, yy)      If iCol > 0 Then         theta = Map(dimx - xx / 4, 0, dimx, theta1, theta0)         phi = Map(dimy / 2 + yy / 30, 0, dimy, phi0, phi1)         c1 = (radius + 1) * Sin_(phi)         px = c1 * Cos_(theta)         py = c1 * Sin_(theta)         pz = (radius + 1) * Cos_(phi)         aParticles(iCounter).x = w2 + px         aParticles(iCounter).y = h2 + py         aParticles(iCounter).z = pz         aParticles(iCounter).col = &hE0FFFFFF         iCounter += 1      End If   NextNext'blue sphere coordinateaParticles(iCounter).x = w2aParticles(iCounter).y = h2aParticles(iCounter).z = 0 '-radius'aParticles(iCounter).col = 0Redim Preserve aParticles(iCounter)Redim Preserve aResult(iCounter)ub = Ubound(aParticles)Imagedestroy(pImageTxt)Dim As Ulong iFPSDim As Uinteger cfps = 0Dim As Single fTimer = TimerDo   'Cls   Line (0, 0) - (w, h * 0.75), &hFF404040, BF   Line (0, h * 0.75 + 1) - (w, h), &hFF808080, BF   ang += .0033   Object3Dto2D(aParticles(), aResult(), Type<vec3>(cc1, 2 * ang, 0), Type<vec3>(w2, h2, 0), zoom)   Qsortz(aResult(), 0, ub)      For i = 0 To ub         'Pset (aResult(i).x, aResult(i).y), aResult(i).col.argb      'Circle (aResult(i).x, aResult(i).y), 1 - aResult(i).z / 800, aResult(i).col, , , , F      aResult(i).z += aadot.vie.iris_z      aadot.defocus_draw @aResult(i)      If aResult(i).col = 0 Then Put (w2 - radius, h2 - radius), pImageSphere, Alpha 'Circle (w2, h2), radius, &hA04040A0, , , , F   Next   Draw String(1, 1), iFPS & " fps", Rgb(&hFF, &hFF, &hFF)      Flip   cfps += 1   If Timer - fTimer > 0.99 Then      iFPS = cfps      cfps = 0      fTimer = Timer   End If   Sleep(10)Loop Until Len(Inkey())Imagedestroy(pImageSphere)`
Last edited by dafhi on Sep 17, 2020 4:19, edited 1 time in total.
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-15

@dafhi: I had the same idea after I finished this part to make the circles blurry according to their z value. ^^ Anyhow, thanks for your version - very smooth movement. :-)
dafhi
Posts: 1357
Joined: Jun 04, 2005 9:51

### Re: Around the Sphere build 2020-09-15

UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-17

Thanks you again dafhi for your contribution.

Meanwhile I finished also my depth of field simulation of the text pixels. imho, it's very simple but it looks nice, too (see 1st post).
dafhi
Posts: 1357
Joined: Jun 04, 2005 9:51

### Re: Around the Sphere build 2020-09-17

thanks for the inspiration!

didn't know my depth-of-field dots wanted to be worked on. also been overhauling my 3d system
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-22

Small update: added now a bitmap font with anti aliasing for a better look. If you are interested have a look to the first post.

The bitmap is integrated into the code which should be unpacked and saved to the disk.
Last edited by UEZ on Sep 22, 2020 12:27, edited 1 time in total.
Roland Chastain
Posts: 947
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: Around the Sphere build 2020-09-22

Hello! Unfortunately for me the program stops here:

Code: Select all

`If FileExists(sFile) = 0 Then  ' ...   If bError <> False Then      '? "Something went wrong"      'Sleep      End -1 ' <---   End If`
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-22

Roland Chastain wrote:Hello! Unfortunately for me the program stops here:

Code: Select all

`If FileExists(sFile) = 0 Then  ' ...   If bError <> False Then      '? "Something went wrong"      'Sleep      End -1 ' <---   End If`

The code editor must support UTF-8 format otherwise it will not decompress the base128 string properly.
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Around the Sphere build 2020-09-22

Hi UEZ.
Works great here and I use fbide.
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-22

dodicat wrote:Hi UEZ.
Works great here and I use fbide.

I'm not 100% sure if you must save the source code in UTF-8 format because it seems to run properly also with ANSI saved source code. Anyhow, I added a download link to the first post.

Btw, thank you for the functions I used in this code. :-)
Roland Chastain
Posts: 947
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: Around the Sphere build 2020-09-22

I use Geany and the encoding is UTF-8. Even with the file from the ZIP, it doesn't work for me. The program exits as soon as I start it. I am on Linux 64.
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-22

Roland Chastain wrote:I use Geany and the encoding is UTF-8. Even with the file from the ZIP, it doesn't work for me. The program exits as soon as I start it. I am on Linux 64.

What is the timestamp of the both files within the zip? I had accidentally uploaded a not working version first.

If it is not

Code: Select all

`22.09.2020  15:41            25.317 Around the Sphere.bas22.09.2020  15:42           186.368 Around the Sphere.exe`

I'm not on Linux, thus I cannot test.
Roland Chastain
Posts: 947
Joined: Nov 24, 2011 19:49
Location: France
Contact:

### Re: Around the Sphere build 2020-09-22

Thank you for your answer. I have the good file. When I have time, I will try to understand what happens. For the moment, I am on another project that I would like to finish.

By the way (I know this isn't my onions, as we say in french), but why don't you upload your files on FB Portal? Just a question. Feel free to ignore it. :)
UEZ
Posts: 624
Joined: May 05, 2017 19:59
Location: Germany

### Re: Around the Sphere build 2020-09-22

Roland Chastain wrote:By the way (I know this isn't my onions, as we say in french), but why don't you upload your files on FB Portal? Just a question. Feel free to ignore it. :)

I'm not aware that I can upload files to the (German?) FB Portal. All the better if I could.

### Who is online

Users browsing this forum: No registered users and 4 guests