weeeee, alright, check it, does it work ok now? the change was in the rotateVertices, i made other little modifications, only because i love modding stuff :D You can spin the sphere with the Mouse! Try it, move mouse slow, also Press Q to make it bounce around the screen, press it again to stop it. You also forgot to put Setbuffer Backbuffer() so i added that, it smooth now, and doesn't flicker, I also made it screen res independent, so you can change the res to anything you want, and it will work just as perfectly, try it, 640, 480 :D
Before you start pressing Q and moving with the mouse and screen res changes, just give it a normal spin, hold Z X together, and you will see that it culls alot better, its not all blockly and ODD looking as before, How Did I Do It?
I have no freakin clue, i'm just a master of messing with stuff till it works, or i give up :P I know nothing of 3D programming, and have no clue to wtf is going on, although I wish I did, this is awesome. Great work, i noticed that your light source is Fixed to the sphere.
Before you start pressing Q and moving with the mouse and screen res changes, just give it a normal spin, hold Z X together, and you will see that it culls alot better, its not all blockly and ODD looking as before, How Did I Do It?
I have no freakin clue, i'm just a master of messing with stuff till it works, or i give up :P I know nothing of 3D programming, and have no clue to wtf is going on, although I wish I did, this is awesome. Great work, i noticed that your light source is Fixed to the sphere.
Open in online IDEDim polyhedre%(256, 256) Dim paintArray%(256, 2) ; Dim x#(16, 9) Dim y#(16, 9) Dim z#(16, 9) ; Dim rx#(16, 9) Dim ry#(16, 9) Dim rz#(16, 9) ; Dim nx#(16, 9) Dim ny#(16, 9) Dim nz#(16, 9) ; Dim rnx#(16, 9) Dim rny#(16, 9) Dim rnz#(16, 9) ; Global a# = 0.00 Global b# = 0.00 Global g# = 0.00 ; Global lx# = 1.00 Global ly# = 1.00 Global lz# = 1.00 Graphics 1024, 768, 16, 1 SetBuffer BackBuffer() ClsColor 255, 128, 64 For i% = 0 To 15 For j% = 0 To 8 r# = Sin#(22.50 * j%) x#(i%, j%) = Cos#(22.50 * i%) * r# y#(i%, j%) = Cos#(22.50 * j%) z#(i%, j%) = Sin#(22.50 * i%) * r# Next Next For i% = 0 To 15 For j% = 0 To 8 x0# = +x#(i%, j%) y0# = -y#(i%, j%) z0# = +z#(i%, j%) x1# = +x#((i% + 1) Mod 16, j%) y1# = -y#((i% + 1) Mod 16, j%) z1# = +z#((i% + 1) Mod 16, j%) x2# = +x#((i% + 1) Mod 16, (j% + 1) Mod 9) y2# = -y#((i% + 1) Mod 16, (j% + 1) Mod 9) z2# = +z#((i% + 1) Mod 16, (j% + 1) Mod 9) x3# = +x#(i%, (j% + 1) Mod 9) y3# = -y#(i%, (j% + 1) Mod 9) z3# = +z#(i%, (j% + 1) Mod 9) If Abs(x2# - x3#) < 0.001 Then dx1# = x2# - x0# dy1# = y2# - y0# dz1# = z2# - z0# dx2# = x2# - x1# dy2# = y2# - y1# dz2# = z2# - z1# Else dx1# = x3# - x1# dy1# = y3# - y1# dz1# = z3# - z1# dx2# = x3# - x2# dy2# = y3# - y2# dz2# = z3# - z2# EndIf nx#(i%, j%) = (dy1# * dz2#) - (dz1# * dy2#) ny#(i%, j%) = (dz1# * dx2#) - (dx1# * dz2#) nz#(i%, j%) = (dx1# * dy2#) - (dy1# * dx2#) l# = Sqr#((nx#(i%, j%) * nx#(i%, j%)) + (ny#(i%, j%) * ny#(i%, j%)) + (nz#(i%, j%) * nz#(i%, j%))) nx#(i%, j%) = nx#(i%, j%) / l# ny#(i%, j%) = ny#(i%, j%) / l# nz#(i%, j%) = nz#(i%, j%) / l# Next Next xdir = 5 ydir = 5 xres = GraphicsWidth() yres = GraphicsHeight() BounceX = xres/2 BounceY = yres/2 Repeat Cls() rotateVertices(a#, b#, g#) drawSphere(bounceX,bounceY) Flip() ;Mouse Control WOOHOO :D b# = b#-MouseXSpeed() Mod 360 a# = a#-MouseYSpeed() Mod 360 MoveMouse 512, 384 ;Make it Move! press Q If KeyHit(16) move = 1 - move If move Then bounceX = bounceX + xdir bounceY = bounceY + ydir If bounceX > xres Then xdir = -5 If bounceX < 0 Then xdir = 5 If bounceY > yres Then ydir = -5 If bounceY < 0 Then ydir = 5 End If If KeyDown(30) Then a# = a# + 1.00 While a# > 360.00 a# = a# - 360.00 Wend EndIf If KeyDown(44) Then a# = a# - 1.00 While a# < 0.00 a# = a# + 360.00 Wend EndIf If KeyDown(31) Then b# = b# + 1.00 While b# > 360.00 b# = b# - 360.00 Wend EndIf If KeyDown(45) Then b# = b# - 1.00 While b# < 0.00 b# = b# + 360.00 Wend EndIf If KeyDown(32) Then g# = g# + 1.00 While g# > 360.00 g# = g# - 360.00 Wend EndIf If KeyDown(46) Then g# = g# - 1.00 While g# < 0.00 g# = g# + 360.00 Wend EndIf If KeyDown(33) Then lx# = lx# - 0.03125 While lx# < 0.00 lx# = lx# + 1.00 Wend EndIf If KeyDown(47) Then lx# = lx# + 0.03125 While lx# > 1.00 lx# = lx# - 1.00 Wend EndIf If KeyDown(34) Then ly# = ly# - 0.03125 While ly# < 0.00 ly# = ly# + 1.00 Wend EndIf If KeyDown(48) Then ly# = ly# + 0.03125 While ly# > 1.00 ly# = ly# - 1.00 Wend EndIf If KeyDown(35) Then lz# = lz# - 0.03125 While lz# < 0.00 lz# = lz# + 1.00 Wend EndIf If KeyDown(49) Then lz# = lz# + 0.03125 While lz# > 1.00 lz# = lz# - 1.00 Wend EndIf Until KeyHit(1) End Function rotateVertices(alpha#, betha#, gamma#) For i% = 0 To 15 For j% = 0 To 8 ;Vertices xl0# = x#(i%, j%) yl0# = y#(i%, j%) zl0# = z#(i%, j%) xl1# = (Sin#(betha#) * zl0#) + (Cos#(betha#) * xl0#) yl1# = yl0# zl1# = (Cos#(betha#) * zl0#) - (Sin#(betha#) * xl0#) xl2# = xl1# yl2# = yl1# * Cos#(alpha#) - zl1# * Sin#(alpha#) zl2# = yl1# * Sin#(alpha#) + zl1# * Cos#(alpha#) rx#(i%, j%) = yl2# * Sin#(gamma#) + xl2# * Cos#(gamma#) ry#(i%, j%) = yl2# * Cos#(gamma#) - xl2# * Sin#(gamma#) rz#(i%, j%) = zl2# ;Normals xl0# = nx#(i%, j%) yl0# = ny#(i%, j%) zl0# = nz#(i%, j%) xl1# = zl0# * Sin#(betha#) + xl0# * Cos#(betha#) yl1# = yl0# zl1# = zl0# * Cos#(betha#) - xl0# * Sin#(betha#) xl2# = xl1# ;+ - is Oppisite of the Vertices - +, looks like it doesn't matter which is set with + - just as long as the other is oppisite of it - + ; Its this oppisite sign change that actually makes it work, put it back to the same as the other one ; - + and see how its messed up :P yl2# = yl1# * Cos#(alpha#) + zl1# * Sin#(alpha#) zl2# = yl1# * Sin#(alpha#) - zl1# * Cos#(alpha#) ;Main Change, Sign Change rnx#(i%, j%) = yl2# * Sin#(gamma#) + xl2# * Cos#(gamma#) rny#(i%, j%) = yl2# * Cos#(gamma#) - xl2# * Sin#(gamma#) rnz#(i%, j%) = zl2# Next Next End Function Function drawSphere(xloc, yloc) For i% = 0 To 15 For j% = 0 To 7 x0# = +rx#(i%, j%) * 100.00 + xloc ;512.00 y0# = -ry#(i%, j%) * 100.00 + yloc ;384.00 x1# = +rx#((i% + 1) Mod 16, j%) * 100.00 + xloc ;512.00 y1# = -ry#((i% + 1) Mod 16, j%) * 100.00 + yloc ;384.00 x2# = +rx#((i% + 1) Mod 16, (j% + 1) Mod 9) * 100.00 + xloc ;512.00 y2# = -ry#((i% + 1) Mod 16, (j% + 1) Mod 9) * 100.00 + yloc ;384.00 x3# = +rx#(i%, (j% + 1) Mod 9) * 100.00 + xloc ;512.00 y3# = -ry#(i%, (j% + 1) Mod 9) * 100.00 + yloc ;384.00 If rnz#(i%, j%) > 0.00 Then c% = (((rnx#(i%, j%) * lx#) + (rny#(i%, j%) * ly#) + (rnz#(i%, j%) * lz#)) / 1.00) * 255 If c% > 255 Then c% = 255 Else If c% < 15 Then c% = 15 EndIf EndIf c% = (c% Shl 16) paintTriangle(x0#, y0#, x1#, y1#, x3#, y3#, c%) paintTriangle(x1#, y1#, x2#, y2#, x3#, y3#, c%) EndIf Next Next End Function Function paintTriangle(x0#, y0#, x1#, y1#, x2#, y2#, c%) minx# = 9999 maxx# = 0 miny# = 9999 maxy# = 0 ; If x0# < minx# Then minx# = x0# If x0# > maxx# Then maxx# = x0# If x1# < minx# Then minx# = x1# If x1# > maxx# Then maxx# = x1# If x2# < minx# Then minx# = x2# If x2# > maxx# Then maxx# = x2# If y0# < miny# Then miny# = y0# If y0# > maxy# Then maxy# = y0# If y1# < miny# Then miny# = y1# If y1# > maxy# Then maxy# = y1# If y2# < miny# Then miny# = y2# If y2# > maxy# Then maxy# = y2# ; xsize# = maxx# - minx# ysize# = maxy# - miny# ; x0# = x0# - minx# x1# = x1# - minx# x2# = x2# - minx# y0# = y0# - miny# y1# = y1# - miny# y2# = y2# - miny# ; For i% = 0 To xsize# For j% = 0 To ysize# polyhedre%(i%, j%) = 0 Next Next ; drawBresenhamLine(x0#, y0#, x1#, y1#) drawBresenhamLine(x1#, y1#, x2#, y2#) drawBresenhamLine(x2#, y2#, x0#, y0#) ; For j% = 0 To ysize# For i% = 0 To xsize# If polyhedre%(i%, j%) Then paintArray%(j%, 0) = i% Exit EndIf Next For i% = xsize# To 0 Step -1 If polyhedre%(i%, j%) Then paintArray%(j%, 1) = i% Exit EndIf Next Next ; Color (c% Shr 16), (c% Shr 8) And 255, c% And 255 ; For i% = 0 To ySize# Line minx# + paintArray%(i%, 0), miny# + i%, minx# + paintArray%(i%, 1), miny# + i% Next End Function Function drawBresenhamLine(x0%, y0%, x1%, y1%) If x0% = x1% Then If y0% = y1% Then polyhedre%(x0%, y0%) = 1 Return EndIf If y0% < y1% Then For i% = y0% To y1% polyhedre%(x0%, i%) = 1 Next Return EndIf For i% = y1% To y0% polyhedre%(x0%, i%) = 1 Next Return EndIf If y0% = y1% Then If x0% < x1% Then For i% = x0% To x1% polyhedre%(i%, y0%) = 1 Next Return EndIf For i% = x1% To x0% polyhedre%(i%, y0%) = 1 Next Return EndIf If y1% < y0% Then temp% = y0% y0% = y1% y1% = temp% temp% = x0% x0% = x1% x1% = temp% EndIf dx% = x1% - x0% If dx% < 0 Then dx% = -dx% xinc% = -1 Else xinc% = 1 EndIf dy% = y1% - y0% If dy% < 0 Then dy% = -dy% yinc% = -1 Else yinc% = 1 EndIf two_dx% = dx% + dx% two_dy% = dy% + dy% xx% = x0% yy% = y0% If dx% > dy% Then error% = 0 For i% = 0 To dx% polyhedre%(xx%, yy%) = 1 xx% = xx% + xinc% error% = error% + two_dy% If error% > dx% Then error% = error% - two_dx% yy% = yy% + yinc% EndIf Next Else error% = 0 For i% = 0 To dy% polyhedre%(xx%, yy%) = 1 yy% = yy% + yinc% error% = error% + two_dx% If error% > dy% Then error% = error% - two_dy% xx% = xx% + xinc% EndIf Next EndIf End Function