| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
 Verfasst am: 24.03.2007, 14:47 Titel: Superellipses/Supershapes on the fly |
 |
|
Grüße an Alle!
Das ist ein wirklich gutes und interessantes Forum!
Hab FB erst kürzlich entdeckt und mache gerade meine ersten Flugversuche! 
Es sind 2 Codes in denen es im wesentlichen um Superellipsen geht
Der 2. Code (superbird) ist "künstlich" verlangsamt durch eine Schleife 0-36000 (statt 0-360) und sync/flip alle 16 ms!
Grüße
steff
| Code: |
' Superellipses/Supershapes on the fly
' by steff
OPTION STATIC
OPTION EXPLICIT
CONST SCREENW=800 '640
CONST SCREENH=600 '480
CONST MAXSHAPES=100
declare sub initshapes()
declare sub calcshapes()
declare sub drawshapes()
dim shared rad as single
dim shared rot as single
dim shared dist as single
dim status as integer
dim time2 as single
type tshapes
originx as single
originy as single
xradius as single
yradius as single
p as single
dp as single
rotangle as single
drotangle as single
col as integer
posx1(36) as single
posy1(36) as single
rotposx as single
rotposy as single
end type
dim shared shape(MAXSHAPES) as tshapes
SCREEN 19, 16, 2, 1
SCREENSET 1, 0
time2=timer
RANDOMIZE TIMER
DO
CLS
if status = 0 then
initshapes()
status=1
endif
IF MULTIKEY(&h39) then
status=0
endif
calcshapes()
drawshapes()
locate 1,1,0
print "hit space"
if timer-time2>0.033 then
time2=timer
SCREENCOPY
endif
LOOP UNTIL INKEY$=CHR$(27)
sub initshapes()
dim x as integer
for x= 0 to MAXSHAPES
shape(x).originx=Rnd*SCREENW
shape(x).originy=Rnd*SCREENH
shape(x).xradius=Rnd*80+20
shape(x).yradius=Rnd*80+20
shape(x).p=rnd*4
shape(x).dp=rnd*0.1
shape(x).rotangle=Rnd*360
shape(x).drotangle=(Rnd*2)-1
shape(x).col=rgb(rnd*255,rnd*255,rnd*255)
next
end sub
sub calcshapes()
dim a as integer
dim ang as integer
dim x as single
dim y as single
for a= 0 to MAXSHAPES
For ang= 0 To 36
rad=ang*0.17453293 '10 * PI / 180
x=Cos(rad)
y=sin(rad)
shape(a).posx1(ang)=sgn(x)*shape(a).xradius*(Abs(x)^shape(a).p)
shape(a).posy1(ang)=sgn(y)*shape(a).yradius*(Abs(y)^shape(a).p)
rot=atan2((shape(a).originx-(shape(a).originx+shape(a).posx1(ang))),(shape(a).originy-(shape(a).originy+shape(a).posy1(ang))))
dist= Sqr ( (shape(a).originx-(shape(a).originx+shape(a).posx1(ang)))^2 + (shape(a).originy-(shape(a).originy+shape(a).posy1(ang)))^2 )
shape(a).posx1(ang)=dist*Cos((shape(a).rotangle) * 0.17453293-rot)
shape(a).posy1(ang)=dist*Sin((shape(a).rotangle) * 0.17453293-rot)
next
shape(a).rotangle=shape(a).rotangle+shape(a).drotangle
shape(a).p=shape(a).p+shape(a).dp
if shape(a).p> 5 then
shape(a).dp=-shape(a).dp
endif
if shape(a).p< 0 then
shape(a).p=0
shape(a).dp=-shape(a).dp
endif
next
end sub
sub drawshapes()
dim a as integer
dim ang as integer
for a= 0 to MAXSHAPES
For ang= 0 To 36
If ang<36 then
Line (shape(a).originx+shape(a).posx1(ang),shape(a).originy+shape(a).posy1(ang))-(shape(a).originx+shape(a).posx1(ang+1),shape(a).originy+shape(a).posy1(ang+1) ),shape(a).col
endif
next
paint (shape(a).originx,shape(a).originy) ,shape(a).col,shape(a).col
next
end sub
|
| Code: |
' Superbird on the fly
' 23.01.07
' by steff
OPTION STATIC
OPTION EXPLICIT
dim ang as integer
dim ang2 as single
dim radang2 as single
dim sinang2 as single
dim cosang2 as single
dim rad as single
dim x as single
dim y as single
dim posx as single
dim posy as single
dim p as single
dim q as single
dim col_red as integer =255
dim col_green as integer
dim col_blue as integer
dim colfactor as integer =1
dim time2 as single
SCREEN 19, 16, 2, 1
SCREENSET 1, 0
time2=timer
RANDOMIZE TIMER
DO
CLS
For ang= 0 To 36000
rad=ang*0.017453293
x=Cos(rad)
y=sin(rad)
posx=sgn(x)*400*(Abs(x)^p)
posy=sgn(y)*300*(Abs(y)^p)
If (ang>45) And (ang<91) then
If col_red<255 And col_blue =255 And col_green =0 Then col_red=col_red+colfactor
If col_red=255 And col_blue >0 And col_green=0 Then col_blue=col_blue-colfactor
If col_red=255 And col_blue =0 And col_green < 255 Then col_green=col_green+colfactor
If col_red>0 And col_blue =0 And col_green = 255 Then col_red=col_red-colfactor
If col_red=0 And col_blue <255 And col_green = 255 Then col_blue=col_blue+colfactor
If col_red=0 And col_blue =255 And col_green >0 Then col_green=col_green-colfactor
Line (360-20*cosang2,320-10*sinang2)-((400+5*cosang2)+posx,(20+5*sinang2)+posy),rgb(col_red,col_green,col_blue)
Line (360-20*cosang2,320-10*sinang2)-((400+5*cosang2)-posx,(20+5*sinang2)+posy),rgb(col_red,col_green,col_blue)
Endif
next
p=p+0.1*q
If p<0.8 then
q=1.0
p=0.8
EndIf
If p>=4 Then
q=-1.0
endif
ang2=ang2+2
If ang2>360 Then ang2=0
sinang2=sin(ang2*0.017453293)
cosang2=cos(ang2*0.017453293)
if timer-time2>0.016 then 'fps 60 ??
time2=timer
SCREENCOPY
endif
LOOP UNTIL INKEY$=CHR$(27)
|
Zuletzt bearbeitet von steff am 24.03.2007, 14:58, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
Mao
Anmeldungsdatum: 25.09.2005
Beiträge: 4409
Wohnort: /dev/hda1
|
| Verfasst am: 24.03.2007, 14:56 Titel: |
|
|
Sehr schöne Effekte!
Machen sich als Bildschirmschoner bestimmt gut.
Nur leider sehr rechenlastig. Bei mir ruckelt's bei beiden bei 3GHz leider etwas.  (Kann aber auch an meinem ohnehin recht aktivem Rechner liegen.)
_________________
Eine handvoll Glück reicht nie für zwei.
--
 |
|
| Nach oben |
|
|
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
| Verfasst am: 24.03.2007, 15:06 Titel: |
|
|
| Zitat: | | Nur leider sehr rechenlastig. Bei mir ruckelt's bei beiden bei 3GHz leider etwas. |
Hi!
Die progs sind nicht optimiert und sollten auch rechenlastig sein.
Gewissermaßen als Test.
Das Ruckeln liegt wahrscheinlich an meinen (derzeit) fehlenden Kenntnissen an fps Kontrolle!
Gruß
steff |
|
| Nach oben |
|
|
Stormy
Anmeldungsdatum: 10.09.2004
Beiträge: 567
Wohnort: Sachsen - wo die schönen Frauen wachsen ;)
|
|
| Nach oben |
|
|
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
| Verfasst am: 24.03.2007, 15:38 Titel: |
|
|
Hi Stormy!
| Zitat: | Ich kann ja mal bei Gelegenheit im Forum ein Thread aufmachen, wo ich erkläre, wie man fps-unabhängige Bewegung realisieren kann.
|
Das wäre natülich 1. super und 2. sehr nützlich !
Gruß
steff |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 24.03.2007, 15:43 Titel: |
|
|
Das sind zwei wirklich geniale Effekte, besonders die Mathematischen funktionen gefallen mir 
_________________
 |
|
| Nach oben |
|
|
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
| Verfasst am: 24.03.2007, 18:49 Titel: |
|
|
Hi!
| Zitat: | Das sind zwei wirklich geniale Effekte, besonders die Mathematischen funktionen gefallen mir
|
Thx!
Beruht auf der Superellipse-formel von Paul Bourke.
Die Formel berechnet die Punkte einer Kurve.
Wesentlich ist der Parameter 'p' (im code)
p=0 ergibt ein Quadrat/Rechteck
0<p<1 ergibt ein abgerundetes Quadrat/Rechteck
p=1 Kreis/Ellipse
p=2 Raute/Rhombus
p>2 ergibt einen vierstahligen Stern/Kreuz
Gruß
steff |
|
| Nach oben |
|
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
