Blitz2D 3D Engine - von Codemaster von CodeMaster |
Folgende 3D Engine beherrscht einfaches Shading und Textuierung. [code:1:a06480618e] Const Felder = 8 Global Raum#, Ampl, AmbientR, AmbientG, AmbientB, FogR, FogG, FogB, Fog#, Wireframe, Renderworld, Grayscale, MaxAbst, Poly, CurrentLight Dim Punkt(Felder,Felder,3) Dim Light(20,3) Global FPS_Ms, FPS_Ss, FPS_Frms, FPS_Tc, FPS FPS_Ms=MilliSecs(): FPS_Ss=0: FPS_Frms=0: FPS_Tc=0 ;############################################################################################ InitGraphics LoadAmbient "default" LoadMap "default" While Not KeyDown(1) Cls Render Color 255,0,0 Text 1,1,Str$(Poly) + " Polygone" Text 1,16,Str$(ShowFPS()) + " FPS (bei " + Str$(GraphicsWidth()) + "x" + Str$(GraphicsHeight()) + ")" Flip Wend End ;############################################################################################ Function InitGraphics() Graphics 640,480,32 SetBuffer BackBuffer() MaxAbst = Abst#(GraphicsWidth()/2,GraphicsHeight()/2,0,0) End Function Function LoadMap(MapName$) If Lower$(MapName$) = "default" Then SeedRnd MilliSecs() For y = 0 To Felder For x = 0 To Felder Punkt(x,y,1) = x * (GraphicsWidth() * 2 / Felder) Punkt(x,y,2) = y * (GraphicsHeight() * 2 / Felder) Punkt(x,y,3) = 50+Rand(Ampl);50+Sqr(x*y)/2 Next Next EndIf End Function Function LoadAmbient(AmbientName$) If Lower$(AmbientName$) = "default" Then Raum# = 50 Ampl = 32 AmbientR = 255 ;102 AmbientG = 110 ;85 AmbientB = 40 ;0 FogR = 0 FogG = 0 FogB = 0;155 Fog# = 1.5 Wireframe = 0;1 Renderworld = 1 Grayscale = 0 MaxAbst = Abst#(GraphicsWidth()/2,GraphicsHeight()/2,0,0) EndIf End Function Function SetLight(x,y,Col) Light(CurrentLight,1) = x Light(CurrentLight,2) = y Light(CurrentLight,3) = Col CurrentLight = CurrentLight + 1 End Function Function Render() Color FogR,FogG,FogB Rect 0,0,GraphicsWidth(),GraphicsHeight() Poly = 0 mx = MouseX() * 2 - GraphicsWidth() * 2 my = MouseY() * 2 - GraphicsHeight() * 2 For y = 0 To Felder-1 For x = 0 To Felder-1 x1 = Punkt(x,y,1) + mx y1 = Punkt(x,y,2) + my z1 = Punkt(x,y,3) x2 = Punkt(x+1,y,1) + mx y2 = Punkt(x+1,y,2) + my z2 = Punkt(x+1,y,3) x3 = Punkt(x+1,y+1,1) + mx y3 = Punkt(x+1,y+1,2) + my z3 = Punkt(x+1,y+1,3) x4 = Punkt(x,y+1,1) + mx y4 = Punkt(x,y+1,2) + my z4 = Punkt(x,y+1,3) ;If ((x2d(x3,z3) > 0) And (y2d(y3,z3) > 0)) Or ((x2d(x1,z1) < GraphicsWidth()) And (y2d(y1,z1) < GraphicsHeight()) Or ((x2d(x2,z2) > 0) And (y2d(y2,z2) > 0)) Or ((x2d(x4,z4) < GraphicsWidth()) And (y2d(y4,z4) < GraphicsHeight()))) Then If (x2d(x1,z1)) > 0 And (y2d(y1,z1) > 0) And (x2d(x1,z1) < GraphicsWidth()) And (y2d(y1,z1) < GraphicsHeight()) Then drawtri1 = 1 Else drawtri1 = 0 If (x2d(x2,z2)) > 0 And (y2d(y2,z2) > 0) And (x2d(x2,z2) < GraphicsWidth()) And (y2d(y2,z2) < GraphicsHeight()) Then drawtri2 = 1 Else drawtri2 = 0 If (x2d(x3,z3)) > 0 And (y2d(y3,z3) > 0) And (x2d(x3,z3) < GraphicsWidth()) And (y2d(y3,z3) < GraphicsHeight()) Then drawtri3 = 1 Else drawtri3 = 0 If (x2d(x4,z4)) > 0 And (y2d(y4,z4) > 0) And (x2d(x4,z4) < GraphicsWidth()) And (y2d(y4,z4) < GraphicsHeight()) Then drawtri4 = 1 Else drawtri4 = 0 If (drawtri1 + drawtri2 + drawtri3 + drawtri4) > 0 Then If Renderworld Then zcol1# = 1 - (z1 - 50 + Ampl / 2) / Ampl zcol2# = 1 - (z2 - 50 + Ampl / 2) / Ampl zcol3# = 1 - (z3 - 50 + Ampl / 2) / Ampl zcol4# = 1 - (z4 - 50 + Ampl / 2) / Ampl Fog1# = (1-Abst#(x2d(x1,z1),y2d(y1,z1),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) Fog2# = (1-Abst#(x2d(x2,z2),y2d(y2,z2),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) Fog3# = (1-Abst#(x2d(x3,z3),y2d(y3,z3),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) Fog4# = (1-Abst#(x2d(x4,z4),y2d(y4,z4),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) R1 = ((255-AmbientR)*zcol1#+AmbientR)*Fog1#+(FogR*(1-Fog1#)) G1 = ((255-AmbientG)*zcol1#+AmbientG)*Fog1#+(FogG*(1-Fog1#)) B1 = ((255-AmbientB)*zcol1#+AmbientB)*Fog1#+(FogB*(1-Fog1#)) R2 = ((255-AmbientR)*zcol2#+AmbientR)*Fog2#+(FogR*(1-Fog2#)) G2 = ((255-AmbientG)*zcol2#+AmbientG)*Fog2#+(FogG*(1-Fog2#)) B2 = ((255-AmbientB)*zcol2#+AmbientB)*Fog2#+(FogB*(1-Fog2#)) R3 = ((255-AmbientR)*zcol3#+AmbientR)*Fog3#+(FogR*(1-Fog3#)) G3 = ((255-AmbientG)*zcol3#+AmbientG)*Fog3#+(FogG*(1-Fog3#)) B3 = ((255-AmbientB)*zcol3#+AmbientB)*Fog3#+(FogB*(1-Fog3#)) R4 = ((255-AmbientR)*zcol4#+AmbientR)*Fog4#+(FogR*(1-Fog4#)) G4 = ((255-AmbientG)*zcol4#+AmbientG)*Fog4#+(FogG*(1-Fog4#)) B4 = ((255-AmbientB)*zcol4#+AmbientB)*Fog4#+(FogB*(1-Fog4#)) ;If x = Felder - 1 Then ; r2 = FogR ; g2 = FogG ; b2 = FogB ; r3 = FogR ; g3 = FogG ; b3 = FogB ;ElseIf x = 0 Then ; r1 = FogR ; g1 = FogG ; b1 = FogB ; r4 = FogR ; g4 = FogG ; b4 = FogB ;EndIf ;If y = Felder - 1 Then ; r3 = FogR ; g3 = FogG ; b3 = FogB ; r4 = FogR ; g4 = FogG ; b4 = FogB ;ElseIf y = 0 Then ; r1 = FogR ; g1 = FogG ; b1 = FogB ; r2 = FogR ; g2 = FogG ; b2 = FogB ;EndIf If R1 > 255 Then R1 = 255 If R1 < 0 Then R1 = 0 If G1 > 255 Then G1 = 255 If G1 < 0 Then G1 = 0 If B1 > 255 Then B1 = 0 If B1 < 0 Then B1 = 0 If R2 > 255 Then R2 = 255 If R2 < 0 Then R2 = 0 If G2 > 255 Then G2 = 255 If G2 < 0 Then G2 = 0 If B2 > 255 Then B2 = 0 If B2 < 0 Then B2 = 0 If R3 > 255 Then R3 = 255 If R3 < 0 Then R3 = 0 If G3 > 255 Then G3 = 255 If G3 < 0 Then G3 = 0 If B3 > 255 Then B3 = 0 If B3 < 0 Then B3 = 0 If R4 > 255 Then R4 = 255 If R4 < 0 Then R4 = 0 If G4 > 255 Then G4 = 255 If G4 < 0 Then G4 = 0 If B4 > 255 Then B4 = 0 If B4 < 0 Then B4 = 0 If Grayscale Then Fb1 = (R1 + G1 + B1) / 3 Fb2 = (R2 + G2 + B2) / 3 Fb3 = (R3 + G3 + B3) / 3 Fb4 = (R4 + G4 + B4) / 3 R1 = Fb1 G1 = Fb1 B1 = Fb1 R2 = Fb2 G2 = Fb2 B2 = Fb2 R3 = Fb3 G3 = Fb3 B3 = Fb3 R4 = Fb4 G4 = Fb4 B4 = Fb4 EndIf ;If (Not (r1 + r2 + r3) / 3 = FogR) And (Not (g1 + g2 + g3) / 3 = FogG) And (Not (b1 + b2 + b3) / 3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not (r1 + r4 + r3) / 3 = FogR) And (Not (g1 + g4 + g3) / 3 = FogG) And (Not (b1 + b4 + b3) / 3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not r1 = FogR) And (Not r2 = FogR) And (Not r3 = FogR) And (Not g1 = FogG) And (Not g2 = FogG) And (Not g3 = FogG) And (Not b1 = FogB) And (Not b2 = FogB) And (Not b3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not r1 = FogR) And (Not r4 = FogR) And (Not r3 = FogR) And (Not g1 = FogG) And (Not g4 = FogG) And (Not g3 = FogG) And (Not b1 = FogB) And (Not b4 = FogB) And (Not b3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (r1 + g1 + b1 + r2 + g2 + b2 + r3 + g3 + b3) / 9 > 0 Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (r1 + g1 + b1 + r4 + g4 + b4 + r3 + g3 + b3) / 9 > 0 Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 EndIf If Wireframe Then Color FogR,FogG,FogB If Not x = Felder Then Line3d(x1,y1,z1,x2,y2,z2) If Not y = Felder Then Line3d(x4,y4,z4,x1,y1,z1) If (Not x = Felder) And (Not y = Felder) Then Line3d(x1,y1,z1,x3,y3,z3) EndIf EndIf Next Next For i = 1 To 20 Light(i,1) = 0 Light(i,2) = 0 Light(i,3) = 0 Next CurrentLight = 0 End Function Function Line3d(x1,y1,z1,x2,y2,z2) xt1 = x2d(x1,z1) yt1 = y2d(y1,z1) xt2 = x2d(x2,z2) yt2 = y2d(y2,z2) Line xt1,yt1,xt2,yt2 End Function Function Plot3d(x,y,z) xt1 = x2d(x,z) yt1 = y2d(y,z) Plot xt1,yt1 End Function Function x2d(x,z) tmp = GraphicsWidth() / 2 + (x / (z / raum#)) Return tmp End Function Function y2d(y,z) tmp = GraphicsHeight() / 2 + (y / (z / raum#)) Return tmp End Function Function fillShadedTriangle(x1, y1, r1, g1, b1, x2, y2, r2, g2, b2, x3, y3, r3, g3, b3) Local varbuf Local xs1, xs2, xs3, xc, sy Local xd1, yd1, xd2, yd2, xd3, yd3 Local d1, d2, d3 Local sr, sg, sb, er, eg, eb, r, g, b, rslope, gslope, bslope Local ff = 0, i, sx, ex, esx, eex, c, dx, dy, dy2 Local mx = GraphicsWidth() - 1, my = GraphicsHeight() - 1 If y1 => y2 Then varbuf = y1: y1 = y2: y2 = varbuf varbuf = x1: x1 = x2: x2 = varbuf varbuf = r1: r1 = r2: r2 = varbuf varbuf = g1: g1 = g2: g2 = varbuf varbuf = b1: b1 = b2: b2 = varbuf End If If y1 > y3 Then varbuf = y1: y1 = y3: y3 = varbuf varbuf = x1: x1 = x3: x3 = varbuf varbuf = r1: r1 = r3: r3 = varbuf varbuf = g1: g1 = g3: g3 = varbuf varbuf = b1: b1 = b3: b3 = varbuf End If If y2 > y3 Then varbuf = y2: y2 = y3: y3 = varbuf varbuf = x2: x2 = x3: x3 = varbuf varbuf = r2: r2 = r3: r3 = varbuf varbuf = g2: g2 = g3: g3 = varbuf varbuf = b2: b2 = b3: b3 = varbuf End If If x1 > x2 Then xs1 = -1 Else xs1 = 1 xd1 = Abs(x1 - x2) yd1 = Abs(y1 - y2) If xd1 = 0 Then d1 = -1 Else d1 = 0 If x1 > x3 Then xs2 = -1 Else xs2 = 1 xd2 = Abs(x1 - x3) yd2 = Abs(y1 - y3) If xd2 = 0 Then d2 = -1 Else d2 = 0 If x2 > x3 Then xs3 = -1 Else xs3 = 1 xd3 = Abs(x2 - x3) yd3 = Abs(y2 - y3) If xd3 = 0 Then d3 = -1 Else d3 = 0 xc = x1 sy = y1 dy = y2 - y1 dy2 = y3 - y1 If y1 = y2 Then ff = 1 x1 = x2 dy = y3 - y2 End If If y1 = y3 Then Return LockBuffer While ff < 2 If y1 >= 0 And y1 <= my Then If ff = 0 Then sr = (r1 * (y2 - y1) + r2 * (y1 - sy)) / dy sg = (g1 * (y2 - y1) + g2 * (y1 - sy)) / dy sb = (b1 * (y2 - y1) + b2 * (y1 - sy)) / dy Else sr = (r2 * (y3 - y1) + r3 * (y1 - y2)) / dy sg = (g2 * (y3 - y1) + g3 * (y1 - y2)) / dy sb = (b2 * (y3 - y1) + b3 * (y1 - y2)) / dy End If er = (r1 * (y3 - y1) + r3 * (y1 - sy)) / dy2 eg = (g1 * (y3 - y1) + g3 * (y1 - sy)) / dy2 eb = (b1 * (y3 - y1) + b3 * (y1 - sy)) / dy2 If x1 > xc Then sx = xc: ex = x1 varbuf = sr: sr = er: er = varbuf varbuf = sg: sg = eg: eg = varbuf varbuf = sb: sb = eb: eb = varbuf Else sx = x1: ex = xc End If esx = sx eex = ex dx = ex - sx If dx > 0 Then If sx < 0 Then sx = 0 If ex > mx Then ex = mx If sx <= mx And ex >= 0 Then rslope = ((er - sr) Shl 8) / dx gslope = ((eg - sg) Shl 8) / dx bslope = ((eb - sb) Shl 8) / dx r = sr Shl 8 g = sg Shl 8 b = sb Shl 8 For i = esx To sx - 1 r = r + rslope g = g + gslope b = b + bslope Next For i = sx To ex rc = r Shr 8 gc = g Shr 8 bc = b Shr 8 WritePixelFast i, y1, (rc Shl 16) Or (gc Shl 8) Or bc r = r + rslope g = g + gslope b = b + bslope Next End If End If End If If ff = 0 Then If y1 = y2 Then ff = 1 x1 = x2 dy = y3 - y2 Else If d1 >= 0 Then x1 = x1 + (xs1 * (d1 / yd1) + xs1): d1 = (d1 Mod yd1) - yd1 If d1 < 0 Then d1 = d1 + xd1 End If End If If ff = 1 Then If y1 = y3 Then UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return Else If d3 >= 0 Then x1 = x1 + (xs3 * (d3 / yd3) + xs3): d3 = (d3 Mod yd3) - yd3 If d3 < 0 Then d3 = d3 + xd3 End If End If If d2 >= 0 Then xc = xc + (xs2 * (d2 / yd2) + xs2): d2 = (d2 Mod yd2) - yd2 If d2 < 0 Then d2 = d2 + xd2 y1 = y1 + 1 If y1 > my Then UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return End If Wend UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return End Function Function Abst#(x1,y1,x2,y2) tmp# = Sqr((x2-x1)^2+(y2-y1)^2) Return tmp# End Function Function ShowFPS() FPS_Ss=MilliSecs() FPS_Frms=FPS_Frms+1 If FPS_SS>FPS_Ms+1000 FPS_Ms=MilliSecs() FPS_Tc=FPS_Tc+1 FPS=FPS_Frms/FPS_Tc EndIf Return FPS End Function [/code:1:a06480618e] |
von CodeMaster / |
Hmm... Das ist eine alte Version meiner Engine. Hier mal die neue Version: [code:1:68aecdaa63]Const Felder = 12 Global MapPosX, MapPosY Global Raum#, Ampl, AmbientR, AmbientG, AmbientB, FogR, FogG, FogB, Fog#, EnableWireframe, Grayscale, MaxAbst, Poly, CurrentLight Dim Punkt(Felder,Felder,3) Dim Light(20,4) Global FPS_Ms, FPS_Ss, FPS_Frms, FPS_Tc, FPS FPS_Ms=MilliSecs(): FPS_Ss=0: FPS_Frms=0: FPS_Tc=0 ;############################################################################################ InitGraphics LoadAmbient "default" LoadMap "default" While Not KeyDown(1) Cls MapPosX = MouseX() * 2 - GraphicsWidth() * 2 MapPosY = MouseY() * 2 - GraphicsHeight() * 2 SetLight 100,100,$00FF00,200 SetLight GraphicsWidth()-100,100,$0000FF,200 Render RadarMap(GraphicsWidth()-75,GraphicsHeight()-75) Color 255,0,0 Text 1,1,Str$(Poly) + " Polygone" Text 1,16,Str$(ShowFPS()) + " FPS (bei " + Str$(GraphicsWidth()) + "x" + Str$(GraphicsHeight()) + ")" Flip Wend End ;############################################################################################ Function InitGraphics() Graphics 512,384,32 SetBuffer BackBuffer() MaxAbst = Abst#(GraphicsWidth()/2,GraphicsHeight()/2,0,0) End Function Function LoadMap(MapName$) If Lower$(MapName$) = "default" Then SeedRnd MilliSecs() For y = 0 To Felder For x = 0 To Felder Punkt(x,y,1) = x * (GraphicsWidth() * 2 / Felder) Punkt(x,y,2) = y * (GraphicsHeight() * 2 / Felder) Punkt(x,y,3) = 50+Rand(10)^2/4;50+Rand(Ampl);50+Sqr(x*y)/2 Next Next EndIf End Function Function LoadAmbient(AmbientName$) If Lower$(AmbientName$) = "default" Then Raum# = 60;80 Ampl = 25 AmbientR = 255 ;102 AmbientG = 110 ;85 AmbientB = 40 ;0 FogR = 0;255;0 FogG = 0;255;0 FogB = 0;255;0;155 Fog# = 1;.6 EnableWireframe = 0;1 Grayscale = 0 MaxAbst = Abst#(GraphicsWidth()/2,GraphicsHeight()/2,0,0) EndIf End Function Function SetLight(x,y,Col,Rad) Light(CurrentLight,1) = x Light(CurrentLight,2) = y Light(CurrentLight,3) = Col Light(CurrentLight,4) = Rad CurrentLight = CurrentLight + 1 End Function Function Render() Color FogR,FogG,FogB Rect 0,0,GraphicsWidth(),GraphicsHeight() Poly = 0 For y = 0 To Felder-1 For x = 0 To Felder-1 x1 = Punkt(x,y,1) + MapPosX y1 = Punkt(x,y,2) + MapPosY z1 = Punkt(x,y,3) x2 = Punkt(x+1,y,1) + MapPosX y2 = Punkt(x+1,y,2) + MapPosY z2 = Punkt(x+1,y,3) x3 = Punkt(x+1,y+1,1) + MapPosX y3 = Punkt(x+1,y+1,2) + MapPosY z3 = Punkt(x+1,y+1,3) x4 = Punkt(x,y+1,1) + MapPosX y4 = Punkt(x,y+1,2) + MapPosY z4 = Punkt(x,y+1,3) tx1 = x2d(x1,z1) ty1 = x2d(y1,z1) tx2 = x2d(x2,z2) ty2 = x2d(y2,z2) tx3 = x2d(x3,z3) ty3 = x2d(y3,z3) tx4 = x2d(x4,z4) ty4 = x2d(y4,z4) ;If ((x2d(x3,z3) > 0) And (y2d(y3,z3) > 0)) Or ((x2d(x1,z1) < GraphicsWidth()) And (y2d(y1,z1) < GraphicsHeight()) Or ((x2d(x2,z2) > 0) And (y2d(y2,z2) > 0)) Or ((x2d(x4,z4) < GraphicsWidth()) And (y2d(y4,z4) < GraphicsHeight()))) Then ;If (x2d(x1,z1)) > 0 And (y2d(y1,z1) > 0) And (x2d(x1,z1) < GraphicsWidth()) And (y2d(y1,z1) < GraphicsHeight()) Then drawtri1 = 1 Else drawtri1 = 0 ;If (x2d(x2,z2)) > 0 And (y2d(y2,z2) > 0) And (x2d(x2,z2) < GraphicsWidth()) And (y2d(y2,z2) < GraphicsHeight()) Then drawtri2 = 1 Else drawtri2 = 0 ;If (x2d(x3,z3)) > 0 And (y2d(y3,z3) > 0) And (x2d(x3,z3) < GraphicsWidth()) And (y2d(y3,z3) < GraphicsHeight()) Then drawtri3 = 1 Else drawtri3 = 0 ;If (x2d(x4,z4)) > 0 And (y2d(y4,z4) > 0) And (x2d(x4,z4) < GraphicsWidth()) And (y2d(y4,z4) < GraphicsHeight()) Then drawtri4 = 1 Else drawtri4 = 0 If (tx1 > 0) And (ty1 > 0) And (tx1 < GraphicsWidth()) And (ty1 < GraphicsHeight()) Then drawtri1 = 1 Else drawtri1 = 0 If (tx2 > 0) And (ty2 > 0) And (tx2 < GraphicsWidth()) And (ty2 < GraphicsHeight()) Then drawtri2 = 1 Else drawtri2 = 0 If (tx3 > 0) And (ty3 > 0) And (tx3 < GraphicsWidth()) And (ty3 < GraphicsHeight()) Then drawtri3 = 1 Else drawtri3 = 0 If (tx4 > 0) And (ty4 > 0) And (tx4 < GraphicsWidth()) And (ty4 < GraphicsHeight()) Then drawtri4 = 1 Else drawtri4 = 0 If (drawtri1 + drawtri2 + drawtri3 + drawtri4) > 0 Then zcol1# = 1 - (z1 - 50 + Ampl / 2) / Ampl / 1.25 zcol2# = 1 - (z2 - 50 + Ampl / 2) / Ampl / 1.25 zcol3# = 1 - (z3 - 50 + Ampl / 2) / Ampl / 1.25 zcol4# = 1 - (z4 - 50 + Ampl / 2) / Ampl / 1.25 ;Fog1# = (1-Abst#(x2d(x1,z1),y2d(y1,z1),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) ;Fog2# = (1-Abst#(x2d(x2,z2),y2d(y2,z2),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) ;Fog3# = (1-Abst#(x2d(x3,z3),y2d(y3,z3),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) ;Fog4# = (1-Abst#(x2d(x4,z4),y2d(y4,z4),GraphicsWidth()/2,GraphicsHeight()/2)*Fog/MaxAbst) If Fog# > 1 Then Fog# = 1 If Fog# < 0 Then Fog# = 0 Fog1# = (1-Abst#(tx1,ty1,GraphicsWidth()/2,GraphicsHeight()/2)*Fog#/MaxAbst);/1.5 Fog2# = (1-Abst#(tx2,ty2,GraphicsWidth()/2,GraphicsHeight()/2)*Fog#/MaxAbst);/1.5 Fog3# = (1-Abst#(tx3,ty3,GraphicsWidth()/2,GraphicsHeight()/2)*Fog#/MaxAbst);/1.5 Fog4# = (1-Abst#(tx4,ty4,GraphicsWidth()/2,GraphicsHeight()/2)*Fog#/MaxAbst);/1.5 If Fog1# > 1 Then Fog1# = 1 If Fog1# < 0 Then Fog1# = 0 If Fog2# > 1 Then Fog2# = 1 If Fog2# < 0 Then Fog2# = 0 If Fog3# > 1 Then Fog3# = 1 If Fog3# < 0 Then Fog3# = 0 If Fog4# > 1 Then Fog4# = 1 If Fog4# < 0 Then Fog4# = 0 ;R1 = AmbientR;((255-AmbientR)*zcol1#+AmbientR)*Fog1#+(FogR*(1-Fog1#)) ;G1 = AmbientG;((255-AmbientG)*zcol1#+AmbientG)*Fog1#+(FogG*(1-Fog1#)) ;B1 = AmbientB;((255-AmbientB)*zcol1#+AmbientB)*Fog1#+(FogB*(1-Fog1#)) ;R2 = AmbientR;((255-AmbientR)*zcol2#+AmbientR)*Fog2#+(FogR*(1-Fog2#)) ;G2 = AmbientG;((255-AmbientG)*zcol2#+AmbientG)*Fog2#+(FogG*(1-Fog2#)) ;B2 = AmbientB;((255-AmbientB)*zcol2#+AmbientB)*Fog2#+(FogB*(1-Fog2#)) ;R3 = AmbientR;((255-AmbientR)*zcol3#+AmbientR)*Fog3#+(FogR*(1-Fog3#)) ;G3 = AmbientG;((255-AmbientG)*zcol3#+AmbientG)*Fog3#+(FogG*(1-Fog3#)) ;B3 = AmbientB;((255-AmbientB)*zcol3#+AmbientB)*Fog3#+(FogB*(1-Fog3#)) ;R4 = AmbientR;((255-AmbientR)*zcol4#+AmbientR)*Fog4#+(FogR*(1-Fog4#)) ;G4 = AmbientG;((255-AmbientG)*zcol4#+AmbientG)*Fog4#+(FogG*(1-Fog4#)) ;B4 = AmbientB;((255-AmbientB)*zcol4#+AmbientB)*Fog4#+(FogB*(1-Fog4#)) R1 = AmbientR ;* zcol1# G1 = AmbientG ;* zcol1# B1 = AmbientB ;* zcol1# R2 = AmbientR ;* zcol2# G2 = AmbientG ;* zcol2# B2 = AmbientB ;* zcol2# R3 = AmbientR ;* zcol3# G3 = AmbientG ;* zcol3# B3 = AmbientB ;* zcol3# R4 = AmbientR ;* zcol4# G4 = AmbientG ;* zcol4# B4 = AmbientB ;* zcol4# For i = 0 To CurrentLight lx = Light(i,1) ly = Light(i,2) If (lx > 0) And (ly > 0) And (lx < GraphicsWidth()) And (ly < GraphicsHeight()) Then lcol = Light(i,3) lrad = Light(i,4) ab1# = Abst#(lx,ly,tx1,ty1) ab2# = Abst#(lx,ly,tx2,ty2) ab3# = Abst#(lx,ly,tx3,ty3) ab4# = Abst#(lx,ly,tx4,ty4) If ab1 < lrad Then R1 = (R1 * (ab1 / lrad) + (lcol And $FF0000) / $10000 * (1 - (ab1 / lrad))); * zcol1# G1 = (G1 * (ab1 / lrad) + (lcol And $FF00) / $100 * (1 - (ab1 / lrad))); * zcol1# B1 = (B1 * (ab1 / lrad) + (lcol And $FF) * (1 - (ab1 / lrad))); * zcol1# EndIf If ab2 < lrad Then R2 = (R2 * (ab2 / lrad) + (lcol And $FF0000) / $10000 * (1 - (ab2 / lrad))); * zcol2# G2 = (G2 * (ab2 / lrad) + (lcol And $FF00) / $100 * (1 - (ab2 / lrad))); * zcol2# B2 = (B2 * (ab2 / lrad) + (lcol And $FF) * (1 - (ab2 / lrad))); * zcol2# EndIf If ab3 < lrad Then R3 = (R3 * (ab3 / lrad) + (lcol And $FF0000) / $10000 * (1 - (ab3 / lrad))); * zcol3# G3 = (G3 * (ab3 / lrad) + (lcol And $FF00) / $100 * (1 - (ab3 / lrad))); * zcol3# B3 = (B3 * (ab3 / lrad) + (lcol And $FF) * (1 - (ab3 / lrad))); * zcol3# EndIf If ab4 < lrad Then R4 = (R4 * (ab4 / lrad) + (lcol And $FF0000) / $10000 * (1 - (ab4 / lrad))); * zcol4# G4 = (G4 * (ab4 / lrad) + (lcol And $FF00) / $100 * (1 - (ab4 / lrad))); * zcol4# B4 = (B4 * (ab4 / lrad) + (lcol And $FF) * (1 - (ab4 / lrad))); * zcol4# EndIf EndIf Next R1 = (R1 * zcol1#) * Fog1# + FogR * (1 - Fog1#) G1 = (G1 * zcol1#) * Fog1# + FogG * (1 - Fog1#) B1 = (B1 * zcol1#) * Fog1# + FogB * (1 - Fog1#) R2 = (R2 * zcol2#) * Fog2# + FogR * (1 - Fog2#) G2 = (G2 * zcol2#) * Fog2# + FogG * (1 - Fog2#) B2 = (B2 * zcol2#) * Fog2# + FogB * (1 - Fog2#) R3 = (R3 * zcol3#) * Fog3# + FogR * (1 - Fog3#) G3 = (G3 * zcol3#) * Fog3# + FogG * (1 - Fog3#) B3 = (B3 * zcol3#) * Fog3# + FogB * (1 - Fog3#) R4 = (R4 * zcol4#) * Fog4# + FogR * (1 - Fog4#) G4 = (G4 * zcol4#) * Fog4# + FogG * (1 - Fog4#) B4 = (B4 * zcol4#) * Fog4# + FogB * (1 - Fog4#) ;R2 = R2 * zcol2# ;G2 = G2 * zcol2# ;B2 = B2 * zcol2# ;R3 = R3 * zcol3# ;G3 = G3 * zcol3# ;B3 = B3 * zcol3# ;R4 = R4 * zcol4# ;G4 = G4 * zcol4# ;B4 = B4 * zcol4# ;If x = Felder - 1 Then ; r2 = FogR ; g2 = FogG ; b2 = FogB ; r3 = FogR ; g3 = FogG ; b3 = FogB ;ElseIf x = 0 Then ; r1 = FogR ; g1 = FogG ; b1 = FogB ; r4 = FogR ; g4 = FogG ; b4 = FogB ;EndIf ;If y = Felder - 1 Then ; r3 = FogR ; g3 = FogG ; b3 = FogB ; r4 = FogR ; g4 = FogG ; b4 = FogB ;ElseIf y = 0 Then ; r1 = FogR ; g1 = FogG ; b1 = FogB ; r2 = FogR ; g2 = FogG ; b2 = FogB ;EndIf If R1 > 255 Then R1 = 255 If R1 < 0 Then R1 = 0 If G1 > 255 Then G1 = 255 If G1 < 0 Then G1 = 0 If B1 > 255 Then B1 = 0 If B1 < 0 Then B1 = 0 If R2 > 255 Then R2 = 255 If R2 < 0 Then R2 = 0 If G2 > 255 Then G2 = 255 If G2 < 0 Then G2 = 0 If B2 > 255 Then B2 = 0 If B2 < 0 Then B2 = 0 If R3 > 255 Then R3 = 255 If R3 < 0 Then R3 = 0 If G3 > 255 Then G3 = 255 If G3 < 0 Then G3 = 0 If B3 > 255 Then B3 = 0 If B3 < 0 Then B3 = 0 If R4 > 255 Then R4 = 255 If R4 < 0 Then R4 = 0 If G4 > 255 Then G4 = 255 If G4 < 0 Then G4 = 0 If B4 > 255 Then B4 = 0 If B4 < 0 Then B4 = 0 If Grayscale Then Fb1 = (R1 + G1 + B1) / 3 Fb2 = (R2 + G2 + B2) / 3 Fb3 = (R3 + G3 + B3) / 3 Fb4 = (R4 + G4 + B4) / 3 R1 = Fb1 G1 = Fb1 B1 = Fb1 R2 = Fb2 G2 = Fb2 B2 = Fb2 R3 = Fb3 G3 = Fb3 B3 = Fb3 R4 = Fb4 G4 = Fb4 B4 = Fb4 EndIf ;If (Not (r1 + r2 + r3) / 3 = FogR) And (Not (g1 + g2 + g3) / 3 = FogG) And (Not (b1 + b2 + b3) / 3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not (r1 + r4 + r3) / 3 = FogR) And (Not (g1 + g4 + g3) / 3 = FogG) And (Not (b1 + b4 + b3) / 3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not r1 = FogR) And (Not r2 = FogR) And (Not r3 = FogR) And (Not g1 = FogG) And (Not g2 = FogG) And (Not g3 = FogG) And (Not b1 = FogB) And (Not b2 = FogB) And (Not b3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (Not r1 = FogR) And (Not r4 = FogR) And (Not r3 = FogR) And (Not g1 = FogG) And (Not g4 = FogG) And (Not g3 = FogG) And (Not b1 = FogB) And (Not b4 = FogB) And (Not b3 = FogB) Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (r1 + g1 + b1 + r2 + g2 + b2 + r3 + g3 + b3) / 9 > 0 Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;If (r1 + g1 + b1 + r4 + g4 + b4 + r3 + g3 + b3) / 9 > 0 Then fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x2,z2),y2d(y2,z2),R2,G2,B2,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 ;fillshadedTriangle(x2d(x1,z1),y2d(y1,z1),R1,G1,B1,x2d(x4,z4),y2d(y4,z4),R4,G4,B4,x2d(x3,z3),y2d(y3,z3),R3,G3,B3): Poly = Poly + 1 Cols = 0 If (R1-FogR <> 0) Or (G1-FogG <> 0) Or (B1-FogG <> 0) Then Cols = Cols + 1 If (R2-FogR <> 0) Or (G2-FogG <> 0) Or (B2-FogG <> 0) Then Cols = Cols + 1 If (R3-FogR <> 0) Or (G3-FogG <> 0) Or (B3-FogG <> 0) Then Cols = Cols + 1 If (R4-FogR <> 0) Or (G4-FogG <> 0) Or (B4-FogG <> 0) Then Cols = Cols + 1 If Cols > 0 Then fillshadedTriangle(tx1,ty1,R1,G1,B1,tx2,ty2,R2,G2,B2,tx3,ty3,R3,G3,B3): Poly = Poly + 1 fillshadedTriangle(tx1,ty1,R1,G1,B1,tx4,ty4,R4,G4,B4,tx3,ty3,R3,G3,B3): Poly = Poly + 1 EndIf EndIf If EnableWireframe Then Color FogR,FogG,FogB If Not x = Felder Then Line tx1,ty1,tx2,ty2;Line3d(x1,y1,z1,x2,y2,z2) If Not y = Felder Then Line tx4,ty4,tx1,ty1;Line3d(x4,y4,z4,x1,y1,z1) If (Not x = Felder) And (Not y = Felder) Then Line tx1,ty1,tx3,ty3;Line3d(x1,y1,z1,x3,y3,z3) EndIf Next Next For i = 1 To 20 Light(i,1) = 0 Light(i,2) = 0 Light(i,3) = 0 Light(i,4) = 0 Next CurrentLight = 0 End Function Function RadarMap(x1,y1) Radius = 75 RadarZoom# = 1.5 For y = 0 To Felder-1 For x = 0 To Felder-1 tx1# = x2d(Punkt(x,y,1)+MapPosX,Punkt(x,y,3)/RadarZoom)/10+x1-Radius/4 ty1# = y2d(Punkt(x,y,2)+MapPosY,Punkt(x,y,3)/RadarZoom)/10+y1-Radius/2 at1# = Abst#(x1,y1,tx1,ty1) If at1# <= Radius Then tx2# = x2d(Punkt(x+1,y,1)+MapPosX,Punkt(x+1,y,3)/RadarZoom)/10+x1-Radius/4 ty2# = y2d(Punkt(x+1,y,2)+MapPosY,Punkt(x+1,y,3)/RadarZoom)/10+y1-Radius/2 tx3# = x2d(Punkt(x,y+1,1)+MapPosX,Punkt(x,y+1,3)/RadarZoom)/10+x1-Radius/4 ty3# = y2d(Punkt(x,y+1,2)+MapPosY,Punkt(x,y+1,3)/RadarZoom)/10+y1-Radius/2 at2# = Abst#(x1,y1,tx2,ty2) at3# = Abst#(x1,y1,tx3,ty3) If at2# <= Radius Then it# = at2# / Radius If it# > 0 Then Color 0,(1-it#)*255,0 Line tx1,ty1,tx2,ty2 EndIf EndIf If at3# <= Radius Then it# = at3# / Radius If it# > 0 Then Color 0,(1-it#)*255,0 Line tx1,ty1,tx3,ty3 EndIf EndIf EndIf Next Next End Function Function Line3d(x1,y1,z1,x2,y2,z2) xt1 = x2d(x1,z1) yt1 = y2d(y1,z1) xt2 = x2d(x2,z2) yt2 = y2d(y2,z2) Line xt1,yt1,xt2,yt2 End Function Function Plot3d(x,y,z) xt1 = x2d(x,z) yt1 = y2d(y,z) Plot xt1,yt1 End Function Function x2d(x,z) tmp = GraphicsWidth() / 2 + (x / (z / raum#)) Return tmp End Function Function y2d(y,z) tmp = GraphicsHeight() / 2 + (y / (z / raum#)) Return tmp End Function Function fillShadedTriangle(x1, y1, r1, g1, b1, x2, y2, r2, g2, b2, x3, y3, r3, g3, b3) Local varbuf Local xs1, xs2, xs3, xc, sy Local xd1, yd1, xd2, yd2, xd3, yd3 Local d1, d2, d3 Local sr, sg, sb, er, eg, eb, r, g, b, rslope, gslope, bslope Local ff = 0, i, sx, ex, esx, eex, c, dx, dy, dy2 Local mx = GraphicsWidth() - 1, my = GraphicsHeight() - 1 If y1 => y2 Then varbuf = y1: y1 = y2: y2 = varbuf varbuf = x1: x1 = x2: x2 = varbuf varbuf = r1: r1 = r2: r2 = varbuf varbuf = g1: g1 = g2: g2 = varbuf varbuf = b1: b1 = b2: b2 = varbuf End If If y1 > y3 Then varbuf = y1: y1 = y3: y3 = varbuf varbuf = x1: x1 = x3: x3 = varbuf varbuf = r1: r1 = r3: r3 = varbuf varbuf = g1: g1 = g3: g3 = varbuf varbuf = b1: b1 = b3: b3 = varbuf End If If y2 > y3 Then varbuf = y2: y2 = y3: y3 = varbuf varbuf = x2: x2 = x3: x3 = varbuf varbuf = r2: r2 = r3: r3 = varbuf varbuf = g2: g2 = g3: g3 = varbuf varbuf = b2: b2 = b3: b3 = varbuf End If If x1 > x2 Then xs1 = -1 Else xs1 = 1 xd1 = Abs(x1 - x2) yd1 = Abs(y1 - y2) If xd1 = 0 Then d1 = -1 Else d1 = 0 If x1 > x3 Then xs2 = -1 Else xs2 = 1 xd2 = Abs(x1 - x3) yd2 = Abs(y1 - y3) If xd2 = 0 Then d2 = -1 Else d2 = 0 If x2 > x3 Then xs3 = -1 Else xs3 = 1 xd3 = Abs(x2 - x3) yd3 = Abs(y2 - y3) If xd3 = 0 Then d3 = -1 Else d3 = 0 xc = x1 sy = y1 dy = y2 - y1 dy2 = y3 - y1 If y1 = y2 Then ff = 1 x1 = x2 dy = y3 - y2 End If If y1 = y3 Then Return LockBuffer While ff < 2 If y1 >= 0 And y1 <= my Then If ff = 0 Then sr = (r1 * (y2 - y1) + r2 * (y1 - sy)) / dy sg = (g1 * (y2 - y1) + g2 * (y1 - sy)) / dy sb = (b1 * (y2 - y1) + b2 * (y1 - sy)) / dy Else sr = (r2 * (y3 - y1) + r3 * (y1 - y2)) / dy sg = (g2 * (y3 - y1) + g3 * (y1 - y2)) / dy sb = (b2 * (y3 - y1) + b3 * (y1 - y2)) / dy End If er = (r1 * (y3 - y1) + r3 * (y1 - sy)) / dy2 eg = (g1 * (y3 - y1) + g3 * (y1 - sy)) / dy2 eb = (b1 * (y3 - y1) + b3 * (y1 - sy)) / dy2 If x1 > xc Then sx = xc: ex = x1 varbuf = sr: sr = er: er = varbuf varbuf = sg: sg = eg: eg = varbuf varbuf = sb: sb = eb: eb = varbuf Else sx = x1: ex = xc End If esx = sx eex = ex dx = ex - sx If dx > 0 Then If sx < 0 Then sx = 0 If ex > mx Then ex = mx If sx <= mx And ex >= 0 Then rslope = ((er - sr) Shl 8) / dx gslope = ((eg - sg) Shl 8) / dx bslope = ((eb - sb) Shl 8) / dx r = sr Shl 8 g = sg Shl 8 b = sb Shl 8 For i = esx To sx - 1 r = r + rslope g = g + gslope b = b + bslope Next For i = sx To ex rc = r Shr 8 gc = g Shr 8 bc = b Shr 8 WritePixelFast i, y1, (rc Shl 16) Or (gc Shl 8) Or bc r = r + rslope g = g + gslope b = b + bslope Next End If End If End If If ff = 0 Then If y1 = y2 Then ff = 1 x1 = x2 dy = y3 - y2 Else If d1 >= 0 Then x1 = x1 + (xs1 * (d1 / yd1) + xs1): d1 = (d1 Mod yd1) - yd1 If d1 < 0 Then d1 = d1 + xd1 End If End If If ff = 1 Then If y1 = y3 Then UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return Else If d3 >= 0 Then x1 = x1 + (xs3 * (d3 / yd3) + xs3): d3 = (d3 Mod yd3) - yd3 If d3 < 0 Then d3 = d3 + xd3 End If End If If d2 >= 0 Then xc = xc + (xs2 * (d2 / yd2) + xs2): d2 = (d2 Mod yd2) - yd2 If d2 < 0 Then d2 = d2 + xd2 y1 = y1 + 1 If y1 > my Then UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return End If Wend UnlockBuffer If fade = -1 Then UnlockBuffer buffer Return End Function Function Abst#(x1,y1,x2,y2) tmp# = Sqr((x2-x1)^2+(y2-y1)^2) Return tmp# End Function Function ShowFPS() FPS_Ss=MilliSecs() FPS_Frms=FPS_Frms+1 If FPS_SS>FPS_Ms+1000 FPS_Ms=MilliSecs() FPS_Tc=FPS_Tc+1 FPS=FPS_Frms/FPS_Tc EndIf Return FPS End Function[/code:1:68aecdaa63] Die neue Version erzeugt im Gegensatz zur alten Version realistischen, volumetrisch aussehenden Nebel (natürlich einstellbar) und man kann Lightingpoints setzen, deren Farbe und Position natürlich selber definierbar ist. Have Phun, CodeMaster |
hi von ??? |
sehr sehr viel code... aber leider keine tabulation drin :(. Das macht den code unlesbar.. |
von ??? |
Ich weiß, aber da ich einmal meinen Code von der Festplatte verloren hatte und anschließend den gesamten Script hier aus dem Forum wieder rauskopieren musste, sind alle Tabs verschwunden, und ich habe mir bisher nicht die Mühe gemacht, wieder welche reinzumachen. Könnte ich aber demnächst trotzdem mal tun... |