Blitz CodeCompo #12 - GrafikDemoDingsda

Übersicht Sonstiges Projekte

Gehe zu Seite Zurück  1, 2, 3, 4  Weiter

Neue Antwort erstellen

Eingeproggt

BeitragSa, Dez 08, 2007 16:08
Antworten mit Zitat
Benutzer-Profile anzeigen
Die Ideen sind bis jetzt alle gut (außer meiner mal wieder Sad )

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

BeitragSa, Dez 08, 2007 16:45
Antworten mit Zitat
Benutzer-Profile anzeigen
Und jetzt überleg mal, warum die Leute ihre Codes noch nicht jetzt posten.

Richtig, damit keiner abguckt.

SpionAtom

BeitragSa, Dez 08, 2007 17:06
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragSa, Dez 08, 2007 17:06
Antworten mit Zitat
Benutzer-Profile anzeigen
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 Smile
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

hectic

Sieger des IS Talentwettbewerb 2006

BeitragSa, Dez 08, 2007 19:28
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragSo, Dez 09, 2007 0:31
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragSo, Dez 09, 2007 12:01
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab mich gestern Abend hingesetzt und Das hier gemacht.

SpionAtom

Betreff: Re: Blitz CodeCompo #12 - GrafikDemoDingsda

BeitragMo, Dez 10, 2007 12:48
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragMo, Dez 10, 2007 14:17
Antworten mit Zitat
Benutzer-Profile anzeigen
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 !

Casiopaya

Betreff: Rundreise

BeitragDo, Dez 13, 2007 11:54
Antworten mit Zitat
Benutzer-Profile anzeigen
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? Razz Ich habs noch nicht geschafft Very Happy

Grüße

Vasi
 

Marek

BeitragDo, Dez 13, 2007 15:45
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragDo, Dez 13, 2007 15:58
Antworten mit Zitat
Benutzer-Profile anzeigen
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 Smile

mfG, Christoph.
Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9

Casiopaya

BeitragDo, Dez 13, 2007 18:58
Antworten mit Zitat
Benutzer-Profile anzeigen
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 Smile. 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 Very Happy

PS: Hier das Problem: http://de.wikipedia.org/wiki/P...sreisenden

Hummelpups

BeitragFr, Dez 14, 2007 3:08
Antworten mit Zitat
Benutzer-Profile anzeigen
user posted image

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

BeitragFr, Dez 14, 2007 13:51
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragFr, Dez 14, 2007 16:33
Antworten mit Zitat
Benutzer-Profile anzeigen
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

BeitragFr, Dez 14, 2007 18:00
Antworten mit Zitat
Benutzer-Profile anzeigen
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

Casiopaya

Betreff: Leßbar?

BeitragMi, Dez 26, 2007 3:55
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi

ich bekomme meinen Code zwar auf 4 kb, allerdings ist dieser nicht mehr leßbar. Laughing
Keine Kommentare, Variablennamen wurden kryptisch ersetzt etc.

Das stellt kein Problem dar oder?

Grüße

Hummelpups

BeitragMi, Dez 26, 2007 3:58
Antworten mit Zitat
Benutzer-Profile anzeigen
Das ist alles nicht dein Problem.
blucode - webdesign - Ressource - NetzwerkSim
BlitzBasic 2D - BlitzMax - MaxGUI - Monkey - BlitzPlus

Benibaerenstark

Betreff: Weihnachtssterne

BeitragDo, Dez 27, 2007 2:17
Antworten mit Zitat
Benutzer-Profile anzeigen
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



user posted image
3D Scanner selber bauen? -> www.bewe-3dscanner.ch.vu

Gehe zu Seite Zurück  1, 2, 3, 4  Weiter

Neue Antwort erstellen


Übersicht Sonstiges Projekte

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group