Hot Demos

Do you have something to share with us? A tip for newbies, perhaps? Post it here.
Post Reply
peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Hot Demos

Post by peter » Tue May 29, 2012 4:42 pm

Hi,

Some demos.

Code: Select all

Include "library.cb"

SCREEN 640,480,32,1
font = LoadFont("courier",24)
SetFont font 
FrameLimit 90

Global col,anzahl,xscreen,yscreen,ymitte,xmitte,i,aSpeed#

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

Dim x#(1000) 
Dim y#(1000) 

Dim angle#(1000) 
Dim speed#(1000) 
Dim sinus#(360)  
Dim cosinus#(360)

For i=1 To anzahl
   x(i) = xmitte
   y(i) = ymitte
   angle(i)= Rand(1,360)
   speed(i)= Rand(1,3)
Next i

For i=0 To 360
   sinus(i)  = Sin(i)
   cosinus(i)= Cos(i)
Next i

Function xMove(x1#,w#,sp#)
Return x1 + Cosinus(int(w))*sp
End Function

Function yMove(y1#,w#,sp#)
Return y1 + Sinus(int(w))*sp
End Function

PlaySound "cosmobumm.wav"
While EscapeKey()=0 
ClearScreen(2,2,2)
For i=0 To anzahl
   aSpeed = Distance(xmitte, ymitte, x(i), y(i)) /200 * speed(i)+1
   x(i) = xMove(x(i), angle(i), aSpeed)
   y(i) = yMove(y(i), angle(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
      angle(i)= Rand(1,360)
      speed(i) = Rand(1,3)
   End If
   col= Int(speed(i)*100 - 55)
   Oval(Int(x(i)),Int(y(i)),6,6,col,col,col)
Next i
xmitte = MouseX()
ymitte = MouseY()
DrawScreen OFF
Wend
Last edited by peter on Sun Jul 27, 2014 11:54 pm, edited 1 time in total.

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 4:44 pm

Another Demo: Water

Code: Select all

Include "library.cb"

SCREEN 600,800,32,1
FrameLimit 60
font=LoadFont("cour",28)
SetFont font

Dim x(1000) 
Dim y(1000) 
Dim Xv#(1000)
Dim Yv#(1000)
Dim LifeSpan(1000) 
Global Xstart,Ystart,i,bild,drop

'drop = LoadBmp("bmp/drop",0)
'bild = LoadBmp("bmp/bild",0)

Function ParticleInit()
Xstart = ScreenWidth() /15
Ystart = ScreenHeight() /15
For i=0 To 1000
    LifeSpan(i) = Rand(1,500)
    X(i)  = Xstart
    Y(i)  = Ystart
    Yv(i) = Rand(1,4)
    Xv(i) = Rand(1,8) 
Next i
End Function

ParticleInit()
While EscapeKey()=0
ClearScreen(0,0,0)
'DrawImage bild,0,0
For i=0 To 1000
Oval(x(i),y(i),8,8, Rand(64,128),rand(128,255),255)
x(i)  = x(i) + Xv(i)
y(i)  = y(i) + Yv(i)
Yv(i) = Yv(i) + .8
If y(i) >= ScreenHeight() Then  
   Yv(i) = Yv(i)-(Yv(i) * rnd(1.1,1.4))   
   y(i)  = ScreenHeight()
End If
LifeSpan(i) = LifeSpan(i) -1
If LifeSpan(i) <=0 Then
   LifeSpan(i) = Rand(1,500)
   x(i)  = Xstart
   y(i)  = Ystart
   Yv(i) = Rand(1,4)
   Xv(i) = Rand(1,8) 
End If
Next i
SetText(300,16,"COOL WATER",128,128,Rand(64,255))
DrawScreen OFF
Wend

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 4:46 pm

A few stars

Code: Select all

include "library.cb"

Screen 800,600,16,1
font= LoadFont("times",28)
SetFont font

Global xRes,yRes
Dim xStar(250)
Dim yStar(250)
Dim speed(250)

xRes =800
yRes =600 

Function InitStars()
Dim i
For i = 1 To 250
   xStar(i) = Rand(1, xRes -2)
   yStar(i) = Rand(1, yRes -2)
   speed(i) = Rand(1, 4)
Next i 
End Function

Function MoveStars()
Dim i
For i = 1 To 250 
Oval(xStar(i),yStar(i),8,6, Rand(64,128),128,128)
xStar(i) = xStar(i) + speed(i)
If xStar(i) > xRes 
   xStar(i)= 0
   yStar(i) = Rand(1, yRes -2)
   speed(i) = Rand(1, 4)
   End If
Next i
End Function

InitStars()

While EscapeKey() =0
ClearScreen(0,0,0)
MoveStars()
SetText(360,16,"STARS",0,255,0)
DrawScreen OFF
Wend

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 4:47 pm

Something about pixel.

Code: Select all

Include "library.cb"

SCREEN 320,240,16,1

font=LoadFont("courier",24)
SetFont font
ClearKeys

Function BigPixel(x1,y1,x2,y2,w,h)
Dim x,y,r,g,b,Col
x = x1
y = y1
While y <= y2-h 
Col = GetPixel(x,y)
r = GetColorR (Col)
g = GetColorG (Col)
b = GetColorB (Col)
Color r,g,b        
Box x,y,w,h 
x = x + w
If x >= x2 - w Then
   x = x1
   y = y + h
End If
Wend    
End Function

Global bild
bild= LoadImage("bmp/bild.bmp")
ResizeImage bild,320,240
  
DrawImage bild,0,0
SetText(50,16,"PIXELS ARE NOW 1x1",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,2,2) 
SetText(50,16,"PIXELS ARE NOW 2x2",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,4,4) 
SetText(50,16,"PIXELS ARE NOW 4x4",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,6,6) 
SetText(50,16,"PIXELS ARE NOW 6x6",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,8,8) 
SetText(50,16,"PIXELS ARE NOW 8x8",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,10,10) 
SetText(50,16,"PIXELS ARE NOW 10x10",255,55,155)
DrawScreen OFF
WaitKey

DrawImage bild,0,0
BigPixel(0,0,640,480,12,12) 
SetText(50,16,"PIXELS ARE NOW 12x12",255,55,155)
DrawScreen OFF
WaitKey

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 10:11 pm

Collision test.

Code: Select all

Include "library.cb"

SCREEN 640,480,16,1
FrameLimit 200
font=LoadFont("courier",44)
SetFont font

Function Triangle(x1,y1,x2,y2,r,g,b)
Color r,g,b 
Line x1,y1,x1+x2,y1+y2
Line x1,y1,x1-x2,y1+y2
Line x1-x2,y1+y2,x1+x2,y1+y2
End Function

Global px1,py1,px2,py2
py1=200:px2=640:py2=200 

While EscapeKey()=0 
ClearScreen(0,0,0)
Color 0,255,0
Circle px1,py1,60,0
Triangle(px2,py2-40,60,80,255,0,0)

If CircleOverlap(px1,py1,30,px2-15,py2,30) =1 
   Color 255,255,255   
   Circle px2-15,py2,30,0    
   SetText(240,16,"BUMMS!",0,255,0)   
End iF   

px1 = px1 +1: If px1 >=640 Then px1=-32
px2 = px2 -1: iF px2 <=-64 Then px2=660
DrawScreen OFF
Wend

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 10:13 pm

Sines Text.

Code: Select all

Include "library.cb"

SCREEN 640,480,32,1
FrameLimit 90
font=LoadFont("courier",28)
SetFont font

Global tl,i,x,letter$,z$
z= "HELLO AND WELCOME TO OUR COOLBASIC FORUM !" 
tl = Len(z)
Dim y(44) As Float
Dim angle(44) As Float

For i=1 To tl
   angle(i) = 360-i*(360/tl) 
   y(i) = 240
Next i

While EscapeKey()=0 
ClearScreen(0,0,0)
for x=1 To tl
   angle(x) = angle(x) +1
   if angle(x) = 360 Then angle(x) =0
   letter = Mid(z, x ,1)
   y(x) = y(x) + Sin(angle(x))
   SetText(20+x*14,y(x), letter, 255,255,255)
Next x
DrawScreen
Wend

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Tue May 29, 2012 10:15 pm

A Snake.

Code: Select all

Include "library.cb"

SCREEN 640,480,16,1
FrameLimit 60
font=LoadFont ("cour",24)
SetFont font

Dim x(60)
Dim y(60)
Global i,col,r,g,b

col=2047791
While EscapeKey()=0
ClearScreen(255,255,255)
For i=59 To 1 Step -1
x(i) = x(i-1)
y(i) = y(i-1)
Next i
x(0)= MouseX()-20
y(0)= MouseY()-20
For i=1 To 59
Oval(x(i)+10,y(i)+10,20,20,i*4,i*4,i*4)
Next i
SetText(200,16,"MOVE YOUR MOUSE!",0,0,0)
DrawScreen
Wend
End

User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 4:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck » Fri Jun 01, 2012 3:08 pm

Oh, is that kind of Cour font exist?
Konstaduck.net
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

User avatar
Awaclus
Forum Veteran
Posts: 2938
Joined: Tue Aug 28, 2007 2:50 pm
Location: Sulkava

Re: Hot Demos

Post by Awaclus » Fri Jun 01, 2012 3:16 pm

Konstaduck wrote:Oh, is that kind of Cour font exist?
Dat English.

Of course it exists, why would peter use a nonexistent font?
Every day I'm reshuffling.
[22:19] <@Grandi> Ha! Tiesin koko ajan, että Awaclus_ oli Awaclus. Hieno peitenimimerkki, mutta Grandia et huiputtanut.

User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 4:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck » Fri Jun 01, 2012 5:55 pm

I was just wondering, that I do not see the same font ...
Konstaduck.net
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Fri Jun 01, 2012 7:37 pm

Hi,

If you do not have this font then take another font. For example "ARIAL" or "COURIER" or whatever. cour font exists in Windows7. :o

User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 4:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck » Sun Jun 03, 2012 9:37 am

But for us, that kind of a font that works only on Windows 7, should be used, for example, if someone is using Windows Xp... :o
Konstaduck.net
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Sun Jun 03, 2012 12:31 pm

Hi Konstaduck,

WindowsXP ? Never heard. :D

User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 4:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck » Sun Jun 03, 2012 2:14 pm

It has come to Windows Vista before. Do not you really know it? Here is a picture of it: http://urly.fi/1zw
EDIT:

Actually, see this yet: http://en.wikipedia.org/wiki/Windows_XP

Konstaduck.net
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

User avatar
valscion
Moderator
Moderator
Posts: 1585
Joined: Thu Dec 06, 2007 8:46 pm
Location: Espoo
Contact:

Re: Hot Demos

Post by valscion » Sun Jun 03, 2012 5:41 pm

Konstaduck wrote:It has come to Windows Vista before. Do not you really know it? Here is a picture of it: http://urly.fi/1zw
EDIT:

Actually, see this yet: http://en.wikipedia.org/wiki/Windows_XP

I really think peter was just joking.
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com

User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 4:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck » Sun Jun 03, 2012 6:30 pm

When you never know ...
Konstaduck.net
<Ize> Pitäs tehä allekirjotus..
<Ize> Vois keksiä jonkin nasahtavan sanonnan..
<Ize> Siitä tulis upea legenda ja kaikki vaihtaisivat allekirjoituksensa siihen.
<Ize> Ehkä ei kuitenkaa...

User avatar
Awaclus
Forum Veteran
Posts: 2938
Joined: Tue Aug 28, 2007 2:50 pm
Location: Sulkava

Re: Hot Demos

Post by Awaclus » Sun Jun 03, 2012 8:44 pm

Konstaduck wrote:When you never know ...
Windows XP was by far the most popular operating system when peter registered on these forums. I find it pretty hard to believe that a programmer wouldn't have even heard of it.

Note to self:
Attachments
dont feed the troll.png
dont feed the troll.png (815.94 KiB) Viewed 11247 times
Every day I'm reshuffling.
[22:19] <@Grandi> Ha! Tiesin koko ajan, että Awaclus_ oli Awaclus. Hieno peitenimimerkki, mutta Grandia et huiputtanut.

peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter » Sun Jun 03, 2012 10:35 pm

LOL :lol:
Last edited by peter on Thu Jul 31, 2014 6:42 pm, edited 1 time in total.

User avatar
Jare
Moderator
Moderator
Posts: 860
Joined: Mon Aug 27, 2007 10:18 pm
Location: Helsinki

Re: Hot Demos

Post by Jare » Sun Jun 03, 2012 11:55 pm

Now back on topic! This is not a chat.

Post Reply

Who is online

Users browsing this forum: No registered users and 1 guest