The Game Creators
The Game Creators Home Online Shop Click to Login
  Hot: Christmas CompetitionNovember NewsletterModel Pack 36DB Pro Pack 2009DGS BonanzaCharacter PackFPS Creator Bonanza;
The Game Creators
DBPro / - DBPro Coding Challenges -

Go to the first page of this board Return to the Forum Menu Post Message
6,836 Messages - Page   of 171   
Bookmark and Share Search the Forum Next 40

Author Message
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 10th Feb 2005 23:17     Edited: 1st Feb 2007 10:42     | link | toggle




Like a challenge? Then this is the place for you !

The challenges in this thread are designed to improve your coding skills, either by having a go at the current challenge yourself, or by learning from other peoples attempts. These challenges are both educational and fun!

Challenges are set regularly, and everyone is welcome to participate, whether you're a complete novice or an advanced programmer. These challenges are about coding techniques. The idea isn't necessarily to create a fully fledged game - the challenge may concentrate on a particular area of game design, and should therefore be achievable within a matter of days.

There are some rules you need to know about. Firstly, your entry must be written in DBPro without the use of any external media.

There are 10 rules in total. You can see all of the rules, and additional information about what is meant by 'no media' here.

A searchable database containing the all of the code snippets from these challenges can be found at www.dbp-site.com - thanks to Nicholas Thompson for creating this great resource.

Have fun, and get coding!

Back to top
Andromedus.com
Download: Image1.jpg Size: 24418 bytes  View Image: Image1.jpg Size: 24418 bytesReport this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 10th Feb 2005 23:19     Edited: 6th Feb 2006 16:38     | link | toggle

Challenge 1:

* Make a weather effect. Could be a rainbow, lightning, snow, etc etc .....

* Time limit: 2 days (until Saturday night).

___________________________________________________________________

Here's my attempt at a tornado!

+ Code Snippet
sync on
sync rate 25
hide mouse
autocam off
position camera 0,5,0
color backdrop rgb(100,100,155)
fog on
fog color rgb(100,100,155)
fog distance 2000

`grass
for x=1 to 10
for y=1 to 10
ink rgb(rnd(100),rnd(155)+100,0),0
dot x,y
next y
next x
get image 1000,1,1,10,10
make object plain 1000,2000,2000
xrotate object 1000,-90
texture object 1000,1000
scale object texture 1000,10,10
set object texture 1000,2,0

`particle properties
numberofparticles=10000
dim x#(numberofparticles)
dim y#(numberofparticles)
dim xspeed#(numberofparticles)
dim yspeed#(numberofparticles)
dim brightness(numberofparticles)
dim a#(numberofparticles)
dim e#(numberofparticles) `phase angle
for particle=1 to numberofparticles
x#(particle)=rnd(screen width())
y#(particle)=rnd(screen height())
xspeed#(particle)=(rnd(3000)/1000.0)
e#(particle)=rnd(360)
brightness(particle)=rnd(100)+100
a#(particle)=gaussian(2*screen width())-screen width() `amplitude
gravitya#=.01
gravityb#=1.0
omega#=0.0006 `primary angular velocity
phi#=2.0 `secondary angular velocity
next particle

do
inc counter
if counter>1000 then counter=0
if counter=100 or counter=110 or counter=400
color backdrop rgb(255,255,255)
else
color backdrop rgb(100,100,155)
endif

gosub particles
control camera using arrowkeys 0,1,1
if counter/2.0=int(counter/2.0) then sync
loop

particles:

text 0,0,str$(screen fps())
lock pixels

`tornado particles
for particle=1 to numberofparticles step 2
inc y#(particle),gravityb#
if y#(particle)>0 and y#(particle)<screen height() and x#(particle)>0 and x#(particle)<screen width() then set_locked_pixel(x#(particle),y#(particle),rgb(brightness(particle),brightness(particle),200))
x#(particle)=(500/y#(particle)^1.5)*a#(particle)*sin(theta#+e#(particle))+screen width()/2+(20*sin(y#(particle)+psi#))
theta#=wrapvalue(theta#)+omega#
if y#(particle)>=screen height()/1.5 then dec y#(particle),screen height()
next particle
psi#=wrapvalue(psi#)+phi#

`background particles
for particle=2 to numberofparticles step 2
inc y#(particle),gravityb#
if y#(particle)>screen height()-1 then y#(particle)=1
if y#(particle)>0 and y#(particle)<screen height() and x#(particle)>0 and x#(particle)<screen width() then set_locked_pixel(x#(particle),y#(particle),rgb(brightness(particle),brightness(particle),200))
inc x#(particle),xspeed#(particle)
if x#(particle)>screen width()-1 then x#(particle)=1
next particle
unlock pixels
return

`Function borrowed from Coding Fodder's Rain code
function set_locked_pixel(x,y,color_value)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   *pointer=color_value
endfunction



function gaussian(range#)

   r=0
   for a = 1 to range#/10
      inc r, rnd(range#)
   next a

   r=int(10*r/range#)

endFunction r





Back to top
Andromedus.com
Report this message as abusive
BillR

User


Joined: Wed Mar 19th 2003
Location: United States
Posted: 11th Feb 2005 06:32           | link | toggle

Ric - Thanks for putting up the challenge thread - nicely done!

I like your tornado, learned something from it already!

I have been playing around with your tornado code, learning how it works, breaking it, fixing it, the usual programming kind of stuff.

I will try to think of something to enter....hmmm...nothing yet...
Back to top
Report this message as abusive
TEH_CODERER

User


Joined: Wed Nov 12th 2003
Location: Right behind you!
Posted: 11th Feb 2005 21:47           | link | toggle

Pretty nice but it doesn't look particularly tornadoish.
I'll try and make an entry now.

Back to top
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 11th Feb 2005 21:58     Edited: 11th Feb 2005 23:53     | link | toggle

Quote: "it doesn't look particularly tornadoish"

OK, so it's not quite 'The Day After Tomorrow' quality, but it's a start ........

<edit> Code is updated above to make it more tornadoish!


Back to top
Andromedus.com
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 11th Feb 2005 22:46           | link | toggle

Why do your comp entrys never work for me Ric? It just quits as soon as I run it.

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
spooky

User


Joined: Fri Aug 30th 2002
Location: United Kingdom
Posted: 11th Feb 2005 22:56           | link | toggle

Same here. Just quits as soon as it starts. I might even try and work out what the problem is.

Boo!
Back to top
www.dbhut.com
Report this message as abusive
spooky

User


Joined: Fri Aug 30th 2002
Location: United Kingdom
Posted: 11th Feb 2005 23:07           | link | toggle

I can get it to work if I replace the *pointer command with;

ink color_value,0 : dot x,y

Presume value given to pointer command is invalid and writing to bits of memory it shouldn't.

Boo!
Back to top
www.dbhut.com
Report this message as abusive
BillR

User


Joined: Wed Mar 19th 2003
Location: United States
Posted: 11th Feb 2005 23:14           | link | toggle

Worked fine for me.

Nice job Ric, good thing judges can't win, that means you can only win every other time!.....LOL

Hey, I just like figuring out how you do this stuff....and sometimes I even understand....LOL again!
Back to top
Report this message as abusive
BillR

User


Joined: Wed Mar 19th 2003
Location: United States
Posted: 11th Feb 2005 23:20           | link | toggle

Now I see...

You and G Man ganged up on us, good stuff man.

Still figuring it out....
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 11th Feb 2005 23:37           | link | toggle

Yea, I think it has something to do with the pointer, because my program will crash at random times for no reason.

Here's my entry, SplineBow!
Use the mouse to move various points* of the spline system to change the shape of the rainbow. Rain particles fall and die when hitting the rainbow.

*note last endpoint of system does allow you to move it. why? cause im lazy.

Code could be more efficient by storing the hermite vectors in an array so they aren't recalculated in the particle routine.

+ Code Snippet
rem catmullrom vector order: control, pt1, pt2, control
rem hermite vector order: pt1, control, pt2, control

set display mode 800,600,32

randomize timer()

rem 2d vector type
type vector
   x as float
   y as float
   w as float
endtype


rem 2 vectors as line segment's endpoints, 2 vectors for control points
type hermiteline
   a as vector
   b as vector
   c as vector
   d as vector
endtype


rem number of points defining hermite spline
spline_total = 5

rem get screen dimensions
width = screen width()
height = screen height()

rem array of hermite splines
dim spline(spline_total) as hermiteline

for t = 1 to spline_total
   if t > 1
      spline(t).a.x = spline(t-1).c.x
      spline(t).a.y = spline(t-1).c.y
      spline(t).b.x = spline(t-1).d.x
      spline(t).b.y = spline(t-1).d.y
   else
      spline(t).a.x = rnd(width)
      spline(t).a.y = rnd(height)
      spline(t).b.x = (rnd(200)-100) + spline(t).a.x
      spline(t).b.y = (rnd(200)-100) + spline(t).a.y
   endif
   spline(t).c.x = rnd(width)
   spline(t).c.y = rnd(height)
   spline(t).d.x = (rnd(200)-100) + spline(t).c.x
   spline(t).d.y = (rnd(200)-100) + spline(t).c.y
next t


rem vector points for hermite splines
null = make vector2(1)
null = make vector2(2)
null = make vector2(3)
null = make vector2(4)

rem result vector
null = make vector2(5)
null = make vector2(6)


rem more steps mean a smoother curve in the spline
steps = 20

rem colors of rainbow
dim colors(7) as dword
colors(1) = rgb(255,0,0)
colors(2) = rgb(213,0,213)
colors(3) = rgb(0,0,255)
colors(4) = rgb(0,255,255)
colors(5) = rgb(0,255,0)
colors(6) = rgb(255,255,0)
colors(7) = rgb(255,0,0)

p_total = 100
dim particles(p_total) as vector
for t = 1 to p_total
   particles(t).x = rnd(width)
   particles(t).y = 0
   particles(t).w = rnd(5)+1
next t

DO
   cls

   for t = 1 to spline_total
      rem allow user to click on spline point
      if mouseclick() and movePoint = 0
         if abs(mousex()-spline(t).a.x) < 4 and abs(mousey()-spline(t).a.y) < 4 then movePoint = t
      endif

      rem create hermite spline
      for s = 1 to steps
         rem get the 4 vectors
         set vector2 1,spline(t).a.x,spline(t).a.y
         set vector2 2,spline(t).b.x,spline(t).b.y
         set vector2 3,spline(t).c.x,spline(t).c.y
         set vector2 4,spline(t).d.x,spline(t).d.y

         time# = s
         hermite vector2 5,1,2,3,4,(time#-1.0)/steps
         hermite vector2 6,1,2,3,4, time#/steps

         rem make rainbow
         offset = -6
         c = 1
         for r = 1 to 6
            ink colors(c),0
            line x vector2(5), y vector2(5)+offset,x vector2(6), y vector2(6)+offset
            line x vector2(5), y vector2(5)+offset+1,x vector2(6), y vector2(6)+offset+1
            inc offset,2
            inc c
         next r

         rem draw circle to show spline points
         ink rgb(255,255,255),0
         circle spline(t).a.x,spline(t).a.y,4
         circle spline(t).c.x,spline(t).c.y,4

      next s
   next t


   rem rain particles
   lock pixels
      for p = 1 to p_total

      particles(p).y = particles(p).y + particles(p).w

      for t = 1 to spline_total

         rem create hermite spline
         for s = 1 to steps
            rem get the 4 vectors
            set vector2 1,spline(t).a.x,spline(t).a.y
            set vector2 2,spline(t).b.x,spline(t).b.y
            set vector2 3,spline(t).c.x,spline(t).c.y
            set vector2 4,spline(t).d.x,spline(t).d.y

            time# = s
            hermite vector2 5,1,2,3,4,(time#-1.0)/steps
            hermite vector2 6,1,2,3,4, time#/steps

            x1 = x vector2(5)
            y1 = y vector2(5)
            x2 = x vector2(6)
            y2 = y vector2(6)
            rem keep low to high order of points
            if x2 < x1
               temp = x1
               x1 = x2
               x2 = temp
               temp = y1
               y1 = y2
               y2 = temp
            endif

            if particles(p).x >= x1 and particles(p).x <= x2
               if point_line(particles(p).x, particles(p).y, x1, y1, x2, y2) >= 0
                  particles(p).x = rnd(width)
                  particles(p).y = 0
               endif
            endif

            if particles(p).y >= height
               particles(p).x = rnd(width)
               particles(p).y = 0
               particles(p).w = rnd(5)+1
            endif

         next s
      next t
      rem draw raindrop
      set_locked_pixel(particles(p).x, particles(p).y, rgb(255,255,255))
   next p
   unlock pixels



   rem allow user to move spline points (control points stay in original locations)
   if movePoint > 0
      spline(movePoint).a.x = mousex()
      spline(movePoint).a.y = mousey()
      if movePoint > 1
         spline(movePoint-1).c.x = spline(movePoint).a.x
         spline(movePoint-1).c.y = spline(movePoint).a.y
      endif
   endif

   if mouseclick() = 0 then movePoint = 0

   if spacekey() then resetSplines(spline_total)

loop



REM give new random coordinates for points
function resetSplines(spline_total as integer )
   for t = 1 to spline_total
      if t > 1
         spline(t).a.x = spline(t-1).c.x
         spline(t).a.y = spline(t-1).c.y
         spline(t).b.x = spline(t-1).d.x
         spline(t).b.y = spline(t-1).d.y
      else
         spline(t).a.x = rnd(width)
         spline(t).a.y = rnd(height)
         spline(t).b.x = (rnd(200)-100) + spline(t).a.x
         spline(t).b.y = (rnd(200)-100) + spline(t).a.y
      endif
      spline(t).c.x = rnd(width)
      spline(t).c.y = rnd(height)
      spline(t).d.x = (rnd(200)-100) + spline(t).c.x
      spline(t).d.y = (rnd(200)-100) + spline(t).c.y
   next t
endfunction


REM if point(px,py) is right or left of line segment (x1,y1),(x2,y2)
REM return negative if left, positive if right, 0 if on
function point_line(px#,py#, x1#,y1#,x2#,y2#)
   dp# = (x2# - x1#) * (py# - y1#) - (px# - x1#) * (y2# - y1#)
endfunction dp#


REM function borrowed from Coding Fodder's Rain code
function set_locked_pixel(x as integer, y as integer, color_value as dword )
   start = get pixels pointer()
   repeat_number = get pixels pitch()
   bits_per_pixel = bitmap depth(num)/8
   pointer = start + y*repeat_number + x*bits_per_pixel
   *pointer = color_value
endfunction


"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 11th Feb 2005 23:52     Edited: 12th Feb 2005 02:29     | link | toggle

Hmm Ric. Very nice. One problem though you do have a tendancy to write to illeagle pixels. It must not be a problem on some hardware but it crashes mine.

For people who can't run rics code. Add a check to see if

if y#(particle)>0 and x#(particle)>0

before calling set_locked_pixel.


I have been having some trouble on this project. I wanted to get away from particles as we have already done that. So I am stuck with trying to make something Truely 3D. It has kinda gotten out of hand.

If anyone needs a nice place for their weather to happen go ahead and use this pile of copy and pastes from other code of mine.

[Edit] removed code and placed silly entry below

If you look at the last few lines you will realize what rotten cheater I am. No media hah.

Really though we should put limits on data statements. I think you should be allowed some finite amount of data. some 3-D things are just too hard without media.

I will try to add the real weather code later on.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 11th Feb 2005 23:59           | link | toggle

memblock matrix?

ric's code runs now with that check. Nice work.

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Cryptoman

User


Joined: Mon Nov 24th 2003
Location: Utah Mountains
Posted: 12th Feb 2005 00:00           | link | toggle

That's some pretty nice stuff Ric. Runs nicely.


Back to top
Find user on ICQ
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 00:07     Edited: 12th Feb 2005 00:13     | link | toggle

I've updated my code (second to top post) to stop it colouring pixels off the screen - hopefully it will work now.

Great to see some more entries coming in! That's one weird rainbow, Phaelax - nobody has ever written collision detection for a rainbow before! It's neat code though.

I've nothing against data statements. The no media rule was really to make testing other peoples code hassle free, and to place the emphasis on the code rather than the gloss - but I'd say use 'em if you want.

Nice terrain you've got there CF - looking forward to seeing some weather on it!


Back to top
Andromedus.com
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 00:13           | link | toggle

@ ric my only objection to data statements is the abuse of them. I could put in a nice thunder clap if I am willing to make everyone on dial up wait a couple minutes for the page to load. I am on dial up myself and it would kinda be a pain if someone put a cartography shop map in data statements.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 00:17     Edited: 12th Feb 2005 00:27     | link | toggle

lol ! I've updated rule 2 - hopefully people will respect the word 'reasonable'!

Just noticed the water on your terrain CF - looks nice, although it seems to disappear at certain camera angles, as the lighting changes.


Back to top
Andromedus.com
Report this message as abusive
Suicidal Sledder

User


Joined: Tue Aug 17th 2004
Location: Watching you through a scope of an M24
Posted: 12th Feb 2005 01:10           | link | toggle

Here's a sort of lightning thingy...
+ Code Snippet
make object box 1,4000,5,4000
color object 1,RGB(00,00,00)
make object sphere 2,25
color object 2,RGB(100,100,100)

randomize timer()
set ambient light 0 : make light 1
position light 1,1000,1000,1000
point light 1,1000,0,1000
set light range 1,1500
sync on : sync rate 1000

color ambient light RGB (250,250,250)

do
if upkey() = 1 then move object 2,7

if leftkey()=1 then ya =  wrapvalue(ya-1)
if rightkey()=1 then ya =  wrapvalue(ya+1)
yrotate object 2,ya

x#=object position x(2)
y#=object position y(2)
z#=object position z(2)
a#=object angle y(2)
d#=250
h#=185
s#=40
set camera to follow x#,y#,z#,a#,d#,h#,s#,1
set ambient light 0
hide light 1
light = rnd(400)
color backdrop RGB(50,50,50)
if light = 5 then : lightning = 1 : count = 30
if lightning = 1 and count > 0 then set ambient light 100 : color backdrop RGB(150,150,150)


dec count
sync
loop


"See?!?! Port IS left and starboard is RIGHT!!" - Hobbes
Back to top
Send AIM user a message
Report this message as abusive
Cryptoman

User


Joined: Mon Nov 24th 2003
Location: Utah Mountains
Posted: 12th Feb 2005 01:40           | link | toggle

Pretty cool lighting sledder. This weather stuff is all over my head. Nice to see some examples. I don't do well with 3d.


Back to top
Find user on ICQ
Report this message as abusive
Suicidal Sledder

User


Joined: Tue Aug 17th 2004
Location: Watching you through a scope of an M24
Posted: 12th Feb 2005 01:42           | link | toggle

Thx for the complement Trs80

"See?!?! Port IS left and starboard is RIGHT!!" - Hobbes
Back to top
Send AIM user a message
Report this message as abusive
Google Ad
Back to top
 
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 02:33     Edited: 12th Feb 2005 02:35     | link | toggle

Well here is my rediculous entry. I really wasted most of my time making an alphablended terrain of sorts. My first. please discount that in judging as it is not weather related.

+ Code Snippet
REM Project: Weather challenge
REM Created: 2/10/2005 9:01:35 PM
REM By Coding Fodder
REM ***** Main Source File *****
REM
REM Not cleaned up yet Kinda trashy coding with cool results

sync on:sync rate 0
autocam off
fog on
position camera 2500,500,2500
global strike
global strike2
global counter
global counter2
x_size=5000
z_size=5000
x_tiles=100
z_tiles=100
seed=0

if seed=0 then seed=timer()

type matrix
   x_grids as integer
   z_grids as integer
   grid_spacing as float
endtype

dim matrices(4) as matrix

create bitmap 1,16,16
make memblock from bitmap 1,1
for i=0 to 15
   for j=0 to 15
      read color
      set_memblock_pixel(1,i,j,color)
   next j
next i
make bitmap from memblock 1,1
delete memblock 1
get image 1,0,0,15,15



make matrix 1,5000,5000,100,100
position matrix 1,50,-10,50

for m=1 to 2
   my_matrix(m,100,100,50)
   Matrix_form_function(m,"seed "+str$(seed)+" sin 150 200 1,150 200 1 0 5 3,0 5 3 5 10 3,5 10 3 8 15 3,8 15 3 0 10 3,0 10 3 0 8 3,0 8 3 roughen 6 300 ",2,700)
   set_matrix_normals(m)
   if m=1
   for i=1 to 100
      for j=1 to 100
         set_uv(m,i,j,(i-1)/10.0,(j-1)/10.0)
      next j
   next i
   endif

   make mesh from memblock m,m
   change mesh m,0,m
   texture object m,1
next m
`remstart
create bitmap 3,12,1
make memblock from bitmap 3,3
for i=0 to 11
   read color
   set_memblock_pixel(3,i,0,color)
next i
make bitmap from memblock 3,3
set current bitmap 0
lock pixels
for i=1 to 256
   for j=1 to 256
      x#=i*100.0/256.0*50.0
      z#=j*100.0/256.0*50.0
      h#=get ground height(1,x#,z#)
      hmap=0
      if h#>30.0 then hmap=1
      if h#>70.0 then hmap=2
      if h#>120.0 then hmap=3
      if h#>170.0 then hmap=4
      if h#>220.0 then hmap=5
      if h#>270.0 then hmap=6
      if h#>320.0 then hmap=7
      if h#>370.0 then hmap=8
      if h#>420.0 then hmap=9
      if h#>470.0 then hmap=10
      if h#>520.0 then hmap=11
      color=get_memblock_pixel(3,hmap,0)
      red=rgbr(color)
      green=rgbg(color)
      blue=rgbb(color)
      red=red+rnd(20)-10
      blue=blue+rnd(20)-10
      green=green+rnd(20)-10
      if red<0 then red=0
      if green<0 then green=0
      if blue<0 then blue=0
      if red>255 then red=255
      if green>255 then green=255
      if blue>255 then blue=255
      set_locked_pixel(256-i,256-j,rgb(red,green,blue))
   next j
next i
delete memblock 3
delete bitmap 3
delete memblock 1
delete memblock 2
delete bitmap 1
unlock pixels
get image 2,0,0,255,255
texture object 2,2

set current bitmap 0
ghost object on 2
make object plain 3,5000,5000
xrotate object 3,-90
create bitmap 3,640,480
color=rgb(0,0,200)
box 0,0,640,480,color,color,color,color
get image 3,0,0,639,479
texture object 3,3

set object specular 3,rgb(0,0,200)
set object specular power 3,100

set current bitmap 0
ghost object on 3
position object 3,2500,0,2500

make object plain 4,640,480
position object 4,0,0,50
lock object on 4
color object 4,RGB(255,255,255)
ghost object on 4

`hide object 1
hide object 4

create bitmap 10,8,64
make memblock from bitmap 10,10
for j=0 to 63
   for i=0 to 7
      read color
      set_memblock_pixel(10,i,j,color)
   next i
next j
make bitmap from memblock 10,10
delete memblock 10
get image 10,0,0,7,63

sprite 1,0,0,10
set current bitmap 0
do
   angle#=wrapvalue(angle#+0.5)
   wave#=sin(angle#)*5
   position object 3,2500,wave#,2500
   text 1,1,str$(screen fps())+" "+str$(seed)
   control camera using arrowkeys 0,3,2
   position camera camera position x(),get ground height(1,camera position x(),camera position z())+50,camera position z()

   if mouseclick()=1 then strike=1
   if strike=1 then lightning()

   sync
loop

function lightning()
   if strike2=0
    size sprite 1,mousey()/8,mousey()
    show sprite 1
    offset sprite 1,-mousex(),0

    show object 4
      inc counter2
      if counter2=6
        strike2=1
        mirror sprite 1
        inc counter
        counter2=0
      endif
   else
      inc counter2
      hide object 4
      hide sprite 1
      if counter2=5
         strike2=0
         inc counter
         counter2=0
      endif
   endif
   if counter=10
      strike2=0
      hide object 4
      counter=0
      strike=0
   endif
endfunction

function my_matrix(num,x_grids,z_grids,grid_spacing)
   matrices(num).x_grids=x_grids
   matrices(num).z_grids=z_grids
   matrices(num).grid_spacing=grid_spacing
   make memblock num,(6*x_grids*z_grids*32)+12
   write memblock dword num,0,274
   write memblock dword num,4,32
   write memblock dword num,8,6*x_grids*z_grids

   for i=1 to x_grids+1
      for j=1 to z_grids+1
         position_vert(num,i,j,i*grid_spacing,-10.0,j*grid_spacing)
         num1#=(1+matrices(num).x_grids-i)
         num2#=matrices(num).x_grids
         num3#=(1+matrices(num).z_grids-j)
         num4#=matrices(num).z_grids
         set_uv(num,i,j,num1#/num2#,num3#/num4#)
         set_normals(num,i,j,0,1,0)
      next j
   next i
   make mesh from memblock num,num
   make object num,num,1
endfunction

function set_normals(num,i,j,nx#,ny#,nz#)
   x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_normal_x(num,1+(i-1)*6+x*(j-1),nx#)
      set_normal_y(num,1+(i-1)*6+x*(j-1),ny#)
      set_normal_z(num,1+(i-1)*6+x*(j-1),nz#)
      set_normal_x(num,4+(i-1)*6+x*(j-1),nx#)
      set_normal_y(num,4+(i-1)*6+x*(j-1),ny#)
      set_normal_z(num,4+(i-1)*6+x*(j-1),nz#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_normal_x(num,6+(i-2)*6+x*(j-1),nx#)
      set_normal_y(num,6+(i-2)*6+x*(j-1),ny#)
      set_normal_z(num,6+(i-2)*6+x*(j-1),nz#)
   endif
   if i>1 and j>1
      set_normal_x(num,3+(i-2)*6+x*(j-2),nx#)
      set_normal_y(num,3+(i-2)*6+x*(j-2),ny#)
      set_normal_z(num,3+(i-2)*6+x*(j-2),nz#)
      set_normal_x(num,5+(i-2)*6+x*(j-2),nx#)
      set_normal_y(num,5+(i-2)*6+x*(j-2),ny#)
      set_normal_z(num,5+(i-2)*6+x*(j-2),nz#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_normal_x(num,2+(i-1)*6+x*(j-2),nx#)
      set_normal_y(num,2+(i-1)*6+x*(j-2),ny#)
      set_normal_z(num,2+(i-1)*6+x*(j-2),nz#)
   endif
endfunction

function set_uv(num,i,j,u#,v#)
 x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_U(num,1+(i-1)*6+x*(j-1),u#)
      set_v(num,1+(i-1)*6+x*(j-1),v#)
      set_u(num,4+(i-1)*6+x*(j-1),u#)
      set_v(num,4+(i-1)*6+x*(j-1),v#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_u(num,6+(i-2)*6+x*(j-1),u#)
      set_v(num,6+(i-2)*6+x*(j-1),v#)
   endif
   if i>1 and j>1
      set_u(num,3+(i-2)*6+x*(j-2),u#)
      set_v(num,3+(i-2)*6+x*(j-2),v#)
      set_u(num,5+(i-2)*6+x*(j-2),u#)
      set_v(num,5+(i-2)*6+x*(j-2),v#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_u(num,2+(i-1)*6+x*(j-2),u#)
      set_v(num,2+(i-1)*6+x*(j-2),v#)
   endif
endfunction

function position_vert(num,i,j,x#,y#,z#)
 x=6*matrices(num).x_grids
   if i<matrices(num).x_grids+1 and j<matrices(num).z_grids+1
      set_vertex_x(num,1+(i-1)*6+x*(j-1),x#)
      set_vertex_y(num,1+(i-1)*6+x*(j-1),y#)
      set_vertex_z(num,1+(i-1)*6+x*(j-1),z#)
      set_vertex_x(num,4+(i-1)*6+x*(j-1),x#)
      set_vertex_y(num,4+(i-1)*6+x*(j-1),y#)
      set_vertex_z(num,4+(i-1)*6+x*(j-1),z#)
   endif
   if i>1 and j<matrices(num).z_grids+1
      set_vertex_x(num,6+(i-2)*6+x*(j-1),x#)
      set_vertex_y(num,6+(i-2)*6+x*(j-1),y#)
      set_vertex_z(num,6+(i-2)*6+x*(j-1),z#)
   endif
   if i>1 and j>1
      set_vertex_x(num,3+(i-2)*6+x*(j-2),x#)
      set_vertex_y(num,3+(i-2)*6+x*(j-2),y#)
      set_vertex_z(num,3+(i-2)*6+x*(j-2),z#)
      set_vertex_x(num,5+(i-2)*6+x*(j-2),x#)
      set_vertex_y(num,5+(i-2)*6+x*(j-2),y#)
      set_vertex_z(num,5+(i-2)*6+x*(j-2),z#)
   endif
   if i<matrices(num).x_grids+1 and j>1
      set_vertex_x(num,2+(i-1)*6+x*(j-2),x#)
      set_vertex_y(num,2+(i-1)*6+x*(j-2),y#)
      set_vertex_z(num,2+(i-1)*6+x*(j-2),z#)
   endif
endfunction


rem  Accessor and mutator functions for vertex data
function Polygons(num)
   polyg=memblock dword(num,8)/3
endfunction polyg

function get_vertex_x(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+12)
endfunction result#

function get_vertex_y(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+16)
endfunction result#

function get_vertex_z(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+20)
endfunction result#

function set_vertex_x(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+12,val#
endfunction

function set_vertex_y(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+16,val#
endfunction

function set_vertex_z(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+20,val#
endfunction



function get_normal_x(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+24)
endfunction result#

function get_normal_y(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+28)
endfunction result#

function get_normal_z(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+32)
endfunction result#

function set_normal_x(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+24,val#
endfunction

function set_normal_y(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+28,val#
endfunction

function set_normal_z(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+32,val#
endfunction



function get_U(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+36)
endfunction result#

function get_V(num,vertnum)
   result#=memblock float(num,(vertnum-1)*32+40)
endfunction result#

function set_U(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+36,val#
endfunction

function set_V(num,vertnum,val#)
   write memblock float num,(vertnum-1)*32+40,val#
endfunction

function Matrix_form_function(num,format$,scale#,offset#)
 continue=1
   width=matrices(num).x_grids
   length=matrices(num).z_grids
   dim sinarray1#(width/4)
   dim sinarray2#(length/4)
   dim cosarray1#(width/4)
   dim cosarray2#(length/4)
   dim radialcos#(40)

   strlength=len(format$)
   position=1
   while continue=1
      locate=next_command(format$,position)
      command$=lower$(right$(Left$(format$,locate),locate-position+1))

      position=locate+2

      select command$
         case "sin":funct$="sin":begin=0:wavenum=1:endcase
         case "cos":funct$="cos":begin=0:wavenum=1:endcase
         case "radialcos":funct$="rcos":begin=0:wavenum=1:endcase
         case "rimwall":funct$="rwall":endcase
         case "seed":randomize (val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1))):position=next_command(format$,position)+2:endcase
         case "wn":wavenum=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case "ct":centerx=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2
                   centerz=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case " "::endcase
         case ","::endcase
         case "roughen":rough=1:roughstart=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2
         roughamount=val(right$(left$(format$,next_command(format$,position)),next_command(format$,position)-position+1)):position=next_command(format$,position)+2:endcase
         case ")"::endcase
         case default:i=val(command$):inc begin:endcase
      endselect

      if begin>0
         select funct$
            case "sin"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:sinarray1#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:sinarray1#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:sinarray1#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                  endcase
                  case 4:min=i:endcase
                  case 5:max=i:endcase
                  case 6
                     select i
                        case 1:sinarray2#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:sinarray2#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:sinarray2#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase

            case "cos"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:cosarray1#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:cosarray1#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:cosarray1#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                  endcase
                  case 4:min=i:endcase
                  case 5:max=i:endcase
                  case 6
                     select i
                        case 1:cosarray2#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:cosarray2#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:cosarray2#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase

            case "rcos"
               select begin
                  case 1:min=i:endcase
                  case 2:max=i:endcase
                  case 3
                     select i
                        case 1:radialcos#(wavenum)=scale#*(rnd(max-min)+max):endcase
                        case 2:radialcos#(wavenum)=scale#*(-1*(rnd(max-min)+max)):endcase
                        case 3:radialcos#(wavenum)=scale#*((-1)^(rnd(2))*(rnd(max-min)+max)):endcase
                     endselect
                     inc wavenum
                     begin=0
                  endcase
               endselect
            endcase
         endselect
      endif

      if rough=1
         scaling#=roughamount
         for i=roughstart to width/4
            sinarray1#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            sinarray2#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            cosarray1#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            cosarray2#(i)= scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/700.0
            radialcos#(i)=scaling#*scale#*(rnd(10))*((-1)^(rnd(2)))/200.0
            scaling#=scaling#*0.94

         next i
         rough=0
      endif
   if position >= strlength then continue=0
   endwhile

   for i=0 to width
      for j=0 to length
         height#=0
         for x=1 to width/4
            height#=height#+(sinarray1#(x)*sin((x*i*180.0)/width))+(cosarray1#(x)*cos((x*i*180.0)/width))
         next x

         for y= 1 to length/4
            height#=height#+(sinarray2#(y)*sin((y*j*180.0)/length))+(cosarray2#(y)*cos((y*j*180.0)/length))
         next y

         distance#=sqrt(((width/2)-i)^2+((length/2)-j)^2)
         for x=1 to 40
            height#=height#+(radialcos#(x)*cos((x*distance#*180/width)))
         next x

         position_vert(num,i+1,j+1,(i+1)*matrices(num).grid_spacing,height#-offset#,(j+1)*matrices(num).grid_spacing)
         if num=1 then set matrix height 1,i,j,height#-offset#
      next j
   next i
   make mesh from memblock num,num
   change mesh num,0,num
   if num=1 then update matrix 1
   undim sinarray1#(0)
   undim sinarray2#(0)
   undim cosarray1#(0)
   undim cosarray2#(0)
   undim radialcos#(0)

endfunction

function next_command(format$,position)
   found=0
   length=len(format$)
   locate=position
   while found=0

      if locate>length
         found=1
      else
         if mid$(format$,locate)=" " or mid$(format$,locate)=","
            found=1
         endif
      endif
      inc locate
   endwhile
   locate=locate-2
endfunction locate

function set_matrix_normals(num)
   r=make vector3(vector)
      for i=2 to matrices(num).x_grids-1
         for j=2 to matrices(num).z_grids-1
            us#=((get_vertex_y(num,1+(i-2)*6+(j-1)*matrices(num).x_grids*6)-get_vertex_y(num,1+(i)*6+(j-1)*matrices(num).x_grids*6))/matrices(num).grid_spacing)
            vs#=((get_vertex_y(num,1+(i-1)*6+(j-2)*matrices(num).x_grids*6)-get_vertex_y(num,1+(i-1)*6+(j)*matrices(num).x_grids*6))/matrices(num).grid_spacing)
            set vector3 vector,us#,1,vs#
            normalize vector3 norm,vector
            set_normals(num,i,j,x vector3(norm),y vector3(norm),z vector3(norm))
         next j
      next i
   make mesh from memblock num,num
   change mesh num,0,num
endfunction

function set_memblock_pixel(memblock,x,y,color)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>-1 and y>-1 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      write memblock dword memblock,pointer,color
   endif
endfunction

function get_memblock_pixel(memblock,x,y)
   width=memblock dword(memblock,0)
   height=memblock dword(memblock,4)
   depth=memblock dword(memblock,8)
   if x>-1 and y>-1 and x<width and y<height
      pointer=y*width*depth/8+x*depth/8+12
      value=memblock dword(memblock,pointer)
   endif
endfunction value

function set_locked_pixel(x,y,color_value)
   start=get pixels pointer()
   repeat_number=get pixels pitch()
   bits_per_pixel=bitmap depth(num)/8
   pointer=start+y*repeat_number+x*bits_per_pixel
   *pointer=color_value
endfunction

DATA -16777216,-16316665,-15527149,-15922164,-16316410,-15658222,-14869218,-15396076,-16382713,-16776959,-16776960,-16777215,-16645886,-16777215,-16776960,-16777216
DATA -16777216,-15592942,-9474193,-14869476,-16513531,-15987187,-15592684,-15659761,-15793144,-16383486,-16711680,-16777216,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16119286,-15000804,-15527149,-16316665,-16316664,-16382202,-15530744,-9501146,-15203318,-16579837,-16645629,-16710911,-16711167,-16711423,-16777216
DATA -16777215,-16711680,-16579836,-15987444,-15395307,-15461358,-15988213,-15792631,-14612719,-15135470,-15593454,-15856628,-15724016,-15395564,-16119799,-16711422
DATA -16382970,-16645887,-16448251,-15264234,-14013910,-14014167,-15001318,-15856114,-15922161,-15198440,-14606560,-15263722,-14606048,-12303294,-14869987,-15725551
DATA -15988467,-16645375,-16579579,-15395563,-14013654,-13421773,-14146010,-15263977,-15593454,-15132648,-14868963,-15198186,-15066855,-14803683,-14476254,-13557455
DATA -16185847,-16645886,-16514045,-15987187,-14934755,-14014166,-14146009,-15001062,-15592428,-15198182,-14803426,-15198185,-15855857,-16053749,-15594223,-15397356
DATA -16382461,-15790077,-15856380,-16053237,-15658220,-15066596,-15001061,-15461355,-15592939,-14803682,-13882582,-14343132,-15527149,-16251129,-16448507,-16514301
DATA -15395833,-13290744,-14935290,-15987702,-15790061,-15790318,-15921905,-15987444,-15658735,-14737632,-13685202,-13553616,-14935269,-15987444,-16316921,-16513787
DATA -14474726,-14211824,-15198711,-16185336,-16119542,-15987956,-15987957,-15790578,-15066854,-14211290,-14145238,-14408923,-14671585,-15066598,-15658478,-15526892
DATA -12960711,-15198444,-16250616,-16514044,-16447482,-15790065,-15000805,-15000548,-14211545,-12566977,-13817043,-15198441,-14737890,-14079446,-15197927,-14605791
DATA -15263721,-16053492,-16316921,-16579323,-16447481,-15592686,-14145755,-14606048,-14408411,-12829381,-14013911,-15329513,-15263974,-14935264,-15592938,-15592430
DATA -16711166,-16711424,-14606046,-15461613,-16185079,-15856114,-15395307,-15395308,-15330027,-14803684,-14540253,-14211546,-13948625,-15455823,-15394523,-16381945
DATA -16777216,-16777215,-10921639,-14606304,-16053493,-16250873,-16184566,-16119543,-16119800,-15922162,-15066341,-13356236,-12500923,-12170916,-14539472,-16382201
DATA -16777216,-16777216,-14145753,-15329769,-16185079,-16250616,-16184565,-16250872,-16448508,-16382714,-15921907,-14935013,-13290443,-11711155,-14606047,-16448251
DATA -16777216,-16777216,-16316923,-16382714,-16316666,-15855857,-15461099,-15724784,-16448251,-16580605,-16579838,-16316666,-15724270,-15197928,-15987444,-16645887

DATA -536462,-7679992,-15684847,-15690223,-9395701,-9402101,-8164061,-8171997,-8095918,-6645352,-3947582,-1381913

DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-1835773,-16777216,-1835773,-1835773
DATA -16777216,-16777216,-197381,-16777216,-1835773,-197381,-1835773,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-1835773,-16777216,-16777216,-1835773,-1835773,-16777216
DATA -16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-197381,-1835773,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-197381,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-197381,-1835773,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-1835773,-16777216,-197381,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-16777216,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-197381,-197381,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-1835773,-16777216,-16777216,-16777216,-197381,-16777216,-16777216
DATA -16777216,-1835773,-16777216,-16777216,-16777216,-197381,-16777216,-16777216
DATA -1835773,-1835773,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-197381,-1835773,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -16777216,-16777216,-16777216,-1835773,-1835773,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-1835773,-1835773,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-1835773,-16777216,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-1835773,-1835773,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-1835773,-16777216
DATA -16777216,-16777216,-197381,-197381,-16777216,-16777216,-1835773,-1835773
DATA -16777216,-1835773,-1835773,-1835773,-1835773,-16777216,-16777216,-1835773
DATA -16777216,-1835773,-16777216,-16777216,-1835773,-16777216,-16777216,-16777216
DATA -1835773,-1835773,-16777216,-1835773,-1835773,-16777216,-16777216,-16777216
DATA -1835773,-16777216,-16777216,-197381,-197381,-16777216,-16777216,-16777216


Just walk around with the arrow keys playing god with the lightning. If someone can get the sprite to scale with distance that would be tremendous.

[edit] oops call down your lightnings with the mouse.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 02:34     Edited: 12th Feb 2005 02:35     | link | toggle

that lightning gives me a headache. How bout adding some lightning bolts that branch off?

I had a good idea involving clouds, but my perlin noise generator isn't finished yet.

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 02:42           | link | toggle

yah it is way too regular and streight. I am kinda limited in the media department tough. I am trying to think of a way to randomize it.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 02:58           | link | toggle

Quote: "my perlin noise generator "

That sounds pretty cool.

CF: That could be a really comical game! Kill the bad guys with lightning ..... oh hold on, has that been done before?


Back to top
Andromedus.com
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 03:11     Edited: 12th Feb 2005 03:11     | link | toggle

grr, DB really needs some "filled-in" 2d commands.

Quote: "oh hold on, has that been done before?"
quake, unreal, etc...

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 03:18           | link | toggle

+ Code Snippet
box 20,20,60,60
wait key





Back to top
Andromedus.com
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 03:34     Edited: 12th Feb 2005 03:37     | link | toggle

What kind of filled in commands do you need? I can supply those.

+ Code Snippet
function solid_circle(x,y,radius,color)
lock pixels
ptr=get pixels pointer()
this=get pixels pitch()
that =bitmap depth()/8
for i=1 to radius*2
   for j=1 to radius*2
      pointer=ptr+((y+j-radius)*this)+(x-radius+i)*that
      if (radius-i)^2+(radius-j)^2<=radius^2 then *pointer=color
   next j
next i
unlock pixels
endfunction


Ric, I was thinking little scurrying rodents. Sorry I have not played any of the afore mentioned games.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 04:33           | link | toggle

The ellipse mostly, so I could make some cheap looking clouds. I can add the other radius to your function, thx.

Here's a different example. Rain demo. Use the mouse to move the ball through the air and watch the rain repel off. I get 26fps on this. Over 80fps if I remove this little bit:
+ Code Snippet
      for i = 1 to 6
         x = rain(t).x + sin(angle)*i
         y = rain(t).y + cos(angle)*i
         pDot(x,y,rgb(0,0,255-i*30))
      next i



Full example:
+ Code Snippet
backdrop on
color backdrop 0
sync on
sync rate 0
hide mouse

Global width = 640
Global height = 480

type particle
   x as float
   y as float
   vx as float
   vy as float
   f as float
   g as float
   color as dword
endtype


amount = 3000
dim rain(amount) as particle

for t = 1 to amount
   rain(t).x = rnd(width)
   rain(t).y = rnd(height)
   rain(t).color = rgb(0,0,255)
next t


repeat

   lock pixels

   for t = 1 to amount
      oldx = rain(t).x
      oldy = rain(t).y
      rain(t).x = rain(t).x + rain(t).vx*rain(t).f
      rain(t).y = rain(t).y + rain(t).vy*rain(t).f + rain(t).g
      if rain(t).g < 5 then rain(t).g = rain(t).g + 0.01
      if rain(t).f > 0
         rain(t).f = rain(t).f - 0.1
      else
         rain(t).f = 0
      endif


      rem if rain hits ball
      if ((rain(t).x-mousex())^2 + (rain(t).y-mousey())^2) <= 100
         x# = (rain(t).x - mousex())/10.0
         y# = (rain(t).y - mousey())/10.0

         rain(t).vx = x#
         rain(t).vy = y#
         rain(t).f = 4
      endif
      if rain(t).y >= height OR rain(t).y <= 0 OR rain(t).x >= width OR rain(t).x <= 0
         rain(t).x = rnd(width)
         rain(t).y = 1
         rain(t).vx = 0
         rain(t).vy = 0
         rain(t).g = 0
         `rain(t).color = rgb(200,200,rnd(55)+200)
         rain(t).color = rgb(0,0,255)
      endif


      angle = wrapvalue(atanfull(oldx-rain(t).x,oldy-rain(t).y))
      pDot(rain(t).x,rain(t).y,rain(t).color)

      for i = 1 to 6
         x = rain(t).x + sin(angle)*i
         y = rain(t).y + cos(angle)*i
         pDot(x,y,rgb(0,0,255-i*30))
      next i
   next t

   unlock pixels

   circle mousex(), mousey(),10

   sync
until spacekey()


function frictionDirection#(f as float)
   if f > 0 then exitfunction 1
   if f < 0 then exitfunction -1
endfunction 0


REM function borrowed from Coding Fodder's Rain code
function pDot(x as integer, y as integer, color_value as dword )
   if x > 0 and x < width and y > 0 and y < height
      start = get pixels pointer()
      repeat_number = get pixels pitch()
      bits_per_pixel = bitmap depth(num)/8
      pointer = start + y*repeat_number + x*bits_per_pixel
      *pointer = color_value
   endif
endfunction


"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 05:42           | link | toggle

hey neat, I like the little drops with tails.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
RiiDii

User


Joined: Thu Jan 20th 2005
Location: Inatincan
Posted: 12th Feb 2005 12:31           | link | toggle

Here's my entry. Please forgive the blank screen and the long wait at the beginning. I decided to do random stuff since no media is allowed, and... well... I have to still improve how quickly it gets done.

PLANET STORM:
+ Code Snippet
Set Display Mode 1280,960,32
Hide Mouse
Color Backdrop 0
Set Ambient light 20
Set Point Light 0,0,0,0
Position Light 0,2000,90,90
Color Light 0,RGB(255,204,204)
Set Light Range 0,10000
sync on : sync rate 60 : Color Backdrop rgb(0,0,0)
set camera range 0,.5,7000
Position Camera 0,0,0,0
Autocam off
Set Image Colorkey 0,0,0
Randomize Timer()

Text$="Please wait... Creating world for PLANET STORM!"
Create Bitmap 1,Text Width(Text$)+5,Text Height(Text$)+5
Set Cursor 0,0
Ink RGB(231,223,84),0
Print Text$
Get Image 100,0,0,BitMap Width(),BitMap Height()
Delete Bitmap 1
Set Current Bitmap 0
Sprite 1,25,25,100
Sync
Sleep 5000
Delete Sprite 1

CreateStarField()
CreatePlanet()
CreateClouds()

Make Object Sphere 4,1000,50,50
Texture Object 4,4
Make Object Sphere 5,1050,50,50
Texture Object 5,5
Ghost Object On 5
Fade Object 5,80
Position Object 4,-300,-80,3000
Position Object 5,-300,-80,3000
Make Object Sphere 6,1010,50,50
Texture Object 6,5
Ghost Object On 6
Fade Object 6,70
Position Object 6,-300,-80,3000

Turn Object Right 4,60
Pitch Object Down 4,20
Turn Object Right 5,62
Pitch Object Down 5,22
Turn Object Right 6,58
Pitch Object Down 6,18
Turn Object Right 6,170


Do
   Turn Object Right 4,.05
   Turn Object Right 5,.04
   Turn Object Right 6,.05
   If Rnd(200)=1 and Lightening<1
      Lightening=20
      Make Light 1
      Set Point Light 1,rnd(800)-700,Rnd(500)-220,2600
      Point Light 1,-300,-80,3000
   Endif
   If Lightening>0
      Color Light 1,Rgb(Rnd(255),Rnd(255),Rnd(255))
      Lightening=Lightening-1
      If Lightening<1
         Color Light 1,0
         Delete Light 1
      Endif
   Endif
   Sync
Loop

Function CreateClouds()
Create Bitmap 1,640,480

Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0

For j = 1 to rnd(80)+50
Ink rgb(rnd(55)+200,rnd(55)+200,rnd(55)+200),0
Radius1 = Rnd(30)+20
Radius2 = Rnd(30)+20
cx=rnd(640)-1
cy=rnd(480)-1
For i = 0 to 360 Step 2
   Radius1=Radius1+(Rnd(4)-2)
   Radius2=Radius2+(Rnd(4)-2)
   If Radius1<1 Then Radius1=1
   If Radius2<1 Then Radius2=1
   x#=Cos(i)*(Radius2)+cx
   y#=Sin(i)*(Radius1)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j


For i = 1 to 5
Blur Bitmap 1,6
Next i

Get Image 5,1,1,639,479
Set Current Bitmap 0
Delete Bitmap 1
EndFunction

Function CreatePlanet()
create bitmap 1,640,480
Ink rgb(10,10,240),1

For i = 0 to 480
   Line 0,i,640,i
Next i

For j = 1 to rnd(10)+7
Ink rgb(10,rnd(100)+50,10),1
Radius = Rnd(50)+25
cx=rnd(530)+55
cy=rnd(370)+55
For i = 0 to 720
   Radius=Radius+(Rnd(4)-2)
   x#=Cos(i/2)*(Radius)+cx
   y#=Sin(i/2)*(Radius)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j
For i = 1 to 5: Rem change back to 10
Blur Bitmap 1,6
Next i
Get Image 4,1,1,639,479
Set Current Bitmap 0
Delete Bitmap 1
EndFunction

Function CreateStarField()
create bitmap 1,1000,1000
For j = 1 to 3
For i = 1 to 1500
Ink rgb(200+rnd(55),200+rnd(55),200+rnd(55)),0
   Dot Rnd(1000),Rnd(1000)
Next i
Blur Bitmap 1,1
Next j
Get Image 16,0,0,999,950
Set Current Bitmap 0
Make Object Sphere 2, 10000
Texture Object 2,16
Scale Object Texture 2,8,8
Position Object 2,0,0,0
Set Object Light 2,0
Set Object Cull 2,0
Fade Object 2,1000
Delete Bitmap 1
Set Object Collision Off 2
CreateGas()
Get Image 2,1,1,639,479
Set Current Bitmap 0
Make Object Sphere 3,9000,50,50
Texture Object 3,2
Rem Scale Object Texture 3,.99,.99
Set Object Transparency 3,1
Set Object Cull 3,0
Ghost Object On 3
Set Object Light 3,0
Fade Object 3,20
Delete Bitmap 1
Set Object Collision Off 3
Rem Return Object 2 as Background Sphere (Starfield)
EndFunction

Function CreateGas()
Create Bitmap 1,640,480

Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0

For j = 1 to rnd(25)+25
Ink rgb(rnd(100)+50,rnd(100)+50,rnd(100)+50),0
Radius1 = Rnd(10)+10
Radius2 = Rnd(10)+10
cx=rnd(640)-1
cy=rnd(480)-1
For i = 0 to 360 Step 5
   Radius1=Radius1+(Rnd(2)-1)
   Radius2=Radius2+(Rnd(4)-2)
   If Radius1<1 Then Radius1=1
   If Radius2<1 Then Radius2=1
   x#=Cos(i)*(Radius2)+cx
   y#=Sin(i)*(Radius1)+cy
   Line cx,cy,x#,y#
   If x#>639
      x#=x#-639
      Line 0,cy,x#,y#
   Endif
   If x#<0
      x#=x#+639
      Line 639,cy,x#,y#
   Endif
Next i
Next j


For i = 1 to 3
Blur Bitmap 1,6
Next i

EndFunction



"Droids don't rip your arms off when they lose." -H. Solo

REALITY II
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 13:17           | link | toggle

Ok, I give up. Give the prize to Riidii. It was kinda cool, then I saw the lightning. Nice touch.

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 16:02           | link | toggle

@Phaelax - Rain, or 'sperm under a microscope' - either way it's pretty cool.

@RiiDii - well, I saw the blank screen, went to have a beer, came back saw a blank screen again, went off and did some shopping, make some phone calls, watched a footy match, came back and ..... wow! That's really nice, and quite amazing considering there's no media and only around 100 lines. Love the lightning - it looks totally realistic. And the clouds. And the nebulae in the background too - nice. Two commands I've never used before are 'fade' and 'blur bitmap' - I will now, though. Winner so far.


Back to top
Andromedus.com
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 17:16           | link | toggle

I used blur bitmap too!

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Cryptoman

User


Joined: Mon Nov 24th 2003
Location: Utah Mountains
Posted: 12th Feb 2005 17:35           | link | toggle

That's really cool RiDii.


Back to top
Find user on ICQ
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 17:40           | link | toggle

Quote: "I used blur bitmap too! "

Er .... where?


Back to top
Andromedus.com
Report this message as abusive
Coding Fodder

User


Joined: Thu Sep 25th 2003
Location: Somewhere in my cerebralcortex
Posted: 12th Feb 2005 17:53           | link | toggle

Very nice riidii worth the wait. I am going to have to throw in the towel on this one. Tough challenge ric. weather is quite difficult.

Something really catchy that makes people stop and think about the meaning of life and say to themselves "My but thats clever"
Back to top
Report this message as abusive
Phaelax

User


Joined: Wed Apr 16th 2003
Location: Ohio
Posted: 12th Feb 2005 18:02           | link | toggle

oops, at least I did use it in a previous snippet that I later decided to not upload. Ok, nevermind.

"eureka" - Archimedes
Back to top
Zimnox Find user on ICQ Send AIM user a message
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 19:15           | link | toggle

Well, I think it's been a great start to the challenge thread, and it's impressive what people can do in just a couple of days. Definitely tougher than I expected it would be, making weather effects!

Assuming nobody comes up with a last minute effort, I think it's safe to say Rii wins this one - Congrats! You become the new challenge setter for challenge number 2 .......... game on.




Back to top
Andromedus.com
Report this message as abusive
RiiDii

User


Joined: Thu Jan 20th 2005
Location: Inatincan
Posted: 12th Feb 2005 19:43           | link | toggle

Thank you, and thanks for the comments! @Ric lol! And nice thread by the way!

I'll post a challenge shortly (any suggestions?).

While trying to speed that puppy up, I was writing my own blur command based on some theories from another thread. Then I hit a bug! Take a look at this code (I've reduced the bug to it's simplest form, so the code is not worth much).

Ompc, the code breaks at Line 17: Create Bitmap 2,MW,MH, regardless of the order the functions are called in. The only difference is Line 14: percent#=(Rnd(10)+75)/100. Very odd. Any ideas why this is happening?

+ Code Snippet
Create Bitmap 1,200,200
MyBlur1(1,.8)
MyBlur2(1)
End

Function MyBlur1(MapNum,percent#)
MW=Bitmap Width(MapNum)*percent#
MH=Bitmap Height(MapNum)*percent#
Create Bitmap 2,MW,MH
Delete BitMap 2
EndFunction

Function MyBlur2(MapNum)
percent#=(Rnd(10)+75)/100:` This is the line giving me problems
MW=Bitmap Width(MapNum)*percent#
MH=Bitmap Height(MapNum)*percent#
Create Bitmap 2,MW,MH
Delete BitMap 2
EndFunction


"Droids don't rip your arms off when they lose." -H. Solo

REALITY II
Back to top
Report this message as abusive
Ric

User


Joined: Sun Jul 11th 2004
Location: object position x
Posted: 12th Feb 2005 20:46           | link | toggle

Stick a .0 on the end of 100, to turn the result into a float. Otherwise, it's calculating your percentage to be 0, because it's rounding to the nearest integer, which is resulting in an illegal bitmap area.

Possible themes for challenges: maths, graphics, AI, physics, effects, mini games, etc........




Back to top
Andromedus.com
Report this message as abusive

Go to the first page of this board Return to the Forum Menu Post Message
6,836 Messages - Page   of 171   
Search the Forum Next 40

This is a multi-page thread older than 30 days.
Go to the last page to check if you can reply to it.

Forum Search

Enter a word or phrase to search our Forum for:

Thread Subject Search
Search Phrase:
Search Scope: Entire forum
Just this board
 
Google Forum Search
Search Phrase:
 
Apollo v2.02


Dark Game Studio
Privacy Policy AUP Top of Page