CosmoParticle

[Deleted]

Hi,

Rebirth of the Cosmos.
After the Big Bang move your mouse, but not too fast!

Dim anzahl, color, aSpeed, xscreen, yscreen, i, xmitte, ymitte, Fnt, waw  
Dim x(1000)
Dim y(1000)
Dim winkel(1000)
Dim speed(1000)  
Dim sinus(360)  
Dim cosinus(360)

anzahl=1000:xscreen =640:yscreen =480
xmitte = xscreen/2:ymitte = yscreen/2

for i=1 to anzahl
   x(i) = xmitte
   y(i) = ymitte
   winkel(i)= Rand(1,360)
   speed(i) = Rand(1,3)
next

for i=0 to 360
   sinus(i)  = sin(i)
   cosinus(i)= cos(i)
next

Window 640,480,0
Fnt = Graphics.CreateFont("courier",24)
waw = Sound.LoadWav("cosmobumm.wav")
Sound.PlayWav waw

while EscKey() =0
ClsColor 0,0,0
for i=0 to anzahl
  aSpeed = Distance (xmitte, ymitte, x(i), y(i)) /200 * speed(i)+1
  x(i) = xMove(x(i), winkel(i), aSpeed)
  y(i) = yMove(y(i), winkel(i), aSpeed)
  if x(i) < 0 Or x(i) > xscreen Or y(i) < 0 Or y(i) > yscreen then
     x(i) = xmitte
     y(i) = ymitte
     winkel(i)= Rand(1,360)
     speed(i) = Rand(1,3)
  end if
  color = speed(i)*100 - 55
  Graphics.SetPoint x(i), y(i), ARGB(255,color, color, color)
next
xmitte = Mouse.x
ymitte = Mouse.y
Graphics.Display
'Graphics.SetFPS 80
wend
WinEnd

Function xMove(x,winkel,speed)
   xMove = x + Cosinus(winkel)*speed
End Function

Function yMove(y,winkel,speed)
   yMove = y + Sinus(winkel)*speed
End Function

Function Distance(x1,y1,x2,y2)
   Dim dx, dy
   dx = x1-x2 : dy = y1-y2
   Distance = abs(sqr(dx*dx+dy*dy))
End Function

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE)  
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
End Sub

Function Rand(ra, rb)
   Rand = Math.GetRndInt(ra,rb)
End Function

Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub    

Attachments:

[Deleted]

Hi,

There is no ellipse in Brutus2D. I had never noticed it.
But now I have an ellipse. Try this demo.

If you move your mouse, the ball will follow you.
If you wait a moment, then turns the ball around the mouse pointer.

include "library.b2d"

Dim x, y, rot, vel, tx, ty
Dim dx, dy, angle, dist, da

Window 640, 480, 0
Fnt = Graphics.CreateFont("courier",12)  

While EscKey()=0
ClsColor 255,255,255
tx = Mouse.x
ty = Mouse.y
dx = tx-x
dy = ty-y
dist  = sqr(dx*dx+dy*dy)
angle = Atan(ty-y, tx-x)
da  = angle-rot
da  = atan(sin(da),cos(da))
vel = Min(1, dist/100)
Rot = rot + da*vel*0.1
x=x + cos(rot)*vel*5
y=y + sin(rot)*vel*5
Text Fnt,246,16,"ATAN ME",255,0,0,200
Graphics.SetCircle x-5, y-5, 8, ARGB(255,0,0,0)      
Ellipse x-5, y-5, 4,6, 0,0,0
Graphics.Display
Graphics.SetFPS 80
Wend
WinEnd


Attachments:

[matthew]

Nice Programs Peter, I liked the one where the ball followed the mouse best.

[Deleted]

Thanks Matthew,

I am sure, you like also this here.

Window 320,240,1

Dim x, offset, Height, Width, hwnd, hdc
offset = 10
x = Width/2

While EscKey()=0
ClsColor 200,200,248
iF Mouse.x > x Then
  x = x + 0.5
  offset = -10
End iF
iF Mouse.x < x Then
  x = x - 0.5
  offset =10
End iF  
Graphics.SetLine x,0,x,height,ARGB(255,0,0,255)
Graphics.SetLine Mouse.x,Mouse.y,Mouse.x+offset,Mouse.y-10,0
Graphics.SetLine Mouse.x,Mouse.y,Mouse.x+offset,Mouse.y+10,0
Graphics.SetLine Mouse.x,Mouse.y,Mouse.x+offset*3,Mouse.y,0
Graphics.Display
Graphics.SetFPS 100
wend
WinEnd

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE) or Key.Pressed(0)
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub

[Deleted]

Hi Mathew,

Maybe you like this best.
Move your mouse from right to left and from left to right.

Window 640,140,1

Dim x, mx, oA, oB, Height, Width, hwnd, hdc

While EscKey()=0
ClsColor 200,200,248
For x=0 To width Step 20
   mx = Mouse.x/10
   oA = Rand(-mx,mx)
   oB = Rand(-mx,mx)
   Graphics.SetLine x+oA,20,x-oB,100,ARGB(255,0,0,255)
Next
Graphics.Display
Graphics.SetfPS 60
Wend
WinEnd

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE) or Key.Pressed(0)
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub

Function Rand(ra, rb)
   Rand = Math.GetRndInt(ra,rb)
End Function


[Deleted]

Hi Matthew,

If you like snakes, then try Quadratus the mega snake.
Window 640,480,1

Dim cRgb(3)  
Dim x(60)
Dim y(60)
Dim i, color

While EscKey()=0
ClsColor 255,255,255
For i=59 To 1 step -1
   x(i) = x(i-1)
   y(i) = y(i-1)
next
x(0)= Mouse.x-12
y(0)= Mouse.y-12

For i=0 To 59
   color = i*4
   GetRGB color
   Graphics.SetRect x(i),y(i),12,12,ARGB(255,cRGB(1),cRGB(2),cRGB(3))
   Next
Graphics.Display
'Graphics.SetfPS 100
Wend
WinEnd

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE) or Key.Pressed(0)
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub

Sub GetRGB(col)
   cRGB(1) = col and &hFF          
   cRGB(2) = (col/256)   and &hFF  
   cRGB(3) = (col/65536) and &hFF  
End Sub


[matthew]

You've been a busy Programmer, Peter.

[Deleted]

Hi Matthew,

Ja, ich bin beschäftig. Ist eine lustige programmierung und sehr leicht.

Yes, I am busy. is a funny programming, and very easy to do.
Here still two demo.

Dim Height, Width, hwnd, hdc, pi
Dim i,px,py,px2,py2,angle,angle2,radius,frequency,frequency2,x,x2,Font
frequency=2: frequency2=2: radius =100  

Window 640,240,1
Font = Graphics.CreateFont("courier",12)
pi= 4*Atn(1)  

While EscKey()=0
ClsColor 128,128,128
Circle width/8,75,radius/2, 255,255,255
px = width/8 + cos(rad(angle))*(radius/2)
py = 75 + sin(rad(angle))*(radius/2)
Graphics.SetBox px, py, 5,5, ARGB(255,0,0,0)
Graphics.SetLine width/8,75, px, py, ARGB(255,0,0,0)
angle2 = 0
For i=0 To width
   px2 = width/8 + cos(rad(angle2))*(radius/2)
   py2 = 75 + sin(rad(angle2))*(radius/2)
   Graphics.SetPoint width/8+radius/2+i, py2, ARGB(255,0,0,255)
   angle2 = angle2 - frequency2
Next
Circle width/8+radius/2+x, py, 5, 0,0,0
angle = angle - frequency
x = x +1
iF x >= width-134 Then
  x=0
  angle=0
End iF
Graphics.SetLine px, py, width/8+radius/2+x, py, ARGB(255,0,0,0)
Text Font,0, 185,  "y = sin x", 255,255,255  
Text Font,200, 185,"px= " & px, 255,255,255
Text Font,420, 185,"py= " & py, 255,255,255
Graphics.Display
Graphics.SetfPS 200
Wend
WinEnd

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE) or Key.Pressed(0)
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub

Sub Text(Fo, xPos,yPos, txt, r0,g0,b0)
   Graphics.SetText txt,xPos,yPos,Fo,ARGB(255,r0,g0,b0)
End Sub    

Function Rad(r)
   Rad = (r*pi)/180
End Function

Sub Circle(xj, yj, r, r1,g1,b1)
   Dim f, ry, rx, x, y
   f = 1-r: ry = -2*r: y=r
   Graphics.SetPoint xj, yj + r, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj, yj - r, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj + r, yj, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj - r, yj, ARGB(255,r1,g1,b1)
   While x < y
   iF f >= 0 Then
      y  = y -1
      ry = ry+2
      f  = f +ry
   End iF
   x  = x +1
   rx = rx+2
   f  = f + rx+1
   Graphics.SetPoint xj + x, yj + y, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj - x, yj + y, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj + x, yj - y, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj - x, yj - y, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj + y, yj + x, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj - y, yj + x, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj + y, yj - x, ARGB(255,r1,g1,b1)
   Graphics.SetPoint xj - y, yj - x, ARGB(255,r1,g1,b1)
   Wend
End Sub


Window 256,256,1
'Graphics.SetIcon "Atom.ico"

Dim Height, Width, hwnd, hdc
Dim ax,ay,bx,by,cx,cy,px,py,n,steps

ax=10: px=10: cy=10
ay=Height-10: by=Height-10
bx=Width-10 : cx=Width/2
py=ay : steps=20000

ClsColor 12,230,40
For n=0 To steps
   Graphics.SetPoint px,py,ARGB(255,0,0,255)
   Select Case Rand(0,2)
       case 0
            px = (px + ax) / 2.0
            py = (py + ay) / 2.0
       case 1
            px = (px + bx) / 2.0
            py = (py + by) / 2.0
       case 2
            px = (px + cx) / 2.0
            py = (py + cy) / 2.0
   End Select          
Next        
Graphics.Display
WaitKey
WinEnd

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate                                                
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight                  
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub  

Function Rand(ra, rb)
   Rand = Math.GetRndInt(ra,rb)
End Function

Sub WaitKey()
   While Key.PressedAny()=0
      System.ProcessMessages
   Wend
End Sub


[matthew]

That Sine Wave example was really impressive Peter.

[Guilect]

Hi peter,
Hi matthew,

I don't check the forum too often these days because it is usually rather quiet here now.
Then I checked and viola, activity.

peter, you wanted a challenge, then doing a complete platformer using Win32 API should be just that.

I tried a few of your demos above. They are neat.

[Deleted]

Thanks Matthew.
Try once Mandel Bug. It needs some moments.

Hi Guilect,
Welcome to the forum.

Yes, I will try to write a game. But at first I need an Api-library for me. This will take some minutes.
It appears to me that DirectX doesn't correctly work here. I noticed a strong flickering, when I am driving in Full screen.
It is a pity. The library which I made, works good. I want still the libtrary widen. (Particle and more Maths, and so on).

Here, some demos.

Dim Height, Width, hwnd, hdc
Dim przelx,przely,x,y,a2,b2,a,b,z,c,x2,y2,ix,iy,Font

Window 640,480,1
Font = Graphics.CreateFont("times",24)

ClsColor 200,200,248
Text Font,128,60,"     BUG MANDELBROT     ",255,255,255
Text Font,148,90,"Press SPACE BAR to start",255,255,255
Graphics.Display
WaitKey
ClsColor 0,0,0
przelx = 3 / 640
przely = 2 / 480
For x=0 To 639
  For y=0 To 479
     a = 0
     b = 0
     c = 0
     x2 = przelx * x - 2
     y2 = przely * y - 1
     Do While c < 50
    a2 = a * a - b * b
        b2 = 2 * a * b
    a = a2 + x2
    b = b2 + y2
    z = a * a + b * b
    if z >= 4 Then Exit Do
    c = c + 1
     Loop
     if c = 50 Then
        Graphics.SetPoint x,y, ARGB(255,0,0,0)
     ElseiF c < 17 Then
    Graphics.SetPoint x,y, ARGB(255,(245-((17-c)*3)),0,0)
     ElseiF c < 33 Then
      Graphics.SetPoint x,y, ARGB(255,245,((c-16)*16)-16,0)
     Else
    Graphics.SetPoint x,y, ARGB(255,641-(c*12), 245,((c-32)*15))
     End iF
  Next
  Graphics.Display  
Next
WaitKey
WinEnd

Function EscKey()
   EscKey = Key.Pressed(VK_ESCAPE)
   iF Key.Pressed(0) Then EscKey =27  
End Function

Sub WinEnd()
   Graphics.Terminate
   Mouse.Terminate
   Key.Terminate
   Sound.Terminate
End Sub

Sub Window(xWidth, xHeight, winmode)
   Graphics.Initialize xWidth, xHeight, winmode, 32  
   Key.Initialize
   Mouse.Initialize
   Sound.Initialize
   Width = Graphics.GetScreenWidth
   Height= Graphics.GetScreenHeight
   hwnd  = System.Gethwnd
   Hdc   = Dll.CallApi("user32","GetDC",hwnd)
End Sub
   
Sub ClsColor(r1,g1,b1)
   Graphics.Clear ARGB(255,r1,g1,b1)
End Sub

Sub Text(Fo, xPos,yPos, txt, r0,g0,b0)
   Graphics.SetText txt,xPos,yPos,Fo,ARGB(255,r0,g0,b0)
End Sub

Sub WaitKey()
   While Key.PressedAny() =0  
      System.ProcessMessages
   Wend
End Sub


include "library.b2d"

Window 800,600,0
ColorKey 0,0,0

Dim fire,fz,x,y,xang,yang,Font,Kame
Fire= LoadBmp("bmp/fireball32.bmp",48,48,32)
Font= LoadBmp("bmp/cfont.bmp",32,32,96)
kame= LoadBmp("bmp/kamille.bmp",800,600,0)

While EscKey()=0
SetBmp kame,0,0,1,1,0
iText font,192,32,"Psycho Balls",1,2
x = (width/2) *sin(rad(xang)) *0.95
y = (height/2)*cos(rad(yang)) *0.97
xang = xang + 1.17
yang = yang + 1.39
SetBmp Fire, x+(width/2)-32, y+(height/2)-32,1,1,fz
SetBmp Fire,-x+(width/2)-32, y+(height/2)-32,1.2,1.2,fz
SetBmp Fire, x+(width/2)-32,-y+(height/2)-32,1.2,1.2,fz
SetBmp Fire,-x+(width/2)-32,-y+(height/2)-32,1,1,fz
fz = fz +1
iF fz=32 Then fz=0
Graphics.Display
Graphics.SetfPS 60
Wend
WinEnd


Attachments:

[Deleted]

And the last demo for this thread.

include "library.b2d"

Window 1024,768,1
ColorKey 0,0,0

Dim bild,font
bild = LoadBmp("bmp/rainbow.bmp",320,240,0)
font = LoadBmp("bmp/afont.bmp",32,32,60)

ClsColor 255,0,0
While EscKey()=0
iText font,64,8,"CLICK AND MOVE",2,1
iF Mouse.LeftButton = True Then
  clsColor 255,0,0
  SetBmp bild,0,0,Mouse.x/200,Mouse.y/200,0
End iF
Graphics.Display
Graphics.SetFPS 60
wend
WinEnd

Attachments:

[matthew]

That Fractal was really good Peter. It displayed very fast.