Blitz CodeCompo #12 - GrafikDemoDingsda
Übersicht Sonstiges ProjekteGehe zu Seite Zurück 1, 2, 3, 4 Weiter
Eingeproggt |
Sa, Dez 08, 2007 16:08 Antworten mit Zitat |
|
---|---|---|
Die Ideen sind bis jetzt alle gut (außer meiner mal wieder )
Aber ist es nicht Sinn einer Code-Compo, mit dem Code teilzunehmen? mfG, Christoph. |
||
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9 |
Artemis |
Sa, Dez 08, 2007 16:45 Antworten mit Zitat |
|
---|---|---|
Und jetzt überleg mal, warum die Leute ihre Codes noch nicht jetzt posten.
Richtig, damit keiner abguckt. |
||
SpionAtom |
Sa, Dez 08, 2007 17:06 Antworten mit Zitat |
|
---|---|---|
Ich hab kein Problem damit, den Code zu posten. Der ist sowas von unlesbar, da kann eh niemand abgucken.
Leider kein TFormfilter mehr drin, und einige Texte sind leicht verkürzt. Aber es sind genau 4096 Bytes! <Inselrutsche> <Inselrutsche kompiliert> |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
- Zuletzt bearbeitet von SpionAtom am Fr, Dez 14, 2007 13:52, insgesamt einmal bearbeitet
Eingeproggt |
Sa, Dez 08, 2007 17:06 Antworten mit Zitat |
|
---|---|---|
Wenn man abguckt, sind hoffentlich alle User so intelligent, dies zu bemerken. Also wenn ich jetzt einen Code poste und jemand so ungefähr dasselbe 2 Wochen später bringt, dann hat er entweder meine Idee oder Code geklaut. Oder er hat einfach nur das Pech, dieselbe Idee zu haben, nur dass er sie später umgesetzt hat.
In diesem Sinne verstecke ich mich nicht und präsentiere meine vorläufige final-Version. Dieser Code erzeugt eine kleine Animation in 2D. Die Enstehungsschritte dieser Ani werden in Echtzeit angezeigt, damits was zu sehen gibt Da ich so viel Platz hatte im Code, ist er halbwegs übersichtlich und ein bisschen kommentiert. Der ReadPixelFast Fehler meiner alten Version ist denke ich mal behoben. Der ganze Code ist in eine Funktion gepackt, an die verschiedene Parameter übergeben werden können. (Durch den Coder, nicht durch den Benutzer, wie von den Regeln festgelegt) Beim herumspielen mit den Parametern bitte berücksichtigen, dass die Wurzel aus "frames" mal der Seitenlänge eines Frames nicht größer als die Bildschirmauflösung wird! Code: [AUSKLAPPEN] Global g_s,g_frames
Global aktx,akty Global i,j ;image=kreisani(Frame-Seitenlänge,Frames,Farbe1-Rot,Farbe1-Grün,Farbe1-Blau,Farbe2-Rot-Farbe2-Grün,Farbe2-Blau) ;frames nur Quadrate!! Also 4,9,16,25,36,... Local img=kreisani(70,49,0,0,0,200,0,0) ;Präsentation des erzeugten Images Local istep=1 AppTitle("ESC=Beenden") i=0 Repeat i=(i+istep) If i>g_frames-2 Or i<1 Then istep=-istep For j=0 To g_frames-1 aktx=(j Mod Ceil(Sqr(g_frames)))*g_s akty=Floor(j/Ceil(Sqr(g_frames)))*g_s DrawBlockRect(img,aktx,akty,(i Mod Ceil(Sqr(g_frames)))*g_s,Floor(i/Ceil(Sqr(g_frames)))*g_s,g_s,g_s) Next Flip 0 : Cls Delay (1000/(g_frames*4)) ;Wartezeit auf Frames anpassen Until KeyHit(1) End Function kreisani(s,frames,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b) ;Initialisierung g_frames=frames : g_s=s AppTitle "ESC=Abbrechen" Local wh=Ceil(Sqr(frames))*s Local col,img Local aktr Local range=2 Local faktor=(range*2+1)^2 Local y,x,r,g,b,dx,dy Graphics wh,wh,0,2 SetBuffer BackBuffer() ;Hintergrund Color col2_r,col2_g,col2_b Rect 0,0,wh,wh For j=0 To frames-1 ;Für den aktuellen Frame vorbereiten aktx=(j Mod Ceil(Sqr(frames)))*s akty=Floor(j/Ceil(Sqr(frames)))*s Viewport(aktx,akty,s,s) aktr=(Float(s)/frames)*(j+1) DebugLog aktr ;Kreismuster erzeugen (5 sich überschneidende Kreise) If radial(aktx+s/2,akty+s/2,aktr/2,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b)=1 Then Goto ende If radial(aktx,akty,aktr/2,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b)=1 Then Goto ende If radial(aktx+s,akty,aktr/2,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b)=1 Then Goto ende If radial(aktx,akty+s,aktr/2,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b)=1 Then Goto ende If radial(aktx+s,akty+s,aktr/2,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b)=1 Then Goto ende ;Blur nur wenn: ;Radius über 45, oder Radius im mittleren Bereich der Animation If aktr>(s/3)*2 Or aktr<(s/3) Or aktr>45 Then For y=akty+range To akty-range+s-1 LockBuffer For x=aktx+range To aktx-range+s-1 r=0:g=0:b=0 If KeyHit(1) Then Goto ende For dx=-range To range For dy=-range To range col=ReadPixelFast(x+dx,y+dy) r=r+((col Shr 16) And 255) g=g+((col Shr 8) And 255) b=b+(col And 255) Next Next WritePixelFast x,y,r/faktor Shl 16+g/faktor Shl 8+b/faktor Next UnlockBuffer Flip 0 Next EndIf Next .ende ;Image erzeugen, Benutzereingabe img=CreateImage(wh,wh) CopyRect(0,0,wh,wh,0,0,BackBuffer(),ImageBuffer(img)) AppTitle "ESC=Animation, Leertaste=Speichern" FlushKeys() Repeat If KeyHit(57) Then SaveBuffer(FrontBuffer(),"animation.bmp") AppTitle "ESC=Animation" EndIf Delay 20 Until KeyHit(1) SetBuffer BackBuffer() Return img End Function Function radial(sx,sy,r,col1_r,col1_g,col1_b,col2_r,col2_g,col2_b) ;Radial-Farbverlauf Local winkel,tmpr,tmpg,tmpb For i=0 To r-1 If KeyHit(1) Then Return 1 tmpr=col1_r+i*Float(col2_r-col1_r)/r tmpg=col1_g+i*Float(col2_g-col1_g)/r tmpb=col1_b+i*Float(col2_b-col1_b)/r For winkel=0 To 359 ;Kein WritePixelFast, weil dieser Befehl den Viewport ignoriert! WritePixel sx+Cos(winkel)*i,sy+Sin(winkel)*i,tmpr Shl 16+tmpg Shl 8+tmpb Next Flip 0 Next End Function Viel Spass! EDIT: Hab den Code ein wenig optimiert. Nun wird Blur nur noch gemacht, wenn es wirklich sinnvoll ist. Außerdem ein bisschen mit Global/Local herumgetrickst und ein ganz klein wenig die Kommentare geändert. Noch mehr Spass! |
||
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9 |
- Zuletzt bearbeitet von Eingeproggt am So, Dez 09, 2007 1:54, insgesamt einmal bearbeitet
hecticSieger des IS Talentwettbewerb 2006 |
Sa, Dez 08, 2007 19:28 Antworten mit Zitat |
|
---|---|---|
So, ich hab auch mal was gemacht. Bisher 2,44 kB Code formatiert und unkomprimiert.
http://www.hectic.de/data/Demo2.exe |
||
Download der Draw3D2 V.1.1 für schnelle Echtzeiteffekte über Blitz3D |
blitzblaster |
So, Dez 09, 2007 0:31 Antworten mit Zitat |
|
---|---|---|
Was kleines von mir:
Code: [AUSKLAPPEN] Graphics3D 640,480,32,2
SetBuffer BackBuffer() FPS=60 timer=CreateTimer(FPS) cam=CreateCamera() AmbientLight 0,0,90 CameraRange cam,1,1000 PositionEntity cam,-80,10,-250 light=CreateLight(2) PositionEntity light,10,100,50 LightRange light,1000 LightColor light,120,90,190 sphere=CreateCone(40) LightMesh sphere,0,250,10 EntityShininess sphere,.8 EntityFX sphere,16 EntityBlend sphere,3 cube=CreateCube() EntityFX cube,16 ScaleEntity cube,30,30,30 EntityAlpha cube,.2 EntityShininess cube,.5 While Not KeyHit(1) a=a+.1 PositionEntity sphere,i*Sin(a),Sin(i*2),Sin(5*i) TurnEntity sphere,1,0,1 ScaleEntity sphere,20,20,20 a=a+.7 b=b+.7 If MilliSecs()>time time=MilliSecs+5000 c=c-1 EntityColor sphere,255,120-c,120 End If MoveEntity cam,Sin(b-.01),Cos(a-.02),Sin(a-.01) UpdateNormals sphere UpdateWorld RenderWorld WaitTimer timer Flip Wend End |
||
Rübennase |
So, Dez 09, 2007 12:01 Antworten mit Zitat |
|
---|---|---|
Ich hab mich gestern Abend hingesetzt und Das hier gemacht. | ||
SpionAtomBetreff: Re: Blitz CodeCompo #12 - GrafikDemoDingsda |
Mo, Dez 10, 2007 12:48 Antworten mit Zitat |
|
---|---|---|
Vorraussetzungen: hat Folgendes geschrieben: Es ist nicht erlaubt Bild/Toninformationen als fertige/verschlüsslte/komprimierte Daten im Code einzubauen. Widerspricht es den Regeln, wenn man zb Koordinaten für den Line-Befehl als Data "speichert", um Platz zu sparen? |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
Vincent |
Mo, Dez 10, 2007 14:17 Antworten mit Zitat |
|
---|---|---|
Was wir halt zu vermeiden versuchen ist, dass jemand ein komplettes Bild irgendwie direkt mitspeichert.
Es ist also erlaubt Grafikfunktionen positioniert anzuwenden. Das Auslesen aus nem irgendwie gearteten Feld hingegen wäre schon ein Schritt zuviel in Richtung: komplette Bilddaten direkt mitgespeichert. Ziel des Contests ist es NICHT zu schauen, wer das meiste grafische Talent hat, sondern wer durch raffinierte mathematische Spielereien und verbflüffende Funktionen das irgendwie beeindruckendste Prdukt erhalten kann. Also: Line() als solches kann beliebig oft aufgerufen werden, ... solange die Parameter nicht aus einem Feld gelesen werden. |
||
Gott ist nicht mit uns ... weil er mit Idioten keine Gnade kennt ! |
CasiopayaBetreff: Rundreise |
Do, Dez 13, 2007 11:54 Antworten mit Zitat |
|
---|---|---|
Hi!
da mir die Forumsuche schon so oft geholfen hat möcht ich nun auch mal was beitragen. Hier mein TSP (Traveling Salesman Problem). Es such für N Städte immer die kürzeste Rundreise. http://www.vgsolutions.de/webspace/TSP.exe Für Theorie-Interessierte: Die kürzeste Reise ist immer überschneidungsfrei. Findet jemand für N = 100 eine Städte-Anordnung, welche nicht von meinem Programm überschneidungsfrei gelöst werden kann? Ich habs noch nicht geschafft Grüße Vasi |
||
Marek |
Do, Dez 13, 2007 15:45 Antworten mit Zitat |
|
---|---|---|
Zitat: Der Benutzer darf nicht in den Programmablauf durch Eingaben eingreifen dürfen
Wiederspricht dein Beitrag nicht den Regeln, Casiopaya? |
||
Wer lesen kann ist klar im Vorteil... |
Eingeproggt |
Do, Dez 13, 2007 15:58 Antworten mit Zitat |
|
---|---|---|
Das Programm find ich faszinierend.
Aber es ist sowohl von Marek's genannter Regel als auch von der Aufgabenstellung "Graphikdemo" etwas fehl am Platz. Zitat: Findet jemand für N = 100 eine Städte-Anordnung, welche nicht von meinem Programm überschneidungsfrei gelöst werden kann?
Naja, fast. Die Berechnung war in der 2600. Generation oder sowas, wie sie fertig war. Lange Zeit ging überhaupt nix weiter, ka warum, kenne deinen Code nicht mfG, Christoph. |
||
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9 |
Casiopaya |
Do, Dez 13, 2007 18:58 Antworten mit Zitat |
|
---|---|---|
Marek hat Folgendes geschrieben: Wiederspricht dein Beitrag nicht den Regeln, Casiopaya?
Hoppla, völlig übersehen. Ich könnte natürlich ne Zufallskarte mit 150 Städten einprogrammieren, aber das wär dann weit nicht mehr so lustig wie das Selbst Anklicken. Schade, dann ein ander mal. Eingeproggt hat Folgendes geschrieben: Naja, fast. Die Berechnung war in der 2600. Generation oder sowas, wie sie fertig war. Lange Zeit ging überhaupt nix weiter, ka warum, kenne deinen Code nicht
Das ist völlig normal so. Eine Änderung sieht man nur, wenn eine weitere bessere Lösung gefunden wurde. Bei sehr kleinen Überschneidungen kann das recht lange dauern. Das ganze basiert auf einem evolutionären Algorithmus, d.h. letztlich auf purem Zufall. Eine Optimale Lösung ist allerdings keineswegs garantiert! Die Wahrscheinlichkeit sie zu finden steigt nur mit jeder Generation. Mit den exakt selben Anfangswerten kann es übrigens auch sein, dass einmal eine optimale Lösung gefunden wird, einmal nicht. Ist halt ne Heuristik das ganze. Um sagen zu können, dass wirklich keine bessere Lösung gefunden wurde sollte sich schon ca. 3 Minuten GAR nichts mehr ändern. Kann sein, dass das Programm bei N = 300 gerne mal ne Stunde rechnet . Dafür ist es bei kleineren n (so bis 100) umso schneller. Liegt an der Wahnsinns-Komplexität, die das Problem hat. Allerdings könnte ich mit etwas Mühe die Lösungsrate noch deutlich erhöhen, mach ich aus obigem Grund nun aber doch nicht. Btw. Freut mich, dass es dir gefällt PS: Hier das Problem: http://de.wikipedia.org/wiki/P...sreisenden |
||
Hummelpups |
Fr, Dez 14, 2007 3:08 Antworten mit Zitat |
|
---|---|---|
Code: [AUSKLAPPEN] SetGraphicsDriver GLMax2DDriver();Graphics 800,600,32,60;Global bm:Byte[8];Global ac%[2]
f();Global i=CreateImage(8,8);MidHandleImage i;pm=LockImage(i);For stepx=1 To 8;For stepy=1 To 8;WritePixel(pm,stepx-1,stepy-1,ac[GetBit(bm[stepy-1],stepx-1)]) Next;Next;UnlockImage(i);Global asi:Float[360];Global acosi:Float[360];t1=CreateTimer(60);For steps=0 To 359;asi[steps]=Sin(steps);acosi[steps]=Cos(steps);Next;SeedRnd MilliSecs() Global sn;z=MilliSecs();tx=200;ty=300;Global ss#=1;Global asp#=1;Global cfg_ttl=Rand(500,2000);Global r,g,b,csp=-5;time=MilliSecs();Type tp;Global l:TList=CreateList() Field x#,y#,ang,dist,r,g,b,ttl%,al#;Function Create(x#,y#) If csp>0 Then If r<255 Then r:+csp If r>=255 And g<=255 Then g:+csp If g>=255 And b<=255 Then b:+csp If b>=255 Then Newacs ElseIf csp<0 Then If r>0 Then r:+csp If r<=0 And g>=0 Then g:+csp If g<=0 And b>=0 Then b:+csp If b<=0 Then Newacs End If Local is:tp=New tp;is.x=x;is.y=y;is.r=r;is.g=g;is.b=b;is.al=1;is.ttl=cfg_ttl;is.dist=400-is.x;l.addlast(is);End Function;Function Newacs();Repeat;csp=Rand(-10,10);Until csp<-2 Or csp>2 r=Rand(255);g=Rand(255);b=Rand(255);End Function;Function DA();Local is:tp;Local old_is:tp=Null;For is=EachIn l;If old_is<>Null SetColor is.r,is.g,is.b;p1x=400-is.dist*Cosi(is.ang);p1y=is.y+ si(sn)* (si(is.ang)*is.dist) p2x=400-old_is.dist*Cosi(old_is.ang);p2y=old_is.y+ si(sn)* (si(old_is.ang)*old_is.dist) If p1x<0 Then p1x=0;If p1x>800 Then p1x=800;If p1y<0 Then p1y=0;If p1y>600 Then p1y=600 If p2x<0 Then p2x=0;If p2x>800 Then p2x=800;If p2y<0 Then p2y=0;If p2y>600 Then p2y=600 TT.Create(p1x,p1y,is.r,is.g,is.b);End If;is.ang:+asp;is.ttl:-1;old_is=is If is.ttl<1 Then is.al:-0.01;If is.al<0 Then l.remove(is) Next;SetColor 255,255,255;End Function;End Type;Type TT;Global l:TList=CreateList();Field x,y,al#,r,g,b;Function Create(x,y,r,g,b) Local is:TT=New TT;is.x=x;is.y=y;is.r=r;is.g=g;is.b=b;is.al=1;l.addlast(is);End Function;Function DA() Local is:TT;Local old_is:tp=Null;SetBlend 4;For is=EachIn l;SetColor is.r,is.g,is.b SetScale is.al,is.al;DrawImage i,is.x,is.y;is.al:-0.05;If is.al<=0 Then l.remove(is) Next;SetScale 1,1;SetBlend 1;SetColor 255,255,255;End Function;End Type;Function ran();Return Rand(-100,100);End Function Function GetBit(a:Byte,b:Byte);Return (a & Int(2^b))/ Int(2^b);End Function Function si#(ang);While ang<0;ang:+360;Wend;Return asi[ang Mod 360];End Function;Function f();c$="(C) IMurDOOM";ac[0]=$FF000000;ac[1]=$FFFFFFFF bm[0]=%00111100;bm[1]=%01111110;bm[2]=%01111110;bm[3]=%11111111;bm[4]=%11111111;bm[5]=%01111110;bm[6]=%01111110;bm[7]=%00111100;End Function Function Cosi#(ang);While ang<0;ang:+360;Wend;Return aCosi[ang Mod 360];End Function;Repeat;SetClsColor r/3,g/3,b/3;Cls;WaitTimer(t1);If MilliSecs()>=z+100 Then z=MilliSecs();tx=tx+Rand(-20,20);ty=ty+Rand(-10,10);If tx<200 Then tx=200;If tx>300 Then tx=300;If ty<250 Then ty=250;If ty>350 Then ty=350 tp.Create(tx,ty);End If;If MilliSecs()>=time+2500 Then ss=Rnd(-3,3);asp=Rnd(0.5,3);time=MilliSecs() tp.DA;TT.DA;Flip 0;sn=(sn+ss) Mod 360;Until KeyHit(27) 3078 Bytes, weniger als erlaubt, aber ist schon gut so.[/code] |
||
blucode - webdesign - Ressource - NetzwerkSim
BlitzBasic 2D - BlitzMax - MaxGUI - Monkey - BlitzPlus |
SpionAtom |
Fr, Dez 14, 2007 13:51 Antworten mit Zitat |
|
---|---|---|
Wär schön, wenn du es kompilierst, dann hätten mehr Leute was von deinem Programm.
(Ich kompilier meines auch nochmal) <Inselrutsche> <Inselrutsche kompiliert> |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
The_Nici |
Fr, Dez 14, 2007 16:33 Antworten mit Zitat |
|
---|---|---|
Toll IMurDOOM, aber bei mir in der Max2D-Demo sieht es etwas anders aus. Vielleicht liegts an der Demo, vielleicht an der nVidia-Karte. Im DirectX-Modus sieht es jedenfalls auch nicht schöner aus. | ||
Hummelpups |
Fr, Dez 14, 2007 18:00 Antworten mit Zitat |
|
---|---|---|
www.blitzhelp.net/graf.exe
Habe auch ne Invidia karte, mach doch einfach mal nen screenshot oder starts im Fenstermodus. |
||
blucode - webdesign - Ressource - NetzwerkSim
BlitzBasic 2D - BlitzMax - MaxGUI - Monkey - BlitzPlus |
CasiopayaBetreff: Leßbar? |
Mi, Dez 26, 2007 3:55 Antworten mit Zitat |
|
---|---|---|
Hi
ich bekomme meinen Code zwar auf 4 kb, allerdings ist dieser nicht mehr leßbar. Keine Kommentare, Variablennamen wurden kryptisch ersetzt etc. Das stellt kein Problem dar oder? Grüße |
||
Hummelpups |
Mi, Dez 26, 2007 3:58 Antworten mit Zitat |
|
---|---|---|
Das ist alles nicht dein Problem. | ||
blucode - webdesign - Ressource - NetzwerkSim
BlitzBasic 2D - BlitzMax - MaxGUI - Monkey - BlitzPlus |
BenibaerenstarkBetreff: Weihnachtssterne |
Do, Dez 27, 2007 2:17 Antworten mit Zitat |
|
---|---|---|
voilà, meine Grafikdemodingsda:
Features: -Sterne, welche zufällig in Anzahl Zacken (3-11) und Form variieren -"Pseudofraktale": Das ursprüngliche Muster wird immer wieder in sich kopiert -unschlagbar schnelle Fullscreen-Farbverläufe -4014 Zeichen Code Screenshot(s) mit der Leertaste, Beenden mit Esc. ...viel Spass! sterne.exe Code: [AUSKLAPPEN] gfxwidth=1024
gfxhight=768 Graphics3D gfxwidth,gfxhight,32,1 SetBuffer BackBuffer() bg = background () screenshot=0 Type stern Field piv Field mesh Field rot# Field scale#=0 Field alpha#=0.3 Field fadeout=0 End Type SeedRnd MilliSecs() s.stern = New stern s\piv=CreatePivot() s\rot=Rnd(-300,300) s\scale=0 s\alpha=1 s\mesh=Fraktal(5,3,1.0,0.5,1.0,1,1,4,s\piv) ScaleEntity s\piv, s\scale,s\scale,1 Global cam=CreateCamera() Global timer=MilliSecs() Function FPS() fps#=1000.0/(MilliSecs()-timer) timer=MilliSecs() Return fps End Function While Not KeyDown(1) fps#=FPS() For s.stern = Each stern s\rot=s\rot/(1+(1/fps)) TurnEntity s\piv,0,0,s\rot/fps s\scale=s\scale+(0.3/fps) ScaleEntity s\piv,s\scale,s\scale,1 MoveEntity s\piv,0,0,-1.2/fps If s\scale >1 If s\fadeout=0 s\fadeout=1 SeedRnd MilliSecs() t.stern = New stern t\piv=CreatePivot() t\rot=Rnd(-300,300) t\alpha=1 t\mesh=Fraktal(Rand(3,11),Rnd(2.5,4),Rnd(1.0,2.3),Rnd(0.1,0.9),Rnd(0.1,1.2),Rnd(-3,3),Rnd(-3,3),Rnd(2.5,5.0),t\piv) ScaleEntity t\piv, t\scale,t\scale,1 Else s\alpha=s\alpha-(0.6/fps) EntityAlpha s\mesh,s\alpha If s\alpha < 0.05 FreeEntity s\piv Delete s.stern EndIf EndIf EndIf Next i#=i+(60/fps) If i >360 Then i=0 TurnEntity bg,60*Sin(i)/fps,25*(Cos(i)^2)/fps,(25*Sin(i))/fps RenderWorld Flip If KeyHit (57) Then SaveBuffer(FrontBuffer(),"Shot"+screenshot+".bmp") screenshot=screenshot+1 EndIf Wend End Function background() m=CreateMesh() s=CreateSurface( m ) EntityFX m,3 AddVertex s,-1,+1,-1:VertexColor s,0,0,0,255 AddVertex s,+1,+1,-1:VertexColor s,1,0,0,0 AddVertex s,+1,-1,-1:VertexColor s,2,0,255,0 AddVertex s,-1,-1,-1:VertexColor s,3,0,255,255 AddVertex s,+1,+1,+1:VertexColor s,4,255,0,0 AddVertex s,-1,+1,+1:VertexColor s,5,255,255,0 AddVertex s,-1,-1,+1:VertexColor s,6,255,255,255 AddVertex s,+1,-1,+1:VertexColor s,7,255,0,255 AddTriangle s,0,3,1 AddTriangle s,1,3,2 AddTriangle s,1,2,7 AddTriangle s,1,7,4 AddTriangle s,4,7,6 AddTriangle s,4,6,5 AddTriangle s,5,6,0 AddTriangle s,0,6,3 AddTriangle s,0,1,5 AddTriangle s,5,1,4 AddTriangle s,6,2,3 AddTriangle s,2,6,7 ScaleMesh m,500,500,500 EntityOrder m,1 Return m End Function Function createstern(n=3,R1#=3,R2#=1.5,R3#=0.5,R4#=1.0,StartX#=0,StartY#=0,piv=0,rot#=0) m=CreateMesh(piv) s=CreateSurface( m ) EntityFX m,1 For e = 0 To (n-1) pos=(360.0/n)*e+rot pos2=(360.0/n)*e+(360.0/(2*n))+rot AddVertex s, StartX+R1*Sin(pos),StartY+R1*Cos(pos),7 AddVertex s, StartX+R2*Sin(pos),StartY+R2*Cos(pos),7 AddVertex s,StartX+R3*Sin(pos2),StartY+R3*Cos(pos2),7 AddVertex s,StartX+R4*Sin(pos2),StartY+R4*Cos(pos2),7 Next For tri=0 To (n-2) p=tri*4 AddTriangle (s,p,p+1,p+2) AddTriangle (s,p,p+2,p+3) AddTriangle (s,p+3,p+2,p+5) AddTriangle (s,p+3,p+5,p+4) Next p=(n-1)*4 AddTriangle (s,p,p+1,p+2) AddTriangle (s,p,p+2,p+3) AddTriangle (s,p+3,p+2,1) AddTriangle (s,p+3,1,0) EntityColor m,0,0,0 FlipMesh m Return m End Function Function Fraktal(n=7,SR1#=3,SR2#=1.0,SR3#=0.5,SR4#=1.0,StrtX#=0,StrtY#=0,Faktor#=4,piv=0) mesh=createstern(n,SR1,SR2,SR3,SR4,StrtX,StrtY,piv) For e = 0 To (n-1) pos=(360.0/n)*e StartX#=StrtX+Sin(pos)*(SR1+(SR4/Faktor)) StartY#=StrtY+Cos(pos)*(SR1+(SR4/Faktor)) If n Mod 2 = 0 rot# = 360.0/(2*n) Else rot#=0 EndIf star3=createstern(n,SR1/Faktor,SR2/Faktor,SR3/Faktor,SR4/Faktor,StartX,StartY,piv,rot) AddMesh star3,mesh FreeEntity star3 For f = 0 To (n-1) pos=(360.0/n)*f+rot StartX1#=StartX+Sin(pos)*(SR1/Faktor+(SR4/(Faktor^2))) StartY1#=StartY+Cos(pos)*(SR1/Faktor+(SR4/(Faktor^2))) star3=createstern(n,SR1/(Faktor^2),SR2/(Faktor^2),SR3/(Faktor^2),SR4/(Faktor^2),StartX1,StartY1,piv,0) AddMesh star3,mesh FreeEntity star3 For g = 0 To (n-1) pos2=(360.0/n)*g star4=createstern(n,SR1/(Faktor^3),SR2/(Faktor^3),SR3/(Faktor^3),SR4/(Faktor^3),StartX1+Sin(pos2)*(SR1/(Faktor^2)+(SR4/(Faktor^3))),StartY1+Cos(pos2)*(SR1/(Faktor^2)+(SR4/(Faktor^3))),piv,rot) ;R1,alt+ R4,neu AddMesh star3,mesh FreeEntity star3 Next Next Next Return mesh End Function |
||
3D Scanner selber bauen? -> www.bewe-3dscanner.ch.vu |
Gehe zu Seite Zurück 1, 2, 3, 4 Weiter
Übersicht Sonstiges Projekte
Powered by phpBB © 2001 - 2006, phpBB Group