Sorry your browser is not supported!

BN2, a prime generator is simple to create, and testing for prime is even easier. I even had a homework assignment in C++ to create a prime generator years ago. You sure about that contest?

Back to top

Profile PM Email Website

BN2 Productions

21

Years of Service

User Offline

Joined: 22nd Jan 2004

Location:

Posted: 11th Nov 2009 10:01

Well the contest was looking for a formula that ONLY returned primes. Algorithms don't count, but this was years ago, and I might have some details fuzzy on it.

The idea, as I recall, is any number you plug in for X will return a prime number (I assume any integer for X, but didn't look into it much).

Great Quote:
"Time...LINE??? Time isn't made out of lines...it is made out of circles. That is why clocks are round!" -Caboose

Back to top

Profile PM

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 11th Nov 2009 16:10

You can't write a formula to produce prime numbers. The fact you can't divide them by anything means you can't scale up to find like numbers which is what a formula does.

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 13th Nov 2009 18:37

ok... People indicated an interest in this challenge and so far only 1 entry. What gives?

Enjoy your day.

Back to top

Profile PM

demons breath

21

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 13th Nov 2009 20:01

busy week (3 courseworks in, couple of all-nighters trying to cram everything in meaning I'm feeling pretty wiped atm). Ima start tomorrow though.

"The fools may crash down upon us in thunderous waves, but we shall Jeku slap them back from whence they came"
-BiggAdd Oct 28th 2009

Back to top

Profile PM Website

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 13th Nov 2009 20:53

We have three days and everyone is keeping their entries til the last minute so their highly technical and superior code doesn't give any clues away to the opposition...

TDK

Back to top

Profile PM Email Website

demons breath

21

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 14th Nov 2009 18:28 Edited at: 15th Nov 2009 14:15

Darn. Went to start and my trial period's over - disc'll be here some time this week but I forgot it when I went home so I'm having it mailed up.

EDIT: I'll try it in DarkGDK and then convert the code over and hope it still runs

"The fools may crash down upon us in thunderous waves, but we shall Jeku slap them back from whence they came"
-BiggAdd Oct 28th 2009

Back to top

Profile PM Website

pictionaryjr

16

Years of Service

User Offline

Joined: 12th Mar 2009

Location:

Posted: 16th Nov 2009 02:46 Edited at: 16th Nov 2009 02:48

I'm not really sure what everyone meant by the prime number thing, but here's two things that tell prime numbers that I wipped up.

This one says prime numbers starting from the lowest prime number and going up:

sync on : sync rate 200 : cls
do
n=3
for t=2 to n
   t#=t
   p=0
   for num=0 to t
      num#=num
      if num<>0 and num<>1 and num<>t
         c#=t#/num#
         if c#=int(c#)
            p=1
         endif
      endif
   next num
   if p=0
      print "Prime number: ";
      print str$(t)
      print "Press any key to continue"
      suspend for key
   endif
   n=n+1
   sync
   cls
next t
loop

This one you enter a number and it tells you if it is a prime number or not:

sync on : sync rate 200 : cls
do
input "Integer: ";n
if prime(n)=0
   print "This is a prime number"
else
   print "This is not a prime number"
endif
print "Press any key to try again"
suspend for key
sync
cls
loop

function prime(num)
num#=num
p=0
if num<>0 and num<>1
   for t=0 to num
      t#=t
      if t<>0 and t<>1 and t<>num
         c#=num#/t#
         if c#=int(c#)
            p=1
         endif
      endif
   next t
else
   p=1
endif
endfunction p

EDIT:
BTW 0 and 1 are not prime numbers. Just so everyone knows.

Back to top

Profile PM Email

demons breath

21

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 16th Nov 2009 03:52

You could probably save some time by stopping it checking numbers after the halfway point.

For example 100 isn't going to be divisible by anything larger than 50 so your for num=0 to t line in there could be a for num=0 to (t/2)+1 instead, which would mean you had to do a little extra calculating there, but when you got to numbers like 1235897 or something it would save a hell of a lot of time.

"The fools may crash down upon us in thunderous waves, but we shall Jeku slap them back from whence they came"
-BiggAdd Oct 28th 2009

Back to top

Profile PM Website

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 16th Nov 2009 04:03

the original challenge was a 'sidescrolling tile based program' note. that is not a game necessarily, just a scrolling map that is tile based. just pointing that out.

New Site! Check it out \/

Back to top

Profile PM Website

Phaelax

DBPro Master

22

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 16th Nov 2009 07:13 Edited at: 16th Nov 2009 08:18

Quote: "I ran this switching bitflipmode between 0 and 1 in the setup.ini file just for fun."

What you mean? I have no ini files for DBC. Nice method though, didn't think bitmap commands would be that fast. I got 60fps with your code Latch.

Drawing squares with BOX I only managed 30fps. Using images, paste image or sprites were less than 6fps. I tried using 3D planes and even that was only 4fps. So at this point I'm not even bothering to paste my code.

Back to top

Profile PM Email Website

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 16th Nov 2009 13:24 Edited at: 16th Nov 2009 13:26

@Phaelax

Quote: "What you mean? I have no ini files for DBC. Nice method though, didn't think bitmap commands would be that fast. I got 60fps with your code Latch."

Busted!

You must not be a sticky reader:

Info about Setup.ini and other useful DBC stuff

I'll bet that 60 fps turns into 700...

I'll attach the setup.ini file here as well so you can grab it. Download it to the same directory as DB.exe.

Enjoy your day.

Attachments

Login to view attachments

Back to top

Profile PM

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 16th Nov 2009 20:03

Last day guys! Even if Latch is the only entry I hope we all learned something from this at least.

As I recall, the challenge setter can place an entry too but just won't be judged. The entry list is a bit lonely so I'll do just that.

set display mode 800,600,16
sync on
sync rate 0
`load music "uncap.mp3",1


cls rgb(155,50,50)
get image 1,0,0,16,16,1
cls rgb(50,155,50)
get image 2,0,0,16,16,1
cls rgb(50,50,155)
get image 3,0,0,16,16,1


BitmapTerrain = 2
create bitmap BitmapTerrain,800+16,600+16



set current bitmap 0


do
	gosub ScrollHandle
	gosub DisplayTerrain
	text 0,0,str$(screen fps())
	sync
loop

	ScrollHandle:
		if ScrollX < 16 then inc ScrollX else ScrollX = 0 : TerrainFlag = 0
	return


	DisplayTerrain:
		if TerrainFlag = 0
			TerrainFlag = 1
			copy bitmap BitmapTerrain,16,0,815,599, BitmapTerrain,0,0,799,599
			set current bitmap BitmapTerrain
			for lpy = 0 to 37
				paste image rnd(2)+1,800,lpy*16
			next lpy
			set current bitmap 0
		endif
		copy bitmap BitmapTerrain,ScrollX,0,799+ScrollX,599, 0,0,0,799,599
	return

Back to top

Profile PM Email

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 16th Nov 2009 20:29 Edited at: 16th Nov 2009 23:28

Quote: "the original challenge was a 'sidescrolling tile based program' note. that is not a game necessarily, just a scrolling map that is tile based. just pointing that out."

Good point!

The closing of the challenge is later tonight, and anyone who thinks their prime number program has a cat in hells chance of winning is in for a big shock!...

TDK

Back to top

Profile PM Email Website

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 16th Nov 2009 22:19

uhhh... I think this challenge is a scrolling 2d screen maker.

Enjoy your day.

Back to top

Profile PM

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 16th Nov 2009 23:35

Damn forum did it to me again - I went to the last page with the button and responded to the last post at the bottom.

But, I wasn't actually on the last page. If there is only a single post on the 'real' last page, sometimes it doesn't appear for me.

I've edited my last post above to quote the message I thought I was following and all should make sense...

My challenge entry:

Rem DBC Programming Challenge - Side Scroller
Rem Demo Using Tiles & Arrays (c) TDK_Man Nov 2009

Gosub Setup
Gosub Create_Tiles
Gosub Generate_Message
Gosub Build_Screen

Do
  If LeftKey() Then Gosub Scroll_Left
  If RightKey() Then Gosub Scroll_Right
  If SpaceKey() Then Gosub Enter_Message
  Sync
Loop
End

Scroll_Left:
  If XTileOffset > 0
    Set Current Bitmap 1
    Dec XPixelOffset,ScrollSpeed
    If XPixelOffset < 0
      XPixelOffset=16
      Dec XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return

Scroll_Right:
  If XTileOffset < ScrnTileWidth
    Set Current Bitmap 1
    Inc XPixelOffset,ScrollSpeed
    If XPixelOffset >= 16
      XPixelOffset=0
      Inc XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return

Build_Screen:
  Create Bitmap 1,1024,768
  For Nx=0 To 49
    For Ny=0 To 37
      Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
    Next Nx
  Next Ny
  Sync
  Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
  Set Current Bitmap 0
  Paste Image 1000,0,0
  Set Text Font "Tahoma"
  Ink RGB(255,255,255),RGB(0,0,255)
Return

Create_Tiles:
  Create Bitmap 1,800,600
  Rem Create 19 different random shaded tiles...
  For N=1 To 19
    CLS RGB(255,255,255)
    Ink RGB(0,0,0),0: Box 1,1,15,15
    C=Rnd(55)+200
    Ink RGB(C,C,255),0: Box 1,1,14,14
    Get Image N,0,0,16,16: Rem Store tiles in images 1 to 20
  Next N
  Rem and 1 blue one...
  CLS RGB(255,255,255)
  Ink RGB(0,0,0),0: Box 1,1,15,15
  Ink RGB(0,0,128),0: Box 1,1,14,14
  Get Image 20,0,0,16,16
  Set Current Bitmap 0
  Delete Bitmap 1
Return

Generate_Message:
  Rem Place Random Tiles Into The Tiles Array. For This Example, We'll  Limit The Landscape
  Rem To Being 10,000 Tiles Wide...
  Create Bitmap 1,800,600
  CLS 0
  For LandscapeX = 0 To ScrnTileWidth-1
    For LandscapeY = 0 To 37
      Tiles(LandscapeX,LandscapeY)=Rnd(18)+1
    Next LandscapeY
  Next LandscapeX
  Rem Now Replace Random Tiles With Dark Blue Tiles For Message...
  CLS 0: Ink RGB(255,255,255),0
  Text 0,0,T$
  For Ny=0 To Text Height(T$)
    For Nx=0 To Text Width(T$)
      PixCol = Point(Nx,Ny)
      If PixCol <> 0
        Tiles(Nx,Ny+11)=20
      Endif
    Next Nx
  Next Ny
  Sync
  Set Current Bitmap 0
  Delete Bitmap 1
Return

Enter_Message:
  Set Current Bitmap 0
  Delete Bitmap 1
  CLS 0: Sync
  Print "User Message:": Print
  Print "Please enter the message you wish to have as the background scrolling message..."
  Input ">: ";T$
  CLS: Sync
  Center Text 400,200,"Please wait while arrays are initiialised (time taken depends on message length)..."
  Gosub Generate_Message
  Gosub Build_Screen
Return

Setup:
  Set Display Mode 800,600,16
  Sync On: Sync Rate 0: CLS
  Hide Mouse
  Randomize Timer()
  Dim Tiles(49999,37): Rem Max horizontal tiles 50000, 38 Vertical
  XTileOffset=0
  XPixelOffset=0
  ScrollSpeed=1
  ScrnTileWidth=10000: Rem Limit number of tiles across on this level to 10,000
  T$=" Welcome To TDK's Side Scrolling DBC Challenge Entry!..."
  Center Text 400,200,"Please wait while arrays are initiialised (approx 20 seconds)..."
  Center Text 400,240,"When Running, Use Cursor Left/Right To Scroll - Space Bar To Edit Scroll Message"
  Set Text Opaque
Return

Rem DBC Programming Challenge - Side Scroller
Rem Demo Using Tiles & Arrays (c) TDK_Man Nov 2009

Gosub Setup
Gosub Create_Tiles
Gosub Generate_Message
Gosub Build_Screen

Do
  If LeftKey() Then Gosub Scroll_Left
  If RightKey() Then Gosub Scroll_Right
  If SpaceKey() Then Gosub Enter_Message
  Sync
Loop
End

Scroll_Left:
  If XTileOffset > 0
    Set Current Bitmap 1
    Dec XPixelOffset,ScrollSpeed
    If XPixelOffset < 0
      XPixelOffset=16
      Dec XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return

Scroll_Right:
  If XTileOffset < ScrnTileWidth
    Set Current Bitmap 1
    Inc XPixelOffset,ScrollSpeed
    If XPixelOffset >= 16
      XPixelOffset=0
      Inc XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return

Build_Screen:
  Create Bitmap 1,1024,768
  For Nx=0 To 49
    For Ny=0 To 37
      Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
    Next Nx
  Next Ny
  Sync
  Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
  Set Current Bitmap 0
  Paste Image 1000,0,0
  Set Text Font "Tahoma"
  Ink RGB(255,255,255),RGB(0,0,255)
Return

Create_Tiles:
  Create Bitmap 1,800,600
  Rem Create 19 different random shaded tiles...
  For N=1 To 19
    CLS RGB(255,255,255)
    Ink RGB(0,0,0),0: Box 1,1,15,15
    C=Rnd(55)+200
    Ink RGB(C,C,255),0: Box 1,1,14,14
    Get Image N,0,0,16,16: Rem Store tiles in images 1 to 20
  Next N
  Rem and 1 blue one...
  CLS RGB(255,255,255)
  Ink RGB(0,0,0),0: Box 1,1,15,15
  Ink RGB(0,0,128),0: Box 1,1,14,14
  Get Image 20,0,0,16,16
  Set Current Bitmap 0
  Delete Bitmap 1
Return

Generate_Message:
  Rem Place Random Tiles Into The Tiles Array. For This Example, We'll  Limit The Landscape
  Rem To Being 10,000 Tiles Wide...
  Create Bitmap 1,800,600
  CLS 0
  For LandscapeX = 0 To ScrnTileWidth-1
    For LandscapeY = 0 To 37
      Tiles(LandscapeX,LandscapeY)=Rnd(18)+1
    Next LandscapeY
  Next LandscapeX
  Rem Now Replace Random Tiles With Dark Blue Tiles For Message...
  CLS 0: Ink RGB(255,255,255),0
  Text 0,0,T$
  For Ny=0 To Text Height(T$)
    For Nx=0 To Text Width(T$)
      PixCol = Point(Nx,Ny)
      If PixCol <> 0
        Tiles(Nx,Ny+11)=20
      Endif
    Next Nx
  Next Ny
  Sync
  Set Current Bitmap 0
  Delete Bitmap 1
Return

Enter_Message:
  Set Current Bitmap 0
  Delete Bitmap 1
  CLS 0: Sync
  Print "User Message:": Print
  Print "Please enter the message you wish to have as the background scrolling message..."
  Input ">: ";T$
  CLS: Sync
  Center Text 400,200,"Please wait while arrays are initiialised (time taken depends on message length)..."
  Gosub Generate_Message
  Gosub Build_Screen
Return

Setup:
  Set Display Mode 800,600,16
  Sync On: Sync Rate 0: CLS
  Hide Mouse
  Randomize Timer()
  Dim Tiles(49999,37): Rem Max horizontal tiles 50000, 38 Vertical
  XTileOffset=0
  XPixelOffset=0
  ScrollSpeed=1
  ScrnTileWidth=10000: Rem Limit number of tiles across on this level to 10,000
  T$=" Welcome To TDK's Side Scrolling DBC Challenge Entry!..."
  Center Text 400,200,"Please wait while arrays are initiialised (approx 20 seconds)..."
  Center Text 400,240,"When Running, Use Cursor Left/Right To Scroll - Space Bar To Edit Scroll Message"
  Set Text Opaque
Return

Note: As my entry scrolls when you use the cursor keys, I've only put the FPS to display in the routines that actually do the work because when not scrolling, I get 1000 fps.

TDK

Back to top

Profile PM Email Website

pictionaryjr

16

Years of Service

User Offline

Joined: 12th Mar 2009

Location:

Posted: 16th Nov 2009 23:39

btw just so everyone knows, i wasn't entering the challenge i was just showing the whole prime generator and stuff that had a conversation going on.

Back to top

Profile PM Email

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 16th Nov 2009 23:50

Ah, I see... hijacking the thread eh?

TDK

Back to top

Profile PM Email Website

pictionaryjr

16

Years of Service

User Offline

Joined: 12th Mar 2009

Location:

Posted: 17th Nov 2009 04:42

haha no. was just commenting on someones comment said something about it and took it as a challenge

Back to top

Profile PM Email

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 17th Nov 2009 08:00

Alright, time's up the Challenge is closed.

We have 2 entries!
Latch
TDK

Latch's entry used bitmaps, a small bitmap with enough space to fit a whole column was filled with the needed tiles and copied to the screen. The screen is then moved one pixels width to the left again by usage of bitmaps as default screen = bitmap 0. I didn't know copying bitmap 0,x1,y1,x2,y2 to 0,x1,y1,x2,y2 was faster than if it was anyother bitmap.

TDK's entry used get/paste image, an interesting approach as I've never seen or think it could be that fast! The image of what's need to be displayed is prepared and stored into an image, then pasted onto the screen as you scroll. The array usage was a bit excessive I must say, but the end resaults sure looks nice.

Testing were done using my 2 computers.
Laptop: Latch = 330fps, TDK = 192fps
PC: Latch = 1000fps, TDK = 214

The 1000fps is no joke nor is it a misreading, the tiles where flying across the screen fast! The funny thing is I cannot reproduce this...

TDK has a more readily usable and graphically appealing entry but latch hits the mark as speed was the real challenge here. So if you ever plan to scroll tiles in the future, bitmaps are the way to go!

Resaults:

Runner-up

TDK

Winner

Latch

Back to top

Profile PM Email

Phaelax

DBPro Master

22

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 17th Nov 2009 11:54 Edited at: 17th Nov 2009 11:55

These are just some challenge suggestions:

ATM challenge

Bob would like to withdraw X $US from an ATM. The cash machine will only accept the transaction
if X is a multiple of 5, and Bob's account balance has enough cash to perform the withdrawal 
transaction (including bank charges). For each successful withdrawal the bank charges 0.50 $US.
Calculate Bob's account balance after an attempted transaction.
Input

Positive integer 0 < X <= 2000 - the amount of cash which Bob wishes to withdraw.
Nonnegative number 0<= Y <= 2000 with two digits of precision - Bob's initial account balance.
Output

Output the account balance after the attempted transaction, given as a number with two digits 
of precision. If there is not enough money in the account to complete the transaction, output
the current bank balance.

[i]Example - Successful Transaction[/i]
[b]Input:[/b]
30 120.00

[b]Output:[/b]
89.50

[i]Example - Incorrect Withdrawal Amount (not multiple of 5)[/i]
[b]Input:[/b]
42 120.00

[b]Output:[/b]
120.00

[i]Example - Insufficient Funds[/i]
[b]Input:[/b]
300 120.00

[b]Output:[/b]
120.00

Bob would like to withdraw X $US from an ATM. The cash machine will only accept the transaction
if X is a multiple of 5, and Bob's account balance has enough cash to perform the withdrawal 
transaction (including bank charges). For each successful withdrawal the bank charges 0.50 $US.
Calculate Bob's account balance after an attempted transaction.
Input

Positive integer 0 < X <= 2000 - the amount of cash which Bob wishes to withdraw.
Nonnegative number 0<= Y <= 2000 with two digits of precision - Bob's initial account balance.
Output

Output the account balance after the attempted transaction, given as a number with two digits 
of precision. If there is not enough money in the account to complete the transaction, output
the current bank balance.

[i]Example - Successful Transaction[/i]
[b]Input:[/b]
30 120.00

[b]Output:[/b]
89.50

[i]Example - Incorrect Withdrawal Amount (not multiple of 5)[/i]
[b]Input:[/b]
42 120.00

[b]Output:[/b]
120.00

[i]Example - Insufficient Funds[/i]
[b]Input:[/b]
300 120.00

[b]Output:[/b]
120.00

> SELECT * FROM users WHERE clue > 0
> 0 rows returned

Back to top

Profile PM Email Website

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 17th Nov 2009 12:41 Edited at: 17th Nov 2009 12:44

Congrats Latch!

Quote: "The array usage was a bit excessive I must say, but the end resaults sure looks nice. "

Just to let you know that I chose the method I used so as to create a usable scrolling 'play area' - in case anyone wanted to apply the method to their own 2D Sonic-type game.

Rather than just randomly fill the array with tiles, you can use a tile map (hence the inclusion of a text message). Tiles can be placed randomly, but their positions are stored - so you can scroll backwards as well as forwards and see the same tiles.

I have a scrolling map editor partially finished somewhere...

But, I've not checked Latch's entry out, so his may also have the same functionality.

Even so, this wasn't asked for in the challenge and I did know the fps hit would mean it would have little chance of winning but I still wanted to do it for fun.

TDK

Back to top

Profile PM Email Website

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 17th Nov 2009 20:01

Thanks! Tdks entry was quite attractive and shows a usable sroller skeleton. I should go back at some point and add some user interactability (word?) and the ability to store a complete map to my entry.

Quote: "I didn't know copying bitmap 0,x1,y1,x2,y2 to 0,x1,y1,x2,y2 was faster than if it was anyother bitmap."

I wonder if it has something to do with video versus system memory. I think it's faster to BLiT (transfer data) between the same type than from one type to the other - but don't quote me on that!

Enjoy your day.

Back to top

Profile PM

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 17th Nov 2009 20:37

Falling Objects' Reactions

In 2D, have a minimum of 3 different items fall from the top of the screen to the bottom (they don't have to fall at once). When the item reaches the bottom, it must have some kind of reaction. For example, a ball may bounce. A flower pot might smash. A drop of water may splash.

The graphics can be as simple as a box for each item, but it's always nice when a bit of creativity is thrown in the pot. Each box/shape must have it's own reaction.

The reactions can be whatever you want. You could have the screen flash like an explosion, or simply have the object roll or tumble away.

Judging will based on number of different objects/effects. Variety and creativity add points.

Deadline is Sunday November 22, Midnight GMT (Monday Morning)

Enjoy your day.

Back to top

Profile PM

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 18th Nov 2009 00:36

nice challenge, I'll enter this one.

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 18th Nov 2009 04:32

Quote: "Deadline is Sunday November 22"

Yay - my birthday!

Back to top

Profile PM Email Website

Phaelax

DBPro Master

22

Years of Service

User Offline

Joined: 16th Apr 2003

Location: Metropia

Posted: 18th Nov 2009 22:48

Cool, what's that put you at, about 46?

> SELECT * FROM users WHERE clue > 0
> 0 rows returned

Back to top

Profile PM Email Website

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 19th Nov 2009 00:31

Add another five years onto that!

TDK

Back to top

Profile PM Email Website

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 19th Nov 2009 05:06

@TDK

Quote: "Add another five years onto that! "

Your crystal is obviously broken

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 20th Nov 2009 01:38 Edited at: 20th Nov 2009 20:24

Here's mines, use the mouse to move around and Right-click for the red ball.

Entry1:

`Ashingda27 - Falling Objects Reations
`A flow of balls will pour out, right-click for the red ball which
`will destroy the grey balls.

set display mode 640,480,16
sync on
sync rate 60

gosub Initialize

do
	gosub Game
	ink rgb(255,255,255),0
	text 0,0,"FPS "+str$(screen fps())
	copy bitmap 1,0
	sync
	cls
loop

Initialize:
		for lp = 0 to 8
			c = 240/((lp/4.0)+1)
			ink rgb(c,c,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 1,0,0,17,17,1

for lp = 0 to 8
			c = 240/((lp/4.0)+1)
			ink rgb(c,0,0),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 2,0,0,17,17,1

for lp = 8 to 0 step -1
			c = 240/((lp/4.0)+1)
			ink rgb(c,c,c),0
			box 8-lp,0,8+lp,16
		next lp
		get image 200,0,0,16,16,1

MapX = 29
		MapY = 19
		dim Unit(MapX,MapY)

dim MaxBall(0)
		MaxBall(0) = 201
		m = MaxBall(0)
		dim Ball(m)
		dim BallX(m)
		dim BallY(m)
		dim Act(m)
		dim MoveX(m)
		dim MoveY(m)

ink rgb(240,200,180),0
		box 0,0,15,15
		ink rgb(70,50,40),0
		box 1,1,15,15
		ink rgb(140,100,80),0
		box 1,1,14,14
		get image 300,0,0,16,16,1

for lpy = 0 to MapY
		for lpx = 0 to MapX
			if lpx = 0 or lpx = MapX or lpy = MapY
				Unit(lpx,lpy) = 300
			endif
		next lpx
		next lpy

create bitmap 1,640,480
	return

Game:
		gosub GameHandle
		gosub GameDisplay
	return

GameHandle:
			mx = mousex()
			my = mousey()
			mc = mouseclick()

tx = mx/16
			if tx < 1 then tx = 1
			if tx > MapX-1 then tx = MapX-1

if Spawn > 0
				dec Spawn
			else
				c = 1 : Spawn = 4
				if mc > 1 then c = 2
				CreateBall(tx,c)
			endif

for lp = 1 to MaxBall(0)

if Ball(lp)
					if Act(lp) = 0
						if Ball(lp) = 1
							MoveD(lp)
							if rnd(1)
								MoveL(lp)
								MoveR(lp)
							else
								MoveR(lp)
								MoveL(lp)
							endif
						endif
						if Ball(lp) = 2
							MoveD2(lp)
						endif
					endif

if Act(lp)
						Act(lp) = Act(lp) - 4
					endif
				endif

next lp

return

GameDisplay:
			for lpy = 0 to MapY
			for lpx = 0 to MapX
				x = lpx*16
				y = 16+lpy*16
				if Unit(lpx,lpy) = 300
					paste image Unit(lpx,lpy),x,y,1
				endif
			next lpx
			next lpy

for lp = 1 to MaxBall(0)
				if Ball(lp)
					x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
					y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
					paste image Ball(lp),x,y,1
				endif
			next lp

paste image 200,tx*16,0
		return

Function CreateBall(x,b)
	for lp = 1 to MaxBall(0)
		if Ball(lp) = 0
			Ball(lp) = b
			if lp = MaxBall(0) then Ball(lp) = 2
			BallX(lp) = x
			BallY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = lp
			MoveX(lp) = 0
			MoveY(lp) = 0
			Act(lp) = 0
			lp = MaxBall(0)
		endif
	next lp
EndFunction

Function MoveD(lp)
	if Unit(BallX(lp),BallY(lp)+1) = 0
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	endif
EndFunction

Function MoveD2(lp)
	if Unit(BallX(lp),BallY(lp)+1) < MaxBall(0)
		if Unit(BallX(lp),BallY(lp)+1) > 0
			Ball(Unit(BallX(lp),BallY(lp)+1)) = 0
		endif
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	else
		Ball(lp) = 0
		Unit(BallX(lp),BallY(lp)) = 0
	endif
EndFunction

Function MoveL(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)+1) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Function MoveR(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)+1) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

`Ashingda27 - Falling Objects Reations
`A flow of balls will pour out, right-click for the red ball which
`will destroy the grey balls.

set display mode 640,480,16
sync on
sync rate 60


gosub Initialize


do
	gosub Game
	ink rgb(255,255,255),0
	text 0,0,"FPS "+str$(screen fps())
	copy bitmap 1,0
	sync
	cls
loop



	Initialize:
		for lp = 0 to 8
			c = 240/((lp/4.0)+1)
			ink rgb(c,c,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 1,0,0,17,17,1

		for lp = 0 to 8
			c = 240/((lp/4.0)+1)
			ink rgb(c,0,0),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 2,0,0,17,17,1

		for lp = 8 to 0 step -1
			c = 240/((lp/4.0)+1)
			ink rgb(c,c,c),0
			box 8-lp,0,8+lp,16
		next lp
		get image 200,0,0,16,16,1


		MapX = 29
		MapY = 19
		dim Unit(MapX,MapY)

		dim MaxBall(0)
		MaxBall(0) = 201
		m = MaxBall(0)
		dim Ball(m)
		dim BallX(m)
		dim BallY(m)
		dim Act(m)
		dim MoveX(m)
		dim MoveY(m)


		ink rgb(240,200,180),0
		box 0,0,15,15
		ink rgb(70,50,40),0
		box 1,1,15,15
		ink rgb(140,100,80),0
		box 1,1,14,14
		get image 300,0,0,16,16,1

		for lpy = 0 to MapY
		for lpx = 0 to MapX
			if lpx = 0 or lpx = MapX or lpy = MapY
				Unit(lpx,lpy) = 300
			endif
		next lpx
		next lpy


		create bitmap 1,640,480
	return

	Game:
		gosub GameHandle
		gosub GameDisplay
	return


		GameHandle:
			mx = mousex()
			my = mousey()
			mc = mouseclick()

			tx = mx/16
			if tx < 1 then tx = 1
			if tx > MapX-1 then tx = MapX-1

			if Spawn > 0
				dec Spawn
			else
				c = 1 : Spawn = 4
				if mc > 1 then c = 2
				CreateBall(tx,c)
			endif

			for lp = 1 to MaxBall(0)

				if Ball(lp)
					if Act(lp) = 0
						if Ball(lp) = 1
							MoveD(lp)
							if rnd(1)
								MoveL(lp)
								MoveR(lp)
							else
								MoveR(lp)
								MoveL(lp)
							endif
						endif
						if Ball(lp) = 2
							MoveD2(lp)
						endif
					endif

					if Act(lp)
						Act(lp) = Act(lp) - 4
					endif
				endif

			next lp



		return


		GameDisplay:
			for lpy = 0 to MapY
			for lpx = 0 to MapX
				x = lpx*16
				y = 16+lpy*16
				if Unit(lpx,lpy) = 300
					paste image Unit(lpx,lpy),x,y,1
				endif
			next lpx
			next lpy


			for lp = 1 to MaxBall(0)
				if Ball(lp)
					x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
					y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
					paste image Ball(lp),x,y,1
				endif
			next lp

			paste image 200,tx*16,0
		return



Function CreateBall(x,b)
	for lp = 1 to MaxBall(0)
		if Ball(lp) = 0
			Ball(lp) = b
			if lp = MaxBall(0) then Ball(lp) = 2
			BallX(lp) = x
			BallY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = lp
			MoveX(lp) = 0
			MoveY(lp) = 0
			Act(lp) = 0
			lp = MaxBall(0)
		endif
	next lp
EndFunction



Function MoveD(lp)
	if Unit(BallX(lp),BallY(lp)+1) = 0
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	endif
EndFunction

Function MoveD2(lp)
	if Unit(BallX(lp),BallY(lp)+1) < MaxBall(0)
		if Unit(BallX(lp),BallY(lp)+1) > 0
			Ball(Unit(BallX(lp),BallY(lp)+1)) = 0
		endif
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	else
		Ball(lp) = 0
		Unit(BallX(lp),BallY(lp)) = 0
	endif
EndFunction

Function MoveL(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)+1) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Function MoveR(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)+1) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Back to top

Profile PM Email

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 20th Nov 2009 02:04

Does there have to be three different reactions or are we just making one reaction and many instances of an object?

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 20th Nov 2009 17:37

Quote: "Does there have to be three different reactions or are we just making one reaction and many instances of an object"

There should be different reactions for different objects. At least 3 different objects and 3 different reactions.

@Ashingda
Hey that's pretty cool. Strangely soothing... Nice work!

Enjoy your day.

Back to top

Profile PM

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 20th Nov 2009 18:12 Edited at: 20th Nov 2009 20:23

Thanks Latch

. Although I only have 2 different objects, I'm still working on an upgrade entry.

Got it done.

Entry2:

`Ashingda27 - Falling Objects Reations

set display mode 640,480,16
sync on
sync rate 60

gosub Initialize

do
	gosub Game
	ink rgb(255,255,255),0
	text 0,0,"FPS "+str$(screen fps())
	copy bitmap 1,0
	sync
	cls
loop

Initialize:
		randomize timer()
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 1,0,0,17,17,1

for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/3
			ink rgb(c,c2,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 2,0,0,17,17,1

for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c2,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 3,0,0,17,17,1

for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 4,0,0,17,17,1

for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c/2,c/2),0
			box 8-lp,0,8+lp,16
		next lp
		get image 200,0,0,16,16,1

for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			box 8-lp,0,8+lp,16
		next lp
		get image 201,0,0,16,16,1

cls
		ink rgb(255,255,255),0
		for lp = 0 to 2
			r = lp*8
			line r,0,16-r,16
			line 0,r,16,16-r
		next lp
		get image 400,0,0,16,16,1

MapX = 29
		MapY = 19
		dim Unit(MapX,MapY)

dim MaxBall(0)
		m = 200
		MaxBall(0) = m
		dim Ball(m)
		dim BallX(m)
		dim BallY(m)
		dim Act(m)
		dim MoveX(m)
		dim MoveY(m)
		dim Smash(m)
		dim Dr(m)

dim Tube(2)
		dim TubeX(2)
		dim TubeC(2)

TubeX(1) = (rnd(454)+16)/16
		TubeX(2) = (rnd(454)+16)/16

ink rgb(240,200,180),0
		box 0,0,15,15
		ink rgb(70,50,40),0
		box 1,1,15,15
		ink rgb(140,100,80),0
		box 1,1,14,14
		get image 300,0,0,16,16,1

for lpy = 0 to MapY
		for lpx = 0 to MapX
			if lpx = 0 or lpx = MapX or lpy = MapY
				Unit(lpx,lpy) = 300
			endif
		next lpx
		next lpy

create bitmap 2,480,336
		create bitmap 1,640,480
	return

Game:
		gosub GameHandle
		gosub GameDisplay
	return

GameHandle:
			mx = mousex()
			my = mousey()
			mc = mouseclick()

for lp = 0 to 2
				if lp = 0
					TubeX(lp) = mx/16
				  else
					if TubeC(lp) > 0
						TubeC(lp) = TubeC(lp) - 1
					  else
						TubeX(lp) = TubeX(lp) + (rnd(2)-1)
						TubeC(lp) = rnd(50)
						if rnd(25)/25 = 1 then TubeX(lp) = (rnd(454)+16)/16
					endif
				endif

if TubeX(lp) < 1 then TubeX(lp) = 1
				if TubeX(lp) > MapX-1 then TubeX(lp) = MapX-1
				
			next lp

if Spawn > 0
				dec Spawn
			else
				Spawn = 8

if mc = 1
					tx = TubeX(0)
					CreateBall(tx,2)
				endif

for lp = 1 to 2
					select rnd(2)
						case 0 : c = 1 : endcase
						case 1 : c = 3 : endcase
						case 2 : c = 4 : endcase
						case default : c = 1 : endcase
					endselect
					tx = TubeX(lp)
					CreateBall(tx,c)
				next lp
			endif

for lp = 1 to MaxBall(0)

if Ball(lp)
					if Act(lp) = 0
						if Ball(lp) = 1
							MoveD(lp)
							if rnd(1)
								MoveL(lp)
								MoveR(lp)
							else
								MoveR(lp)
								MoveL(lp)
							endif
						endif
						if Ball(lp) = 2
							MoveD2(lp)
						endif
						if Ball(lp) = 3
							MoveD(lp)
							if Dr(lp)
								MoveRU(lp)
								MoveLU(lp)
							else
								MoveLU(lp)
								MoveRU(lp)
							endif
						endif
						if Ball(lp) = 4
							MoveD(lp)
							if Dr(lp)
								MoveR4(lp)
								MoveL4(lp)
							else
								MoveL4(lp)
								MoveR4(lp)
							endif
						endif
					endif

if Act(lp)
						Act(lp) = Act(lp) - 2
					endif
				endif

next lp

return

GameDisplay:
			gosub DisplayTerrain
			gosub DisplayObjects
		return

DisplayTerrain:
				if TerrainFlag = 0
					TerrainFlag = 1
					set current bitmap 2
						for lp = 1 to 336
							lpm# = 1+(lp/100.0)
							ink rgb(80/lpm#,100/lpm#,120/lpm#),0
							box 0,336-(lp-1),479,336-(lp-1)
						next lp

for lpy = 0 to MapY
						for lpx = 0 to MapX
							x = lpx*16
							y = 16+lpy*16
							if Unit(lpx,lpy) = 300
								paste image Unit(lpx,lpy),x,y,1
							endif
						next lpx
						next lpy
					set current bitmap 1
				endif
				copy bitmap 2,0,0,479,335, 1,0,0,479,335
			return

DisplayObjects:
				for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						paste image Ball(lp),x,y,1
						if smash(lp)
							r = 16-Act(lp)
							circle x+8,y+24-r,r
						endif
					endif
				next lp

for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						if smash(lp)
							r = 16-Act(lp)
							c = 255/(1+r/10.0)
							ink rgb(c,c,c),0
							circle x+8,y+24-r,r
						endif
					endif
				next lp

for lp = 1 to 2
					x = TubeX(lp)
					paste image 201,TubeX(lp)*16,0
					paste image 201,TubeX(lp)*16,16
				next lp

x = TubeX(0)
				paste image 200,TubeX(0)*16,0
				paste image 200,TubeX(0)*16,8
			return

Function CreateBall(x,b)
	if Unit(x,1) = 0
		for lp = 1 to MaxBall(0)
			if Ball(lp) = 0
				Ball(lp) = b
				if lp = MaxBall(0) then Ball(lp) = 2
				BallX(lp) = x
				BallY(lp) = 0
				Unit(BallX(lp),BallY(lp)) = lp
				MoveX(lp) = 0
				MoveY(lp) = 0
				Act(lp) = 0
				Smash(lp) = 0
				Dr(lp) = rnd(1)
				lp = MaxBall(0)
			endif
		next lp
	endif
EndFunction

Function MoveD(lp)
	if Unit(BallX(lp),BallY(lp)+1) = 0
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	endif
EndFunction

Function MoveD2(lp)
	if Unit(BallX(lp),BallY(lp)+1) < MaxBall(0)
		Smash(lp) = 0
		if Unit(BallX(lp),BallY(lp)+1) > 0
			Ball(Unit(BallX(lp),BallY(lp)+1)) = 0
			Smash(lp) = 1
		endif
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	else
		Ball(lp) = 0
		Unit(BallX(lp),BallY(lp)) = 0
	endif
EndFunction

Function MoveL(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)+1) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Function MoveR(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)+1) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Function MoveLU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)-1,BallY(lp)) = 0
			if Unit(BallX(lp)-1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 0
				MoveX(lp) = -1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) - 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction

Function MoveRU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)+1,BallY(lp)) = 0
			if Unit(BallX(lp)+1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 1
				MoveX(lp) = 1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) + 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction

Function MoveL4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			Dr(lp) = 0
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction

Function MoveR4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Dr(lp) = 1
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction

`Ashingda27 - Falling Objects Reations

set display mode 640,480,16
sync on
sync rate 60


gosub Initialize


do
	gosub Game
	ink rgb(255,255,255),0
	text 0,0,"FPS "+str$(screen fps())
	copy bitmap 1,0
	sync
	cls
loop



	Initialize:
		randomize timer()
		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 1,0,0,17,17,1

		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/3
			ink rgb(c,c2,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 2,0,0,17,17,1


		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c2,c),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 3,0,0,17,17,1


		for lp = 0 to 8
			c = 255/((lp/4.0)+1)
			c2 = c/1.5
			ink rgb(c2,c,c2),0
			if lp = 8 then ink rgb(10,10,10),0
			circle 8,8,lp
		next lp
		get image 4,0,0,17,17,1


		for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c/2,c/2),0
			box 8-lp,0,8+lp,16
		next lp
		get image 200,0,0,16,16,1

		for lp = 8 to 0 step -1
			c = 255/((lp/4.0)+1)
			ink rgb(c,c,c),0
			box 8-lp,0,8+lp,16
		next lp
		get image 201,0,0,16,16,1

		cls
		ink rgb(255,255,255),0
		for lp = 0 to 2
			r = lp*8
			line r,0,16-r,16
			line 0,r,16,16-r
		next lp
		get image 400,0,0,16,16,1






		MapX = 29
		MapY = 19
		dim Unit(MapX,MapY)

		dim MaxBall(0)
		m = 200
		MaxBall(0) = m
		dim Ball(m)
		dim BallX(m)
		dim BallY(m)
		dim Act(m)
		dim MoveX(m)
		dim MoveY(m)
		dim Smash(m)
		dim Dr(m)


		dim Tube(2)
		dim TubeX(2)
		dim TubeC(2)

		TubeX(1) = (rnd(454)+16)/16
		TubeX(2) = (rnd(454)+16)/16

		ink rgb(240,200,180),0
		box 0,0,15,15
		ink rgb(70,50,40),0
		box 1,1,15,15
		ink rgb(140,100,80),0
		box 1,1,14,14
		get image 300,0,0,16,16,1

		for lpy = 0 to MapY
		for lpx = 0 to MapX
			if lpx = 0 or lpx = MapX or lpy = MapY
				Unit(lpx,lpy) = 300
			endif
		next lpx
		next lpy

		create bitmap 2,480,336
		create bitmap 1,640,480
	return

	Game:
		gosub GameHandle
		gosub GameDisplay
	return


		GameHandle:
			mx = mousex()
			my = mousey()
			mc = mouseclick()


			for lp = 0 to 2
				if lp = 0
					TubeX(lp) = mx/16
				  else
					if TubeC(lp) > 0
						TubeC(lp) = TubeC(lp) - 1
					  else
						TubeX(lp) = TubeX(lp) + (rnd(2)-1)
						TubeC(lp) = rnd(50)
						if rnd(25)/25 = 1 then TubeX(lp) = (rnd(454)+16)/16
					endif
				endif

				if TubeX(lp) < 1 then TubeX(lp) = 1
				if TubeX(lp) > MapX-1 then TubeX(lp) = MapX-1
				
			next lp

			if Spawn > 0
				dec Spawn
			else
				Spawn = 8

				if mc = 1
					tx = TubeX(0)
					CreateBall(tx,2)
				endif

				for lp = 1 to 2
					select rnd(2)
						case 0 : c = 1 : endcase
						case 1 : c = 3 : endcase
						case 2 : c = 4 : endcase
						case default : c = 1 : endcase
					endselect
					tx = TubeX(lp)
					CreateBall(tx,c)
				next lp
			endif

			for lp = 1 to MaxBall(0)

				if Ball(lp)
					if Act(lp) = 0
						if Ball(lp) = 1
							MoveD(lp)
							if rnd(1)
								MoveL(lp)
								MoveR(lp)
							else
								MoveR(lp)
								MoveL(lp)
							endif
						endif
						if Ball(lp) = 2
							MoveD2(lp)
						endif
						if Ball(lp) = 3
							MoveD(lp)
							if Dr(lp)
								MoveRU(lp)
								MoveLU(lp)
							else
								MoveLU(lp)
								MoveRU(lp)
							endif
						endif
						if Ball(lp) = 4
							MoveD(lp)
							if Dr(lp)
								MoveR4(lp)
								MoveL4(lp)
							else
								MoveL4(lp)
								MoveR4(lp)
							endif
						endif
					endif

					if Act(lp)
						Act(lp) = Act(lp) - 2
					endif
				endif

			next lp



		return


		GameDisplay:
			gosub DisplayTerrain
			gosub DisplayObjects
		return


			DisplayTerrain:
				if TerrainFlag = 0
					TerrainFlag = 1
					set current bitmap 2
						for lp = 1 to 336
							lpm# = 1+(lp/100.0)
							ink rgb(80/lpm#,100/lpm#,120/lpm#),0
							box 0,336-(lp-1),479,336-(lp-1)
						next lp

						for lpy = 0 to MapY
						for lpx = 0 to MapX
							x = lpx*16
							y = 16+lpy*16
							if Unit(lpx,lpy) = 300
								paste image Unit(lpx,lpy),x,y,1
							endif
						next lpx
						next lpy
					set current bitmap 1
				endif
				copy bitmap 2,0,0,479,335, 1,0,0,479,335
			return

			DisplayObjects:
				for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						paste image Ball(lp),x,y,1
						if smash(lp)
							r = 16-Act(lp)
							circle x+8,y+24-r,r
						endif
					endif
				next lp


				for lp = 1 to MaxBall(0)
					if Ball(lp)
						x = BallX(lp)*16 - MoveX(lp)*Act(lp)-1
						y = 15 + BallY(lp)*16 - MoveY(lp)*Act(lp)
						if smash(lp)
							r = 16-Act(lp)
							c = 255/(1+r/10.0)
							ink rgb(c,c,c),0
							circle x+8,y+24-r,r
						endif
					endif
				next lp

				for lp = 1 to 2
					x = TubeX(lp)
					paste image 201,TubeX(lp)*16,0
					paste image 201,TubeX(lp)*16,16
				next lp

				x = TubeX(0)
				paste image 200,TubeX(0)*16,0
				paste image 200,TubeX(0)*16,8
			return

Function CreateBall(x,b)
	if Unit(x,1) = 0
		for lp = 1 to MaxBall(0)
			if Ball(lp) = 0
				Ball(lp) = b
				if lp = MaxBall(0) then Ball(lp) = 2
				BallX(lp) = x
				BallY(lp) = 0
				Unit(BallX(lp),BallY(lp)) = lp
				MoveX(lp) = 0
				MoveY(lp) = 0
				Act(lp) = 0
				Smash(lp) = 0
				Dr(lp) = rnd(1)
				lp = MaxBall(0)
			endif
		next lp
	endif
EndFunction



Function MoveD(lp)
	if Unit(BallX(lp),BallY(lp)+1) = 0
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	endif
EndFunction

Function MoveD2(lp)
	if Unit(BallX(lp),BallY(lp)+1) < MaxBall(0)
		Smash(lp) = 0
		if Unit(BallX(lp),BallY(lp)+1) > 0
			Ball(Unit(BallX(lp),BallY(lp)+1)) = 0
			Smash(lp) = 1
		endif
		Act(lp) = 16
		MoveX(lp) = 0 : MoveY(lp) = 1
		Unit(BallX(lp),BallY(lp)) = 0
		BallY(lp) = BallY(lp) + 1
		Unit(BallX(lp),BallY(lp)) = lp
	else
		Ball(lp) = 0
		Unit(BallX(lp),BallY(lp)) = 0
	endif
EndFunction

Function MoveL(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)+1) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction

Function MoveR(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)+1) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
		endif
	endif
EndFunction


Function MoveLU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)-1,BallY(lp)) = 0
			if Unit(BallX(lp)-1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 0
				MoveX(lp) = -1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) - 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction

Function MoveRU(lp)
	if Act(lp) = 0 
		if BallY(lp) > 0
			if Unit(BallX(lp)+1,BallY(lp)) = 0
			if Unit(BallX(lp)+1,BallY(lp)-1) = 0
				Act(lp) = 16
				Dr(lp) = 1
				MoveX(lp) = 1 : MoveY(lp) = -1
				Unit(BallX(lp),BallY(lp)) = 0
				BallX(lp) = BallX(lp) + 1
				BallY(lp) = BallY(lp) - 1
				Unit(BallX(lp),BallY(lp)) = lp
			endif
			endif
		endif
	endif
EndFunction



Function MoveL4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)-1,BallY(lp)) = 0
			Act(lp) = 16
			Dr(lp) = 0
			MoveX(lp) = -1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) - 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction

Function MoveR4(lp)
	if Act(lp) = 0
		if Unit(BallX(lp)+1,BallY(lp)) = 0
			Dr(lp) = 1
			Act(lp) = 16
			MoveX(lp) = 1 : MoveY(lp) = 0
			Unit(BallX(lp),BallY(lp)) = 0
			BallX(lp) = BallX(lp) + 1
			Unit(BallX(lp),BallY(lp)) = lp
		endif
	endif
EndFunction

Back to top

Profile PM Email

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 20th Nov 2009 23:15 Edited at: 21st Nov 2009 19:58

Aaaahhh I only have 2 days

I have been working on one but i'm not sure if it will be done. grrrrrr. I have a glitch and can't find it lol

Edit:

got it working. Ignore anything about water

didn't get that to work, but i do have 4 types of objects(dust,fire,glass,bouncy ball)

rem Falling Objects by Caleb Stewart
rem DBC Challenge entry
Sync on
Sync rate 100

rem Dot Information
dim maxDot(0)
maxDot(0) = 10000
m = maxDot(0)
dim dots(m)
dim dotx#(m)
dim doty#(m)
dim dotType(m)
dim dotWeight#(m)
dim dotVolX#(m)
dim dotVolY#(m)
dim dotTimer(m)
dim dotData(m, 5)
dim freeDot(0) : freeDot(0) = 1
dim maxUpdate(0)

rem Environment information
dim gravx#(0) : gravx#(0) = 0.0
dim gravy#(0) : gravy#(0) = 0.8
dim windAng#(0) : windAng#(0) = 0.0
dim windForce#(0) : windForce#(0) = 0.0

rem Screen Map for collision
dim Screen(bitmap width(0), bitmap Height(0))

rem different types of dots
dim TYPE_BALL(0) : TYPE_BALL(0) = 1
dim TYPE_FIRE(0) : TYPE_FIRE(0) = 2
dim TYPE_GLASS(0) : TYPE_GLASS(0) = 3
dim TYPE_DUST(0) : TYPE_DUST(0) = 4
dim TYPE_NORM(0) : TYPE_NORM(0) = 5
dim TYPE_WATER(0) : TYPE_WATER(0) = 6

dropType = 1

set text size 5

do

ink rgb(255,255,255),0
   print "Screen FPS: "; Screen FPS()
   print "Press 1 - 5 to select a tool"
   PrintInstructions(dropType)

if mouseclick() = 1
      if hold = 0
         select dropType
            case TYPE_FIRE(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_FIRE(0))
               next x
            endcase
            case TYPE_GLASS(0)
               for x=-5 to 5
                   CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_GLASS(0))
               next x
               Hold = 1
            endcase
            case default
               if dropType <= 4 then CreateDot(mousex()+0.0,mousey()+0.0,dropType)
            endcase
         endselect
      endif
   else
      hold = 0
   endif

if dropType = 5
      x2 = sin(windAng#(0)) * 30
      y2 = cos(windAng#(0)) * 30
      line bitmap width(0)/2,bitmap height(0)/2,bitmap width(0)/2+x2,bitmap height(0)/2+y2

o# = mouseX() - bitmap width(0)/2 : a# = mousey() - bitmap height(0)/2
      windAng#(0) = wrapvalue(atanfull(o#,a#))
      if mouseclick() = 1
         if rlDown = 0 and windForce#(0) < 10.0
            windForce#(0) = windForce#(0) + 0.1
            rlDown = 1
         endif
      endif
      if mouseclick() = 2 and rlDown = 0 and windForce#(0) >= 0.0
         windForce#(0) = windForce#(0) - 0.1
      endif
      if mousemovez() > 0
         windForce#(0) = windForce#(0) + (mousemovez()/10)
      endif
      rlDown = 0
   endif

if val(inkey$()) >= 1 and val(inkey$()) <= 5
      dropType = val(inkey$())
   endif

updateDots()
   sync
   cls
loop

function PrintInstructions(Type)

select Type
      case 5
         print
         Print "Wind Tool:"
         print
         Print "Use up and down keys to change direction."
         Print "Use left and right mouse buttons or mouse wheel to change the force."
         print "Wind Angle = "; WindAng#(0)
         print "Wind Force = "; WindForce#(0)
         print
      endcase
      case TYPE_GLASS(0)
         print
         print "Glass Tool:"
         print
         print "Click to drop a plate of glass and watch it shatter!"
         print
      endcase
      case TYPE_FIRE(0)
         print
         print "Fire Tool:"
         print
         print "Click to send fire through the air!"
         print "Fire will burn up other dots!"
         print
      endcase
      case TYPE_BALL(0)
         print
         print "Ball Tool:"
         print
         print "Unlease the power of the super ball!"
         print "The higher you drop it from, the Higher it will go!"
         print
      endcase
      case TYPE_DUST(0)
         print
         print "Dust Tool:"
         print
         print "Drop the dust and  watch it stack."
         print "Use the wind tool to make it fly across the screen!"
         print
      endcase
   endselect

endfunction

rem Draw and update all the dots
function UpdateDots()
   for i = 0 to maxUpdate(0)
      if dots(i) = 1
         findDotFunction(i)
      endif
   next i
endfunction

rem Find the correct dot controller by type
function findDotFunction(i)

select dotType(i)
      case TYPE_BALL(0)
         controlBall(i)
      endcase
      case TYPE_DUST(0)
         controlDust(i)
      endcase
      case TYPE_NORM(0)
         controlNorm(i)
      endcase
      case TYPE_FIRE(0)
         controlFire(i)
      endcase
      case TYPE_WATER(0)
         controlWater(i)
      endcase
      case TYPE_GLASS(0)
         controlGlass(i)
      endcase
      case default
         controlNorm(i)
      endcase
   endselect

endfunction

function StartCollisionMatters(type)

select type
      case default
         exitfunction 1
      endcase
   endselect

endfunction 1

rem Create a dot. ready for updating.
function CreateDot(x#, y#, type)
   rem check to see if position is on screen
   if x# < 0 or x# > bitmap width(0)-1 or y# < 0 or y# > bitmap height(0)-1 then exitfunction
   rem if there is already a dot at this position, don't create it
   if screen(x#,y#) > 0 and StartCollisionMatters(type) = 1 then exitfunction
   rem if there are no more dots exit the function
   if freeDot(0) = -1 then exitfunction

weight# = findTypeWeight(type)
   index = freeDot(0)
   dots(index) = 1
   dotx#(index) = x#
   doty#(index) = y#
   dotType(index) = type
   dotWeight#(index) = weight#

rem Set the screen collision coordanet to the dot index
   screen(x#,y#) = index

rem Set Dot timer to the current time
   dotTimer(index) = timer()

rem If the max updated dot is less then this dot
   rem set it to this dot
   if maxUpdate(0) < index then maxUpdate(0) = index

rem search up
   while index < maxDot(0) and dots(index) = 1
      index = index + 1
   endwhile
   rem if no free spaces up
   if index = maxDot(0)
      rem then search down
      while index > 0
         if dots(index) = 0 then exit
         index = index - 1
      endwhile
      rem if no free spaces. set freeDot(0) to -1
      if index = 0 then index = -1
   endif
   freeDot(0) = index

endfunction

function DestroyDot(i)
   rem if the dot doesn't exist the exit the function
   if dots(i) = 0 then exitfunction

rem set collision position to 0
   screen(dotx#(i),doty#(i)) = 0
   rem set all values to 0
   dots(i) = 0
   dotx#(i) = 0.0
   doty#(i) = 0.0
   dotType(i) = 0
   dotWeight#(i) = 0.0
   dotTimer(i) = 0
   for x=i to maxUpdate(0)
      dots(x) = dots(x+1)
      dotx#(x) = dotx#(x+1)
      doty#(x) = doty#(x+1)
      dotType(x) = dotType(x+1)
      dotWeight#(x) = dotWeight#(x+1)
      dotTimer(x) = dotTimer(x+1)
   next x
   freeDot(0) = maxUpdate(0)
   maxUpdate(0) = freeDot(0) - 1
endfunction

rem Find the weight of the ball according to its type
function findTypeWeight(type)

select type
      case TYPE_BALL(0)
         weight# = 0.5
      endcase
      case TYPE_FIRE(0)
         weight# = -0.5
      endcase
      case TYPE_NORM(0)
         weight# = 0.8
      endcase
      case TYPE_DUST(0)
         weight# = 0.3
      endcase
      case TYPE_WATER(0)
         weight# = 1.2
      endcase
      case TYPE_GLASS(0)
         weight# = 0.5
      endcase
      case default
         weight# = 0.0
      endcase
   endselect

endfunction weight#

rem Type Controller functions
function controlDust(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)

if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# < 0 then ny# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = 3
         else
            collision = 2
         endif
      else
         if nx# ! x#
            collision = 1
         endif
      endif
      dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
      c = screen(nx#, ny#)
   else
      collision = 0
   endif

if collision ! 0 then dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   endif
   screen(dotx#(i),doty#(i)) = i

ink rgb(255,255,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlBall(i)
   rem will eventually control a bouncy ball type of dot

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   if dotData(i, 0) = 0 then dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   if dotData(i, 1) = 0 then dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

if dotVolY#(i) > 10.0 then dotVolY#(i) = 10.0
   if dotVolY#(i) < -10.0 then dotVolY#(i) = -10.0
   if dotVolX#(i) > 10.0 then dotVolX#(i) = 10.0
   if dotVolX#(i) < -10.0 then dotVolX#(i) = -10.0

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = collision | 1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = collision | 1
   if ny# < 0 then ny# = 0 : collision = collision | 2
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = collision | 2

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = collision | 3
         else
            collision = collision | 2
         endif
      else
         if nx# ! x#
            collision = collision | 1
         endif
      endif
   endif

screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   else
      dotVolX#(i) = dotVolX#(i) * -1
      dotData(i, 0) = 1
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   else
      dotVolY#(i) = dotVolY#(i) * -1
      dotData(i, 1) = 1
   endif
   screen(dotx#(i),doty#(i)) = i

ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlFire(i)
   rem will eventually control a fire type of dot(burns through other dots)
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

if dotVolY#(i) > 3.0 then dotVolY#(i) = 3.0
   if dotVolY#(i) < -3.0 then dotVolY#(i) = -3.0
   if dotVolX#(i) > 3.0 then dotVolX#(i) = 3.0
   if dotVolX#(i) < -3.0 then dotVolX#(i) = -3.0

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      collision = screen(nx#, ny#)
   endif

screen(x#,y#) = 0
   if collision ! 0 or (timer()-dotTimer(i)) > 500
      if collision > 0
         DestroyDot(i)
         if dotType(collision) ! TYPE_FIRE(0)
            DestroyDot(collision)
         endif
      else
         DestroyDot(i)
      endif
   else
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(dotx#(i), doty#(i)) = i
   endif

ink rgb(255,0,0),0
   dot dotx#(i),doty#(i)
endfunction

function controlWater(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

Collision = 0
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

if screen(nx#,ny#+1) > 0
         collision = 1
      endif

if collision > 0
      if screen(nx#+1,ny#+1) = 0
         nx# = nx# + 1
         ny# = ny# + 1
         break
      else
         if screen(nx#-1,ny#+1) = 0
            nx# = nx# - 1
            ny# = ny# + 1
         else
            nx# = x#
            ny# = y#
         endif
      endif
   endif

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i

ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)

endfunction

function controlGlass(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

if screen(nx#,ny#) > 0 and screen(nx#,ny#) ! i or collision ! 0

if dotVolY#(i) > 10 or dotVolX#(i) > 10
         if dotData(i, 0) = 0
            dotVolY#(i) = rnd(10)-5.0
            dotVolX#(i) = rnd(10)-5.0
            dotData(i, 0) = 1
            dotData(i, 1) = timer()
         endif
      else
      endif

collision = 1

else
      if collision = 0
         dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
         dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
      endif
   endif

if collision = 0
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
   endif

ink rgb(210, 205, 220),0
   dot dotx#(i),doty#(i)

endfunction

function controlNorm(i)
   rem Idk
endfunction

rem Falling Objects by Caleb Stewart
rem DBC Challenge entry
Sync on
Sync rate 100

rem Dot Information
dim maxDot(0)
maxDot(0) = 10000
m = maxDot(0)
dim dots(m)
dim dotx#(m)
dim doty#(m)
dim dotType(m)
dim dotWeight#(m)
dim dotVolX#(m)
dim dotVolY#(m)
dim dotTimer(m)
dim dotData(m, 5)
dim freeDot(0) : freeDot(0) = 1
dim maxUpdate(0)

rem Environment information
dim gravx#(0) : gravx#(0) = 0.0
dim gravy#(0) : gravy#(0) = 0.8
dim windAng#(0) : windAng#(0) = 0.0
dim windForce#(0) : windForce#(0) = 0.0

rem Screen Map for collision
dim Screen(bitmap width(0), bitmap Height(0))

rem different types of dots
dim TYPE_BALL(0) : TYPE_BALL(0) = 1
dim TYPE_FIRE(0) : TYPE_FIRE(0) = 2
dim TYPE_GLASS(0) : TYPE_GLASS(0) = 3
dim TYPE_DUST(0) : TYPE_DUST(0) = 4
dim TYPE_NORM(0) : TYPE_NORM(0) = 5
dim TYPE_WATER(0) : TYPE_WATER(0) = 6

dropType = 1

set text size 5

do

   ink rgb(255,255,255),0
   print "Screen FPS: "; Screen FPS()
   print "Press 1 - 5 to select a tool"
   PrintInstructions(dropType)

   if mouseclick() = 1
      if hold = 0
         select dropType
            case TYPE_FIRE(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_FIRE(0))
               next x
            endcase
            case TYPE_GLASS(0)
               for x=-5 to 5
                   CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_GLASS(0))
               next x
               Hold = 1
            endcase
            case default
               if dropType <= 4 then CreateDot(mousex()+0.0,mousey()+0.0,dropType)
            endcase
         endselect
      endif
   else
      hold = 0
   endif

   if dropType = 5
      x2 = sin(windAng#(0)) * 30
      y2 = cos(windAng#(0)) * 30
      line bitmap width(0)/2,bitmap height(0)/2,bitmap width(0)/2+x2,bitmap height(0)/2+y2

      o# = mouseX() - bitmap width(0)/2 : a# = mousey() - bitmap height(0)/2
      windAng#(0) = wrapvalue(atanfull(o#,a#))
      if mouseclick() = 1
         if rlDown = 0 and windForce#(0) < 10.0
            windForce#(0) = windForce#(0) + 0.1
            rlDown = 1
         endif
      endif
      if mouseclick() = 2 and rlDown = 0 and windForce#(0) >= 0.0
         windForce#(0) = windForce#(0) - 0.1
      endif
      if mousemovez() > 0
         windForce#(0) = windForce#(0) + (mousemovez()/10)
      endif
      rlDown = 0
   endif

   if val(inkey$()) >= 1 and val(inkey$()) <= 5
      dropType = val(inkey$())
   endif

   updateDots()
   sync
   cls
loop

function PrintInstructions(Type)

   select Type
      case 5
         print
         Print "Wind Tool:"
         print
         Print "Use up and down keys to change direction."
         Print "Use left and right mouse buttons or mouse wheel to change the force."
         print "Wind Angle = "; WindAng#(0)
         print "Wind Force = "; WindForce#(0)
         print
      endcase
      case TYPE_GLASS(0)
         print
         print "Glass Tool:"
         print
         print "Click to drop a plate of glass and watch it shatter!"
         print
      endcase
      case TYPE_FIRE(0)
         print
         print "Fire Tool:"
         print
         print "Click to send fire through the air!"
         print "Fire will burn up other dots!"
         print
      endcase
      case TYPE_BALL(0)
         print
         print "Ball Tool:"
         print
         print "Unlease the power of the super ball!"
         print "The higher you drop it from, the Higher it will go!"
         print
      endcase
      case TYPE_DUST(0)
         print
         print "Dust Tool:"
         print
         print "Drop the dust and  watch it stack."
         print "Use the wind tool to make it fly across the screen!"
         print
      endcase
   endselect

endfunction

rem Draw and update all the dots
function UpdateDots()
   for i = 0 to maxUpdate(0)
      if dots(i) = 1
         findDotFunction(i)
      endif
   next i
endfunction

rem Find the correct dot controller by type
function findDotFunction(i)

   select dotType(i)
      case TYPE_BALL(0)
         controlBall(i)
      endcase
      case TYPE_DUST(0)
         controlDust(i)
      endcase
      case TYPE_NORM(0)
         controlNorm(i)
      endcase
      case TYPE_FIRE(0)
         controlFire(i)
      endcase
      case TYPE_WATER(0)
         controlWater(i)
      endcase
      case TYPE_GLASS(0)
         controlGlass(i)
      endcase
      case default
         controlNorm(i)
      endcase
   endselect

endfunction

function StartCollisionMatters(type)

   select type
      case default
         exitfunction 1
      endcase
   endselect

endfunction 1

rem Create a dot. ready for updating.
function CreateDot(x#, y#, type)
   rem check to see if position is on screen
   if x# < 0 or x# > bitmap width(0)-1 or y# < 0 or y# > bitmap height(0)-1 then exitfunction
   rem if there is already a dot at this position, don't create it
   if screen(x#,y#) > 0 and StartCollisionMatters(type) = 1 then exitfunction
   rem if there are no more dots exit the function
   if freeDot(0) = -1 then exitfunction

   weight# = findTypeWeight(type)
   index = freeDot(0)
   dots(index) = 1
   dotx#(index) = x#
   doty#(index) = y#
   dotType(index) = type
   dotWeight#(index) = weight#

   rem Set the screen collision coordanet to the dot index
   screen(x#,y#) = index

   rem Set Dot timer to the current time
   dotTimer(index) = timer()

   rem If the max updated dot is less then this dot
   rem set it to this dot
   if maxUpdate(0) < index then maxUpdate(0) = index

   rem search up
   while index < maxDot(0) and dots(index) = 1
      index = index + 1
   endwhile
   rem if no free spaces up
   if index = maxDot(0)
      rem then search down
      while index > 0
         if dots(index) = 0 then exit
         index = index - 1
      endwhile
      rem if no free spaces. set freeDot(0) to -1
      if index = 0 then index = -1
   endif
   freeDot(0) = index

endfunction

function DestroyDot(i)
   rem if the dot doesn't exist the exit the function
   if dots(i) = 0 then exitfunction

   rem set collision position to 0
   screen(dotx#(i),doty#(i)) = 0
   rem set all values to 0
   dots(i) = 0
   dotx#(i) = 0.0
   doty#(i) = 0.0
   dotType(i) = 0
   dotWeight#(i) = 0.0
   dotTimer(i) = 0
   for x=i to maxUpdate(0)
      dots(x) = dots(x+1)
      dotx#(x) = dotx#(x+1)
      doty#(x) = doty#(x+1)
      dotType(x) = dotType(x+1)
      dotWeight#(x) = dotWeight#(x+1)
      dotTimer(x) = dotTimer(x+1)
   next x
   freeDot(0) = maxUpdate(0)
   maxUpdate(0) = freeDot(0) - 1
endfunction

rem Find the weight of the ball according to its type
function findTypeWeight(type)

   select type
      case TYPE_BALL(0)
         weight# = 0.5
      endcase
      case TYPE_FIRE(0)
         weight# = -0.5
      endcase
      case TYPE_NORM(0)
         weight# = 0.8
      endcase
      case TYPE_DUST(0)
         weight# = 0.3
      endcase
      case TYPE_WATER(0)
         weight# = 1.2
      endcase
      case TYPE_GLASS(0)
         weight# = 0.5
      endcase
      case default
         weight# = 0.0
      endcase
   endselect

endfunction weight#

rem Type Controller functions
function controlDust(i)

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)

   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))


   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# < 0 then ny# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = 3
         else
            collision = 2
         endif
      else
         if nx# ! x#
            collision = 1
         endif
      endif
      dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
      c = screen(nx#, ny#)
   else
      collision = 0
   endif

   if collision ! 0 then dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   endif
   screen(dotx#(i),doty#(i)) = i

   ink rgb(255,255,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlBall(i)
   rem will eventually control a bouncy ball type of dot

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   if dotData(i, 0) = 0 then dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   if dotData(i, 1) = 0 then dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   if dotVolY#(i) > 10.0 then dotVolY#(i) = 10.0
   if dotVolY#(i) < -10.0 then dotVolY#(i) = -10.0
   if dotVolX#(i) > 10.0 then dotVolX#(i) = 10.0
   if dotVolX#(i) < -10.0 then dotVolX#(i) = -10.0

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = collision | 1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = collision | 1
   if ny# < 0 then ny# = 0 : collision = collision | 2
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = collision | 2

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = collision | 3
         else
            collision = collision | 2
         endif
      else
         if nx# ! x#
            collision = collision | 1
         endif
      endif
   endif


   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   else
      dotVolX#(i) = dotVolX#(i) * -1
      dotData(i, 0) = 1
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   else
      dotVolY#(i) = dotVolY#(i) * -1
      dotData(i, 1) = 1
   endif
   screen(dotx#(i),doty#(i)) = i

   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlFire(i)
   rem will eventually control a fire type of dot(burns through other dots)
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   if dotVolY#(i) > 3.0 then dotVolY#(i) = 3.0
   if dotVolY#(i) < -3.0 then dotVolY#(i) = -3.0
   if dotVolX#(i) > 3.0 then dotVolX#(i) = 3.0
   if dotVolX#(i) < -3.0 then dotVolX#(i) = -3.0

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      collision = screen(nx#, ny#)
   endif

   screen(x#,y#) = 0
   if collision ! 0 or (timer()-dotTimer(i)) > 500
      if collision > 0
         DestroyDot(i)
         if dotType(collision) ! TYPE_FIRE(0)
            DestroyDot(collision)
         endif
      else
         DestroyDot(i)
      endif
   else
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(dotx#(i), doty#(i)) = i
   endif

   ink rgb(255,0,0),0
   dot dotx#(i),doty#(i)
endfunction

function controlWater(i)


   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   Collision = 0
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1


      if screen(nx#,ny#+1) > 0
         collision = 1
      endif

   if collision > 0
      if screen(nx#+1,ny#+1) = 0
         nx# = nx# + 1
         ny# = ny# + 1
         break
      else
         if screen(nx#-1,ny#+1) = 0
            nx# = nx# - 1
            ny# = ny# + 1
         else
            nx# = x#
            ny# = y#
         endif
      endif
   endif

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i

   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)

endfunction

function controlGlass(i)

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > screen width()-1 then nx# = screen width()-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > screen height()-1 then ny# = screen height()-1 : collision = -1

   if screen(nx#,ny#) > 0 and screen(nx#,ny#) ! i or collision ! 0

      if dotVolY#(i) > 10 or dotVolX#(i) > 10
         if dotData(i, 0) = 0
            dotVolY#(i) = rnd(10)-5.0
            dotVolX#(i) = rnd(10)-5.0
            dotData(i, 0) = 1
            dotData(i, 1) = timer()
         endif
      else
      endif

      collision = 1

   else
      if collision = 0
         dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
         dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
      endif
   endif


   if collision = 0
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
   endif

   ink rgb(210, 205, 220),0
   dot dotx#(i),doty#(i)

endfunction

function controlNorm(i)
   rem Idk
endfunction

It's based on dots or pixels. although the glass does come down in 10x1 'plates' and shatters, each pixel of the plate is actually a individual entity by itself and can stand alone. If fire touches any other type of dot then it will destroy itself and the other dot.

Something fun i added is the wind. press five and move the mouse around the center of the screen to change the angle and then use left or right mouse clicks or mouse wheel to change the force. it's quite fun with the dust, if i do say so myself lol.

I wanted to make it so if you burnt the dust then it would turn to glass(i want to change it to be more like sand hahaha)

This game gave me the idea:

Dust Game

Check it out! it's very fun game.

New Site! Check it out \/

Back to top

Profile PM Website

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 21st Nov 2009 17:34

@Caleb
Well done. That is quite an interesting entry. All the effects are pretty good! I like the glass and the wind the best. I had to switch the sync rate down to abount 30 or 40 because it ran at around 500 fps when the sync was at 0 - which was way too fast.

Enjoy your day.

Back to top

Profile PM

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 21st Nov 2009 19:55 Edited at: 21st Nov 2009 21:37

Thanks! I think this is only my first or second entry on this hole thread

I had already thought about trying to replicate that game then i saw this challenge and it gave me the incentive lol

Quote: "I had to switch the sync rate down to abount 30 or 40 because it ran at around 500 fps when the sync was at 0 - which was way too fast.
"

Sorry! i always start my programs with sync rate at 0 then as i move on i ussually change it. The frame rate was still locked at 99 on my machine so it was fine for me

i will edit the original post with sync rate at 100 which seemed to work good for me.

Edit:

Got the water to work. Although i'm displeased with the speed. with only 2000 dots(of just water) my fps drops to about 15

I also added walls(just inanimate objects to stop dots from passing), and a clear thing(click and it will clear a 5x5 box of dots around the cursor)

Also changed the map width and height to bitmap 0 width and height.

I am adding ice next(MIGHT be done before tomorrow). where if ice touches water, then the water turns to ice. if ice touches fire the ice turns to water woohoo! This might turn into a full blown project.... hmmmm

I know most of the features in this don't count as "Falling Objects" but they were fun lol

Here it is:

rem Falling Objects by Caleb Stewart
rem DBC Challenge entry
Sync on
Sync rate 100
set display mode 640,480,16

rem Dot Information
dim maxDot(0)
maxDot(0) = 10000
m = maxDot(0)
dim dots(m)
dim dotx#(m)
dim doty#(m)
dim dotType(m)
dim dotWeight#(m)
dim dotVolX#(m)
dim dotVolY#(m)
dim dotTimer(m)
dim dotData(m, 5)
dim freeDot(0) : freeDot(0) = 1
dim maxUpdate(0)
dim DotCount(0)

rem Environment information
dim gravx#(0) : gravx#(0) = 0.0
dim gravy#(0) : gravy#(0) = 0.8
dim windAng#(0) : windAng#(0) = 0.0
dim windForce#(0) : windForce#(0) = 0.0
MAP_WIDTH = bitmap width(0) : map_height = bitmap height(0)
dim map_width(0) : map_width(0) = map_width
dim map_height(0) : map_height(0) = map_height

rem Screen Map for collision
dim Screen(map_width, map_height)

rem different types of dots
dim TYPE_BALL(0) : TYPE_BALL(0) = 1
dim TYPE_FIRE(0) : TYPE_FIRE(0) = 2
dim TYPE_GLASS(0) : TYPE_GLASS(0) = 3
dim TYPE_DUST(0) : TYPE_DUST(0) = 4
dim TYPE_NORM(0) : TYPE_NORM(0) = 5
dim TYPE_WATER(0) : TYPE_WATER(0) = 6
dim TYPE_WALL(0) : TYPE_WALL(0) = 7

dropType = 1

set text size 5

do

ink rgb(255,255,255),0
   print "Screen FPS: "; Screen FPS()
   print "Number of dots on screen: "; dotCount(0)
   print "Press 1 - 7 to select a tool"
   print "Press backspace to use the delete tool."
   PrintInstructions(dropType)

if mouseclick() = 1
      if hold = 0
         select dropType
            case TYPE_FIRE(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_FIRE(0))
               next x
            endcase
            case TYPE_WATER(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_WATER(0))
               next x
            endcase
            case TYPE_GLASS(0)
               for x=0 to 10
                   CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_GLASS(0))
               next x
               Hold = 1
            endcase
            case TYPE_WALL(0)
               for x=-2 to 2
                  for y=-2 to 2
                     CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_WALL(0))
                  next y
               next x
            endcase
            case 150
               for x=-2 to 2
                  for y=-2 to 2
                     if (mousex()+x) >= 0 and (mousex()+x) =< map_width(0) and (mousey()+y) >= 0 and (mousey()+y) <= map_height(0)
                        DestroyDot(safecheck(mousex()+x+0.0,mousey()+y+0.0))
                     endif
                  next y
               next x
            endcase
            case default
               if dropType ! 5 then CreateDot(mousex()+0.0,mousey()+0.0,dropType)
            endcase
         endselect
      endif
   else
      hold = 0
   endif

if dropType = 5
      x2 = sin(windAng#(0)) * 30
      y2 = cos(windAng#(0)) * 30
      line map_width(0)/2,map_height(0)/2,map_width(0)/2+x2,map_height(0)/2+y2

o# = mouseX() - map_width(0)/2 : a# = mousey() - map_height(0)/2
      windAng#(0) = wrapvalue(atanfull(o#,a#))
      if mouseclick() = 1
         if rlDown = 0 and windForce#(0) < 10.0
            windForce#(0) = windForce#(0) + 0.1
            rlDown = 1
         endif
      endif
      if mouseclick() = 2 and rlDown = 0 and windForce#(0) >= 0.0
         windForce#(0) = windForce#(0) - 0.1
      endif
      if mousemovez() > 0
         windForce#(0) = windForce#(0) + (mousemovez()/10)
      endif
      rlDown = 0
   endif

if val(inkey$()) >= 1 and val(inkey$()) <= 7
      dropType = val(inkey$())
   endif

if keystate(14) = 1 then dropType = 150

updateDots()
   sync
   cls
loop

function PrintInstructions(Type)

select Type
      case 5
         print
         Print "Wind Tool:"
         print
         Print "Use up and down keys to change direction."
         Print "Use left and right mouse buttons or mouse wheel to change the force."
         print "Wind Angle = "; WindAng#(0)
         print "Wind Force = "; WindForce#(0)
         print
      endcase
      case TYPE_GLASS(0)
         print
         print "Glass Tool:"
         print
         print "Click to drop a plate of glass and watch it shatter!"
         print
      endcase
      case TYPE_FIRE(0)
         print
         print "Fire Tool:"
         print
         print "Click to send fire through the air!"
         print "Fire will burn up other dots!"
         print
      endcase
      case TYPE_BALL(0)
         print
         print "Ball Tool:"
         print
         print "Unlease the power of the super ball!"
         print "The higher you drop it from, the Higher it will go!"
         print
      endcase
      case TYPE_DUST(0)
         print
         print "Dust Tool:"
         print
         print "Drop the dust and  watch it stack."
         print "Use the wind tool to make it fly across the screen!"
         print
      endcase
      case TYPE_WALL(0)
         print
         print "Wall Tool:"
         print
         print "Click to place 4x4 walls."
         print "The walls will hold in other dots."
         print
      endcase
   endselect

endfunction

rem Draw and update all the dots
function UpdateDots()
   for i = 0 to maxUpdate(0)
      if dots(i) = 1
         findDotFunction(i)
      endif
   next i
endfunction

rem Find the correct dot controller by type
function findDotFunction(i)

select dotType(i)
      case TYPE_BALL(0)
         controlBall(i)
      endcase
      case TYPE_DUST(0)
         controlDust(i)
      endcase
      case TYPE_NORM(0)
         controlNorm(i)
      endcase
      case TYPE_FIRE(0)
         controlFire(i)
      endcase
      case TYPE_WATER(0)
         controlWater(i)
      endcase
      case TYPE_GLASS(0)
         controlGlass(i)
      endcase
      case TYPE_WALL(0)
         controlWall(i)
      endcase
      case default
         controlNorm(i)
      endcase
   endselect

endfunction

function StartCollisionMatters(type)

select type
      case default
         exitfunction 1
      endcase
   endselect

endfunction 1

rem Create a dot. ready for updating.
function CreateDot(x#, y#, type)
   rem check to see if position is on screen
   if x# < 0 or x# > map_width(0)-1 or y# < 0 or y# > map_height(0)-1 then exitfunction
   rem if there is already a dot at this position, don't create it
   if screen(x#,y#) > 0 and StartCollisionMatters(type) = 1 then exitfunction
   rem if there are no more dots exit the function
   if freeDot(0) = -1 then exitfunction

DotCount(0) = DotCount(0) + 1

weight# = findTypeWeight(type)
   index = freeDot(0)
   dots(index) = 1
   dotx#(index) = x#
   doty#(index) = y#
   dotType(index) = type
   dotWeight#(index) = weight#

rem Set the screen collision coordanet to the dot index
   screen(x#,y#) = index

rem Set Dot timer to the current time
   dotTimer(index) = timer()

rem If the max updated dot is less then this dot
   rem set it to this dot
   if maxUpdate(0) < index then maxUpdate(0) = index

rem search up
   while index < maxDot(0) and dots(index) = 1
      index = index + 1
   endwhile
   rem if no free spaces up
   if index = maxDot(0)
      rem then search down
      while index > 0
         if dots(index) = 0 then exit
         index = index - 1
      endwhile
      rem if no free spaces. set freeDot(0) to -1
      if index = 0 then index = -1
   endif
   freeDot(0) = index

endfunction

function DestroyDot(i)
   rem if the dot doesn't exist the exit the function
   if dots(i) = 0 then exitfunction

DotCount(0) = DotCount(0) - 1

rem set collision position to 0
   screen(dotx#(i),doty#(i)) = 0
   rem set all values to 0
   dots(i) = 0
   dotx#(i) = 0.0
   doty#(i) = 0.0
   dotType(i) = 0
   dotWeight#(i) = 0.0
   dotTimer(i) = 0
   for x=i to maxUpdate(0)
      dots(x) = dots(x+1)
      dotx#(x) = dotx#(x+1)
      doty#(x) = doty#(x+1)
      dotType(x) = dotType(x+1)
      dotWeight#(x) = dotWeight#(x+1)
      dotTimer(x) = dotTimer(x+1)
   next x
   freeDot(0) = maxUpdate(0)
   maxUpdate(0) = freeDot(0) - 1
endfunction

rem Find the weight of the ball according to its type
function findTypeWeight(type)

select type
      case TYPE_BALL(0)
         weight# = 0.5
      endcase
      case TYPE_FIRE(0)
         weight# = -0.5
      endcase
      case TYPE_NORM(0)
         weight# = 0.8
      endcase
      case TYPE_DUST(0)
         weight# = 0.2
      endcase
      case TYPE_WATER(0)
         weight# = 1.2
      endcase
      case TYPE_GLASS(0)
         weight# = 0.3
      endcase
      case TYPE_WALL(0)
         weight# = 0.0
      endcase
      case TYPE_ICE
      endcase
      case default
         weight# = 0.0
      endcase
   endselect

endfunction weight#

rem Type Controller functions
function controlDust(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)

if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# < 0 then ny# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = 3
         else
            collision = 2
         endif
      else
         if nx# ! x#
            collision = 1
         endif
      endif
      dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
      c = screen(nx#, ny#)
   else
      collision = 0
   endif

if collision ! 0 then dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   endif
   screen(dotx#(i),doty#(i)) = i

ink rgb(255,255,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlBall(i)
   rem will eventually control a bouncy ball type of dot

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   if dotData(i, 0) = 0 then dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   if dotData(i, 1) = 0 then dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

if dotVolY#(i) > 10.0 then dotVolY#(i) = 10.0
   if dotVolY#(i) < -10.0 then dotVolY#(i) = -10.0
   if dotVolX#(i) > 10.0 then dotVolX#(i) = 10.0
   if dotVolX#(i) < -10.0 then dotVolX#(i) = -10.0

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = collision | 1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = collision | 1
   if ny# < 0 then ny# = 0 : collision = collision | 2
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = collision | 2

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = collision | 3
         else
            collision = collision | 2
         endif
      else
         if nx# ! x#
            collision = collision | 1
         endif
      endif
   endif

screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   else
      dotVolX#(i) = dotVolX#(i) * -1
      dotData(i, 0) = 1
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   else
      dotVolY#(i) = dotVolY#(i) * -1
      dotData(i, 1) = 1
   endif
   screen(dotx#(i),doty#(i)) = i

ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlFire(i)
   rem will eventually control a fire type of dot(burns through other dots)
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

if dotVolY#(i) > 3.0 then dotVolY#(i) = 3.0
   if dotVolY#(i) < -3.0 then dotVolY#(i) = -3.0
   if dotVolX#(i) > 3.0 then dotVolX#(i) = 3.0
   if dotVolX#(i) < -3.0 then dotVolX#(i) = -3.0

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      collision = screen(nx#, ny#)
   endif

screen(x#,y#) = 0
   if collision ! 0 or (timer()-dotTimer(i)) > 500
      if collision > 0
         DestroyDot(i)
         if dotType(collision) ! TYPE_FIRE(0)
            DestroyDot(collision)
         endif
      else
         DestroyDot(i)
      endif
   else
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(dotx#(i), doty#(i)) = i
   endif

ink rgb(255,0,0),0
   dot dotx#(i),doty#(i)
endfunction

function controlWater(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

Collision = 0

if safecheck(nx#,ny#) > 0 and safecheck(nx#,ny#) ! i
      collision = 1
      nx# = x# : ny# = y#
   endif

if collision <> 0
      if safecheck(nx#+1, ny#) = 0
         nx# = nx# + 1
      else
         if safecheck(nx#-1, ny#) = 0
            nx# = nx# - 1
         endif
      endif
      if safecheck(nx#,ny#+1) = 0
         ny# = ny# + 1
      endif
   endif

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i

ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)

endfunction

function controlGlass(i)

rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif

collision = 0

rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

if screen(nx#,ny#) > 0 and screen(nx#,ny#) ! i or collision ! 0

if dotVolY#(i) > 10 or dotVolX#(i) > 10
         if dotData(i, 0) = 0
            dotVolY#(i) = rnd(10)-5.0
            dotVolX#(i) = rnd(10)-5.0
            dotData(i, 0) = 1
            dotData(i, 1) = timer()
         endif
      else
      endif

collision = 1

else
      if collision = 0
         dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
         dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
      endif
   endif

if collision = 0
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
   endif

ink rgb(210, 205, 220),0
   dot dotx#(i),doty#(i)

endfunction

function controlNorm(i)
   rem Idk
endfunction

function controlWall(i)

ink rgb(100, 100, 100),0
   dot dotx#(i),doty#(i)

endfunction

function safecheck(x#,y#)
   if x# < 0 or x# > map_Width(0)-1 or y# < 0 or y# > map_Height(0)-1 then exitfunction 1
endfunction screen(x#,y#)

rem Falling Objects by Caleb Stewart
rem DBC Challenge entry
Sync on
Sync rate 100
set display mode 640,480,16

rem Dot Information
dim maxDot(0)
maxDot(0) = 10000
m = maxDot(0)
dim dots(m)
dim dotx#(m)
dim doty#(m)
dim dotType(m)
dim dotWeight#(m)
dim dotVolX#(m)
dim dotVolY#(m)
dim dotTimer(m)
dim dotData(m, 5)
dim freeDot(0) : freeDot(0) = 1
dim maxUpdate(0)
dim DotCount(0)

rem Environment information
dim gravx#(0) : gravx#(0) = 0.0
dim gravy#(0) : gravy#(0) = 0.8
dim windAng#(0) : windAng#(0) = 0.0
dim windForce#(0) : windForce#(0) = 0.0
MAP_WIDTH = bitmap width(0) : map_height = bitmap height(0)
dim map_width(0) : map_width(0) = map_width
dim map_height(0) : map_height(0) = map_height

rem Screen Map for collision
dim Screen(map_width, map_height)

rem different types of dots
dim TYPE_BALL(0) : TYPE_BALL(0) = 1
dim TYPE_FIRE(0) : TYPE_FIRE(0) = 2
dim TYPE_GLASS(0) : TYPE_GLASS(0) = 3
dim TYPE_DUST(0) : TYPE_DUST(0) = 4
dim TYPE_NORM(0) : TYPE_NORM(0) = 5
dim TYPE_WATER(0) : TYPE_WATER(0) = 6
dim TYPE_WALL(0) : TYPE_WALL(0) = 7

dropType = 1

set text size 5

do

   ink rgb(255,255,255),0
   print "Screen FPS: "; Screen FPS()
   print "Number of dots on screen: "; dotCount(0)
   print "Press 1 - 7 to select a tool"
   print "Press backspace to use the delete tool."
   PrintInstructions(dropType)

   if mouseclick() = 1
      if hold = 0
         select dropType
            case TYPE_FIRE(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_FIRE(0))
               next x
            endcase
            case TYPE_WATER(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_WATER(0))
               next x
            endcase
            case TYPE_GLASS(0)
               for x=0 to 10
                   CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_GLASS(0))
               next x
               Hold = 1
            endcase
            case TYPE_WALL(0)
               for x=-2 to 2
                  for y=-2 to 2
                     CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_WALL(0))
                  next y
               next x
            endcase
            case 150
               for x=-2 to 2
                  for y=-2 to 2
                     if (mousex()+x) >= 0 and (mousex()+x) =< map_width(0) and (mousey()+y) >= 0 and (mousey()+y) <= map_height(0)
                        DestroyDot(safecheck(mousex()+x+0.0,mousey()+y+0.0))
                     endif
                  next y
               next x
            endcase
            case default
               if dropType ! 5 then CreateDot(mousex()+0.0,mousey()+0.0,dropType)
            endcase
         endselect
      endif
   else
      hold = 0
   endif

   if dropType = 5
      x2 = sin(windAng#(0)) * 30
      y2 = cos(windAng#(0)) * 30
      line map_width(0)/2,map_height(0)/2,map_width(0)/2+x2,map_height(0)/2+y2

      o# = mouseX() - map_width(0)/2 : a# = mousey() - map_height(0)/2
      windAng#(0) = wrapvalue(atanfull(o#,a#))
      if mouseclick() = 1
         if rlDown = 0 and windForce#(0) < 10.0
            windForce#(0) = windForce#(0) + 0.1
            rlDown = 1
         endif
      endif
      if mouseclick() = 2 and rlDown = 0 and windForce#(0) >= 0.0
         windForce#(0) = windForce#(0) - 0.1
      endif
      if mousemovez() > 0
         windForce#(0) = windForce#(0) + (mousemovez()/10)
      endif
      rlDown = 0
   endif

   if val(inkey$()) >= 1 and val(inkey$()) <= 7
      dropType = val(inkey$())
   endif

   if keystate(14) = 1 then dropType = 150

   updateDots()
   sync
   cls
loop

function PrintInstructions(Type)

   select Type
      case 5
         print
         Print "Wind Tool:"
         print
         Print "Use up and down keys to change direction."
         Print "Use left and right mouse buttons or mouse wheel to change the force."
         print "Wind Angle = "; WindAng#(0)
         print "Wind Force = "; WindForce#(0)
         print
      endcase
      case TYPE_GLASS(0)
         print
         print "Glass Tool:"
         print
         print "Click to drop a plate of glass and watch it shatter!"
         print
      endcase
      case TYPE_FIRE(0)
         print
         print "Fire Tool:"
         print
         print "Click to send fire through the air!"
         print "Fire will burn up other dots!"
         print
      endcase
      case TYPE_BALL(0)
         print
         print "Ball Tool:"
         print
         print "Unlease the power of the super ball!"
         print "The higher you drop it from, the Higher it will go!"
         print
      endcase
      case TYPE_DUST(0)
         print
         print "Dust Tool:"
         print
         print "Drop the dust and  watch it stack."
         print "Use the wind tool to make it fly across the screen!"
         print
      endcase
      case TYPE_WALL(0)
         print
         print "Wall Tool:"
         print
         print "Click to place 4x4 walls."
         print "The walls will hold in other dots."
         print
      endcase
   endselect

endfunction

rem Draw and update all the dots
function UpdateDots()
   for i = 0 to maxUpdate(0)
      if dots(i) = 1
         findDotFunction(i)
      endif
   next i
endfunction

rem Find the correct dot controller by type
function findDotFunction(i)

   select dotType(i)
      case TYPE_BALL(0)
         controlBall(i)
      endcase
      case TYPE_DUST(0)
         controlDust(i)
      endcase
      case TYPE_NORM(0)
         controlNorm(i)
      endcase
      case TYPE_FIRE(0)
         controlFire(i)
      endcase
      case TYPE_WATER(0)
         controlWater(i)
      endcase
      case TYPE_GLASS(0)
         controlGlass(i)
      endcase
      case TYPE_WALL(0)
         controlWall(i)
      endcase
      case default
         controlNorm(i)
      endcase
   endselect

endfunction

function StartCollisionMatters(type)

   select type
      case default
         exitfunction 1
      endcase
   endselect

endfunction 1

rem Create a dot. ready for updating.
function CreateDot(x#, y#, type)
   rem check to see if position is on screen
   if x# < 0 or x# > map_width(0)-1 or y# < 0 or y# > map_height(0)-1 then exitfunction
   rem if there is already a dot at this position, don't create it
   if screen(x#,y#) > 0 and StartCollisionMatters(type) = 1 then exitfunction
   rem if there are no more dots exit the function
   if freeDot(0) = -1 then exitfunction

   DotCount(0) = DotCount(0) + 1

   weight# = findTypeWeight(type)
   index = freeDot(0)
   dots(index) = 1
   dotx#(index) = x#
   doty#(index) = y#
   dotType(index) = type
   dotWeight#(index) = weight#

   rem Set the screen collision coordanet to the dot index
   screen(x#,y#) = index

   rem Set Dot timer to the current time
   dotTimer(index) = timer()

   rem If the max updated dot is less then this dot
   rem set it to this dot
   if maxUpdate(0) < index then maxUpdate(0) = index

   rem search up
   while index < maxDot(0) and dots(index) = 1
      index = index + 1
   endwhile
   rem if no free spaces up
   if index = maxDot(0)
      rem then search down
      while index > 0
         if dots(index) = 0 then exit
         index = index - 1
      endwhile
      rem if no free spaces. set freeDot(0) to -1
      if index = 0 then index = -1
   endif
   freeDot(0) = index

endfunction

function DestroyDot(i)
   rem if the dot doesn't exist the exit the function
   if dots(i) = 0 then exitfunction

   DotCount(0) = DotCount(0) - 1

   rem set collision position to 0
   screen(dotx#(i),doty#(i)) = 0
   rem set all values to 0
   dots(i) = 0
   dotx#(i) = 0.0
   doty#(i) = 0.0
   dotType(i) = 0
   dotWeight#(i) = 0.0
   dotTimer(i) = 0
   for x=i to maxUpdate(0)
      dots(x) = dots(x+1)
      dotx#(x) = dotx#(x+1)
      doty#(x) = doty#(x+1)
      dotType(x) = dotType(x+1)
      dotWeight#(x) = dotWeight#(x+1)
      dotTimer(x) = dotTimer(x+1)
   next x
   freeDot(0) = maxUpdate(0)
   maxUpdate(0) = freeDot(0) - 1
endfunction

rem Find the weight of the ball according to its type
function findTypeWeight(type)

   select type
      case TYPE_BALL(0)
         weight# = 0.5
      endcase
      case TYPE_FIRE(0)
         weight# = -0.5
      endcase
      case TYPE_NORM(0)
         weight# = 0.8
      endcase
      case TYPE_DUST(0)
         weight# = 0.2
      endcase
      case TYPE_WATER(0)
         weight# = 1.2
      endcase
      case TYPE_GLASS(0)
         weight# = 0.3
      endcase
      case TYPE_WALL(0)
         weight# = 0.0
      endcase
      case TYPE_ICE
      endcase
      case default
         weight# = 0.0
      endcase
   endselect

endfunction weight#

rem Type Controller functions
function controlDust(i)

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)

   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))


   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# < 0 then ny# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = 3
         else
            collision = 2
         endif
      else
         if nx# ! x#
            collision = 1
         endif
      endif
      dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
      c = screen(nx#, ny#)
   else
      collision = 0
   endif

   if collision ! 0 then dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0

   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   endif
   screen(dotx#(i),doty#(i)) = i

   ink rgb(255,255,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlBall(i)
   rem will eventually control a bouncy ball type of dot

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   if dotData(i, 0) = 0 then dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   if dotData(i, 1) = 0 then dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   if dotVolY#(i) > 10.0 then dotVolY#(i) = 10.0
   if dotVolY#(i) < -10.0 then dotVolY#(i) = -10.0
   if dotVolX#(i) > 10.0 then dotVolX#(i) = 10.0
   if dotVolX#(i) < -10.0 then dotVolX#(i) = -10.0

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = collision | 1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = collision | 1
   if ny# < 0 then ny# = 0 : collision = collision | 2
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = collision | 2

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = collision | 3
         else
            collision = collision | 2
         endif
      else
         if nx# ! x#
            collision = collision | 1
         endif
      endif
   endif


   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   else
      dotVolX#(i) = dotVolX#(i) * -1
      dotData(i, 0) = 1
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   else
      dotVolY#(i) = dotVolY#(i) * -1
      dotData(i, 1) = 1
   endif
   screen(dotx#(i),doty#(i)) = i

   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
endfunction

function controlFire(i)
   rem will eventually control a fire type of dot(burns through other dots)
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   if dotVolY#(i) > 3.0 then dotVolY#(i) = 3.0
   if dotVolY#(i) < -3.0 then dotVolY#(i) = -3.0
   if dotVolX#(i) > 3.0 then dotVolX#(i) = 3.0
   if dotVolX#(i) < -3.0 then dotVolX#(i) = -3.0

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      collision = screen(nx#, ny#)
   endif

   screen(x#,y#) = 0
   if collision ! 0 or (timer()-dotTimer(i)) > 500
      if collision > 0
         DestroyDot(i)
         if dotType(collision) ! TYPE_FIRE(0)
            DestroyDot(collision)
         endif
      else
         DestroyDot(i)
      endif
   else
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(dotx#(i), doty#(i)) = i
   endif

   ink rgb(255,0,0),0
   dot dotx#(i),doty#(i)
endfunction

function controlWater(i)


   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))

   Collision = 0

   if safecheck(nx#,ny#) > 0 and safecheck(nx#,ny#) ! i
      collision = 1
      nx# = x# : ny# = y#
   endif

   if collision <> 0
      if safecheck(nx#+1, ny#) = 0
         nx# = nx# + 1
      else
         if safecheck(nx#-1, ny#) = 0
            nx# = nx# - 1
         endif
      endif
      if safecheck(nx#,ny#+1) = 0
         ny# = ny# + 1
      endif
   endif

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i

   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)

endfunction

function controlGlass(i)

   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif

   collision = 0

   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1

   if screen(nx#,ny#) > 0 and screen(nx#,ny#) ! i or collision ! 0

      if dotVolY#(i) > 10 or dotVolX#(i) > 10
         if dotData(i, 0) = 0
            dotVolY#(i) = rnd(10)-5.0
            dotVolX#(i) = rnd(10)-5.0
            dotData(i, 0) = 1
            dotData(i, 1) = timer()
         endif
      else
      endif

      collision = 1

   else
      if collision = 0
         dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
         dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
      endif
   endif


   if collision = 0
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
   endif

   ink rgb(210, 205, 220),0
   dot dotx#(i),doty#(i)

endfunction

function controlNorm(i)
   rem Idk
endfunction

function controlWall(i)

   ink rgb(100, 100, 100),0
   dot dotx#(i),doty#(i)

endfunction

function safecheck(x#,y#)
   if x# < 0 or x# > map_Width(0)-1 or y# < 0 or y# > map_Height(0)-1 then exitfunction 1
endfunction screen(x#,y#)

New Site! Check it out \/

Back to top

Profile PM Website

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 23rd Nov 2009 03:52

sorry, i've had to work a lot the last few days.
Shame I really liked this challenge. I started to set up a memblock to store a 2D object like DB does wih meshes, I might carry on experimenting with that.

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 23rd Nov 2009 04:48

Quote: "I started to set up a memblock to store a 2D object like DB does wih meshes, I might carry on experimenting with that."

So you are creating a mesh with 2d vectors

and no normals, or uv data

New Site! Check it out \/

Back to top

Profile PM Website

Latch

18

Years of Service

User Offline

Joined: 23rd Jul 2006

Location:

Posted: 23rd Nov 2009 18:41

RESULTS of the Falling Object Challenge:

There were 2 entries

Ashingda : Very nice 2d sphere dropping demo. A series of spheres pouring out of different tubes. Some spheres jumped, others moved from side to side, some destroyed others. This was well done and looked very nice.

Caleb : A demo of multiple "tools" including bouncing balls, water, filing dust (snow?), fire, wind, breaking glass, and building obstacles. The graphcis were very simple, but it was easily understandable what each tool was doing. Very good work, and very nice particle motion.

The winner is :

Caleb1994

Enjoy your day.

Back to top

Profile PM

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 23rd Nov 2009 20:38

Good job Caleb, congrats

Back to top

Profile PM Email

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 24th Nov 2009 03:21

Wow! thanks!

Although i must say, Ashinga I loved your graphics! Yours was great also!

I am willing to judge the next challenge, but I just can't think of one. So I will leave it up to the community for what kind of challenge you want! Throw out suggestions and i will pick one

If i think of something i will put it up though.

New Site! Check it out \/

Back to top

Profile PM Website

t10dimensional

16

Years of Service

User Offline

Joined: 22nd Mar 2009

Location: Code Cave, USA

Posted: 24th Nov 2009 04:01

How about a rubik's cube race. If someone is willing to, he could build a skeliton of the code(display,mixing and timer) and leave a small part for solving it. And to find the winner you could ethier have a set mixed up cube or whoever has the best out of 10.

Razerx

Back to top

Profile PM

demons breath

21

Years of Service

User Offline

Joined: 4th Oct 2003

Location: Surrey, UK

Posted: 24th Nov 2009 04:12

Over the last page or two if you don't have any ideas there have been a few ideas which have been quite good. I personally prefer the challenges where there have been basic guidelines but then you have the option to build on them, but again that's just me and I can't get DB to work so I don't know how much my vote counts...

Back to top

Profile PM Website

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 24th Nov 2009 05:00 Edited at: 24th Nov 2009 05:05

Banking system

The requirements are that you have to be able to withdraw and put in money, and you must be able to pay a bill or buy something. or in other words spend the money in some way.

It could be in 2d or 3d. It could be as simple as text displayed on the screen or have a actual 3d teller and have it be a actually bank. or even have it be a atm. Whatever you see fit.

Will be judged on creativity, and features. I don't think that speed is really a issue with this challenge.

Because this is during the holidays, I think i will put the Deadline as December 4th If anyone objects the this timeframe(almost 2 weeks) then i will change it, but i figure people will no doubt be busy this week.

New Site! Check it out \/

Back to top

Profile PM Website

Ashingda 27

17

Years of Service

User Offline

Joined: 15th Feb 2008

Location:

Posted: 24th Nov 2009 06:54

This sounds fun!

Back to top

Profile PM Email

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 24th Nov 2009 07:03

@Caleb
Just to get this straight - we're making something for depositing and withdrawing money. So could this be anything from a piggybank to a stockmarket simulator?
I'm doing an accounting course so I'll put that to good use

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

Caleb1994

16

Years of Service

User Offline

Joined: 10th Oct 2008

Location: The Internet you idiot!

Posted: 24th Nov 2009 15:32

Quote: "So could this be anything from a piggybank to a stockmarket simulator?"

Of course! like you said anything that will withdraw/doposit(thanks for that word i couldn't rmember it) money and spend it.

New Site! Check it out \/

Back to top

Profile PM Website

Libervurto

18

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 26th Nov 2009 06:55

I'm probably not awake enough to be having "ideas" so this might sound crazy but what if we had a series of scrapheap code challenges. What I mean by that is instead of starting from scratch every challenge, you have to re-use your old code from the previous challenge and alter it to fit its new purpose. The person with the best program and fewest alterations wins.

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

jason p sage

17

Years of Service

User Offline

Joined: 10th Jun 2007

Location: Ellington, CT USA

Posted: 26th Nov 2009 08:51

Neat Idea Obese87.

You know how some game making tutorials kind of take you step by step on how to make a game, and each step is "COOL" but as you progress it keeps getting cooler and cooler (hopefully -

)

I like that idea of building ... it's a longer commitment maybe, but that could potentially turn the "small challenges" into a slightly spread out series - that ends up generating a few nearly complete or completed games by multiple people at the same time....

Tired or not Obese87, I know I have a slightly different slant on it, but your idea is really really cool!

Back to top

Profile PM Email Website

TDK

Retired Moderator

22

Years of Service

User Offline

Joined: 19th Nov 2002

Location: UK

Posted: 8th Dec 2009 12:49

The deadline has passed - 4 days ago!

Nothing has been posted in 12 days.

Is this thread now officially abandoned? Should it be locked?

Do we all now move to DBPro now the free version is available?

TDK