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 »

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 »

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 »

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 »

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 »

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 »

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 »

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 3:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck »

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...
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Hot Demos

Post by Awaclus »

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

Of course it exists, why would peter use a nonexistent font?
User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 3:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck »

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 »

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 3:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck »

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 »

Hi Konstaduck,

WindowsXP ? Never heard. :D
User avatar
Konstaduck
Advanced Member
Posts: 267
Joined: Sat Dec 17, 2011 3:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck »

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: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: Hot Demos

Post by valscion »

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 3:09 pm
Location: Nurmijärvi, Finland
Contact:

Re: Hot Demos

Post by Konstaduck »

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...
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Hot Demos

Post by Awaclus »

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:
peter
Active Member
Posts: 123
Joined: Mon Oct 22, 2007 2:31 pm

Re: Hot Demos

Post by peter »

LOL :lol:
Last edited by peter on Thu Jul 31, 2014 6:42 pm, edited 1 time in total.
User avatar
Jare
Devoted Member
Posts: 877
Joined: Mon Aug 27, 2007 10:18 pm
Location: Pori
Contact:

Re: Hot Demos

Post by Jare »

Now back on topic! This is not a chat.
Post Reply