Doom3-2D-Fake - von Triton

Diese kleine Demo ist ein Nachbau von 3D-Diagrammen aus dem Spiel Doom 3:



;*** Doom3 2D-Fake ;*** 8.10.2004, by Triton ;*** http://www.silizium-net.de/ Graphics 800,600,16,3 SetBuffer BackBuffer() SeedRnd MilliSecs() font1=LoadFont("verdana",32,1) font2=LoadFont("verdana",24,1) ;Dim balken(3,3) ;hier kann man manuell unterschiedliche Balkenverschiebungen eingeben ;For x = 1 To 3 ; For y = 1 To 3 ; balken(x,y)=Rand(0,180) ; Next ;Next Global originx = 370 Global originy = 400 time1 = MilliSecs() While Not KeyDown(1) loops = loops+1 If MilliSecs() - time1 > 1000 Then fps = loops:loops = 0:time1 = MilliSecs() a = a + 3 If a > 360 Then a=0 Color 100,123,157 ;Ganz außen Rect 0,0,800,600 Color 40,50,65 ;Mitte Rect 10,10,790,520 Color 70,86,112 ;Balkenbg Rect 400,100,340,400 Color 190,200,215 ;balkenrand Rect 400,100,340,400,0 Color 75,108,118 ;"fps"-balken Rect 0,540,800,10 Rect 690,550,200,40 filltri(650,550,690,550,690,590,75,108,118,75,108,118) SetFont font1 Color 168,171,181 Text 50,50, "F L U C T U A T I O N" Text 685,550, fps+" FPS" Color 68,71,90 Text 20,550, "S C I E N C E S T A T I O N - S C A N" Color Abs(Sin(a*5)*127+128),Abs(Sin(a*5)*100+100),Abs(Sin(a*5)*32+32) Text 50,450, "R E C O R D I N G" Color 78,81,91 Text 50,480,"D A T A S T R E A M" SetFont font2 For x = 3 To 1 Step -1 For y = 1 To 3 Step 1 h# = Abs(Sin(a+(x-2*y)*50)*100+100) ;höhe der Balken r=h/2+155 g=h*0.8 b=h*0.8 rgb=255*$1000000 + r*$10000 + 0*$100 + 0 filltri(xneu(x,y),yneu(x,y)-h,xneu(x+1,y),yneu(x+1,y)-h,xneu(x,y+1),yneu(x,y+1)-h,r,g,b,r,g,b) filltri(xneu(x+1,y+1),yneu(x+1,y+1)-h,xneu(x+1,y),yneu(x+1,y)-h,xneu(x,y+1),yneu(x,y+1)-h,r,g,b,r,g,b) filltri(xneu(x,y),yneu(x,y),xneu(x,y),yneu(x,y)-h,xneu(x,y+1),yneu(x,y+1),r*0.8,g*0.8,b*0.8,r*0.8,g*0.8,b*0.8) filltri(xneu(x,y+1),yneu(x,y+1)-h,xneu(x,y),yneu(x,y)-h,xneu(x,y+1),yneu(x,y+1),r*0.8,g*0.8,b*0.8,r*0.8,g*0.8,b*0.8) filltri(xneu(x,y+1),yneu(x,y+1),xneu(x,y+1),yneu(x,y+1)-h,xneu(x+1,y+1),yneu(x+1,y+1),r*0.6,g*0.6,b*0.6,r*0.6,g*0.6,b*0.6) filltri(xneu(x,y+1),yneu(x,y+1)-h,xneu(x+1,y+1),yneu(x+1,y+1),xneu(x+1,y+1),yneu(x+1,y+1)-h,r*0.6,g*0.6,b*0.6,r*0.6,g*0.6,b*0.6) Color 126,146,141 Text (x-1)*100+50, (y-1)*26+100, Int(h+23) Text (x-1)*100+50, (y-1)*26+180, r Text (x-1)*100+50, (y-1)*26+260, g Text (x-1)*100+50, (y-1)*26+340, b Text 350, 100, "H" Text 350, 180, "R" Text 350, 260, "G" Text 350, 340, "B" Next Next If KeyDown(1) Then End Flip Cls Wend ;--- Function xneu(x,y) Return (x*2+y*2)*20+originx End Function ;--- Function yneu(x,y) Return (y*2-x*2)/2*20+originy End Function ;--- Function filltri(x1,y1,x2,y2,x3,y3,r,g,b,borderr,borderg,borderb) For oft = 0 To 1 If x1 > x2 Then p=x2 x2=x1 x1=p q=y2 y2=y1 y1=q End If If x1 > x3 Then p=x3 x3=x1 x1=p q=y3 y3=y1 y1=q End If If x2 > x3 Then p=x3 x3=x2 x2=p q=y3 y3=y2 y2=q End If Next Color r,g,b For bx1# = x1 To x2 m13# = (Float(y3-y1)/(x3-x1)) n13# = -m13*x1+y1 by1# = m13*bx1+n13 m12# = (Float(y2-y1)/(x2-x1)) n12# = -m12*x1+y1 by2# = m12*bx1+n12 If by2-by1 > 0 Then Rect bx1,by1,1,by2-by1 If by2-by1 < 0 Then Rect bx1,by2,1,by1-by2 Next For bx2 = x2 To x3 m13# = (Float(y3-y1)/(x3-x1)) n13# = -m13*x3+y3 by3# = m13*bx2+n13 m23# = (Float(y3-y2)/(x3-x2)) n23# = -m23*x2+y2 by4# = m23*bx2+n23 If by4-by3 > 0 Then Rect bx2,by3,1,by4-by3 If by4-by3 < 0 Then Rect bx2,by4,1,by3-by4 Next Color borderr,borderg,borderb Line x1,y1,x2,y2 Line x1,y1,x3,y3 Line x2,y2,x3,y3 End Function