Sorry your browser is not supported!

print "hello world!"
wait key

set text font "Comic Sans MS"
set text size 50
do
set text size rnd(50)
cls rgb(0,0,0)
set cursor rnd(screen width()),rnd(screen height())
ink rgb(rnd(255),rnd(255),rnd(255)),rgb(0,0,0)
print "Hello world!"
wait 1000
loop

set text font "Comic Sans MS"
set text size 50
do
 set text size rnd(50)
 ink rgb(rnd(255),rnd(255),rnd(255)),rgb(0,0,0)
 center text rnd(screen width()),rnd(screen height()),"Hello world!"
 wait 50
loop

Rem Project: hello World
Rem Created: Tuesday, December 07, 2010

Rem ***** Main Source File *****
set display mode 800,600,32,1
sync on
autocam off
backdrop off
set text font "Arial"
x=screen width()/2
y=screen height()/2
set text size 10
hello$="*Hello World!*"
ink rgb(0,255,0),rgb(0,0,0)
cls rgb(0,220,0)
length=len(hello$)

for xpos= 0 to x*2 step 14
    
ink rgb(0,rnd(100)+150,0),rgb(0,0,0)
for ypos= 0 to y*2 step (16*length)
    for count= 1 to length
        a$=mid$(hello$,count) 
        text xpos,ypos+(count*16),a$
    next count
next ypos    
next xpos
count=0
for column=0 to 49
    inc count
    get image count,column*16,0,(column*16)+16,600
    make object plane count,14,600
    texture object count,count
    position object count,column*14,0,0
next xpos1

position camera 240,0,-300
count=0
speed#=0
set text size 25
ink rgb(255,255,255),0
do

for column=0 to 49
    inc count
    if count<25
        inc speed#,.05
        else
        dec speed#,.05
    ENDIF
    scroll object texture count,0,-0.001*speed#
next xpos1

if count>=50
    count=0
endif

inc typecount
if typecount>=100
    typecount=0
    inc letter
    b$=mid$(hello$,letter)
    text$=text$+b$
endif

if letter=length
    letter=0
    text$=""
ENDIF

text 0,0,text$
sync
LOOP

` Hello world
sync on : sync rate 0 : hide mouse
set text font "arial" : set text size 12 : set text transparent

hw$="Hello world!            "
h=text height(hw$):w=text width(hw$)
print hw$
get image 1,1,1,w,h,1

make object cylinder 1,200
texture object 1,1
scale object 1,100,20,100
color backdrop 0,rgb(0,0,0)
point camera 0,0,0,0

do
   oy=object angle y(1)+1
   yrotate object 1,oy
   wait 10
   sync
loop

SET DISPLAY MODE desktop width(),desktop height(),32

sync on : sync rate 0 :
color backdrop rgb(0,0,0) : hide mouse
set text font "Ariel" : set text size 16 : set text transparent
set ambient light 75
autocam off
set camera range 0,1,1001001
randomize timer()

c as dword
ob=100

t$="Hello Galaxy!"
tw=text width(t$)
th=text height(t$)

create bitmap 1,tw,th
set cursor 0,0
print t$
lock pixels
for y=0 to th
   for x=0 to tw
      c=point(x,y)
      if c<>0
         r=1+rnd(49)
         inc ob,1
         make object sphere ob,.2
         position object ob,r*(x-(tw/2)),r*((th/2)-y),r*50
         s=r*100
         scale object ob,s,s,s
         color object ob,rgb(255,255,0)
      endif
   next x
next y
unlock pixels

delete bitmap 1
set current bitmap 0
set text size 18

gosub SetupStarSphere

make object sphere ob+1,1
color object ob+1,rgb(255,0,0)

do
   control camera using arrowkeys 0,.05,.05
   text 10,10,"fps: "+str$(screen fps())
   text 10,25,"obj: "+str$(ob)
   text 10,40,"camx: "+str$(camera position x(0))
   text 10,55,"camz: "+str$(camera position z(0))
   sync
loop

rem this is Lucifer 1101 code
SetupStarSphere:
   cls rgb(5,5,5)
   fgcolor=RGB(255,255,255)
   bgcolor=RGB(255,255,255)
   ink fgcolor,bgcolor

   for n=1 to 500
      dtx=rnd(1000):dty=rnd(1000)
      dot dtx,dty
   next n

   get image 3,0,0,256,256,1
   make object sphere 1,1000000,6,6
   set object 1,1,1,0,0,0,0,0
   texture object 1,3
   scale object texture 1,10,10
   position object 1,0,0,0
   sync
return

Rem Project: Dark Basic Pro Project
Rem Created: Thursday, December 09, 2010

Rem ***** Main Source File *****
Rem Bill Robinson
Rem 12-9-10
Rem LED Cube simulation
Rem still a WIP, not too practical though too many 3D objects

set display mode desktop width(),desktop height(),32,1
sync on
sync rate 0
sync
autocam off
color backdrop 0 
set text opaque
set ambient light 10
hide mouse

set text font "ARIEL"
set text size 8
t1$="HELLO"
t2$="WORLD"

w1=text width(t1$)
w2=text width(t2$)
h1=text height(t1$)
h2=text height(t2$)
h=h1+h2
if w1>w2 then w=w1 else w=w2

global numrows=h
global numcols=w
global numslices=15

`set up 3-dimensional arrays to simulate LEDs cube
`used to be a larger cube, too many objects though
dim led(numslices,numrows,numcols)
dim ledobj(numslices,numrows,numcols)
dim ledx(numslices,numrows,numcols)
dim ledy(numslices,numrows,numcols)
dim ledz(numslices,numrows,numcols)
dim ledcolor#(numslices,numrows,numcols)

dim templed(numslices,numrows,numcols)
dim templedcolor#(numslices,numrows,numcols)

global spacing=8
global cubesize=2
global slice
global objptr=0
global LEDofflevel=50


`print text to screen and scan pixels
cls
set cursor 1,0
print t1$
set cursor 2,h1
print t2$
lock pixels
for row=0 to h
   for col=0 to w
`      pixels(col,row)=RGBG(POINT(col,row))
      v=RGBG(POINT(col,row))
      if v>0
         led(5,numrows-row,col)=1            :`save a pixel bitmap of the text in the array
      endif
   next col
next row
unlock pixels
set text size 14

`setup cube objects in box formation
xcols=0
yrows=0
zslices=0
global ledcolor#
ledcolor#=rgb(255,255,255)

position camera 300,300,-200
point camera 200,50,200

for i=1 to numslices          :`z component
   set cursor 0,0
   print "Building Cube Slices...(";i;" of ";numslices;")"
   sync

   for j=1 to numrows         :`y component
      for k=1 to numcols      :`x component
         inc objptr
         if objptr=1
            make object cube objptr,cubesize
         else
            clone object objptr,1
         endif
         position object objptr,xcols,yrows,zslices
         color object objptr,rgb(0,0,LEDofflevel)
         ghost object on objptr
         ledobj(i,j,k)=objptr
         ledx(i,j,k)=xcols
         ledy(i,j,k)=yrows
         ledz(i,j,k)=zslices
         ledcolor#(i,j,k)=ledcolor#
         inc xcols,spacing
      next k
      inc yrows,spacing
      xcols=0
   next j
   inc zslices,spacing
   yrows=0
next i



position camera 300,300,-200
point camera 200,50,200
`turn LEDs on with text pattern stored in array
_light_active_LEDs()
sync

countdown=numrows+1
animtype=1
maxanims=2
slice=5
sync rate 30
t1=timer()

do
   t2=timer()-t1
   if t2>50      
      `alternate between the 2 animation types - Up or BACK movement
      select animtype
         case 1
            _move_active_LEDs_UP(slice)
            dec countdown       
            if countdown<=0
               countdown=5+rnd(numslices)
               inc animtype
            endif 
         endcase
      
         case 2
            _move_active_LEDs_BACK() 
            dec countdown       
            if countdown<=0
               countdown=numrows
               inc animtype
            endif                  
            inc slice
            if slice>numslices then slice=1
         endcase
      endselect
      
      if animtype>maxanims then animtype=1
      
      _light_active_LEDs()
      t1=timer()
   endif

   set cursor 0,0
   print "fps=";screen fps()
   print "#objects=";objptr
   sync
loop
end

`turn LEDs on with text pattern stored in array
function _light_active_LEDs()
for i=1 to numslices
   for j=1 to numrows
      for k=1 to numcols
         if led(i,j,k)=1
            color object ledobj(i,j,k),ledcolor#
         else
            color object ledobj(i,j,k),rgb(0,0,LEDofflevel)
         endif
      next k
   next j
next i
endfunction

`scroll LEDs up in a given Z-slice of the cube
function _move_active_LEDs_UP(slice)
`save the top row pattern to a temp array
for t=1 to numcols
   templed(slice,numrows,t)=led(slice,numrows,t)
   templedcolor#(slice,numrows,t)=ledcolor#(slice,numrows,t)
next t
`shift the row patterns up a row
for i=numrows to 2 step -1
   for j=numcols to 1 step -1
      for k=slice to slice
         led(k,i,j)=led(k,i-1,j)
         ledcolor#(k,i,j)=ledcolor#(k,i-1,j)
      next k
   next j
next i
`restore the top row pattern to the bottom row of the slice in the cube
for t=1 to numcols
   led(slice,1,t)=templed(slice,numrows,t)
   ledcolor#(slice,1,t)=templedcolor#(slice,numrows,t)
next t
endfunction

`shift all the slices back one slice in Z direction
function _move_active_LEDs_BACK()
`save the back slice to a temp array
for i=1 to numrows
   for j=1 to numcols
      templed(numslices,i,j)=led(numslices,i,j)
      templedcolor#(numslices,i,j)=ledcolor#(numslices,i,j)
   next j
next i
`move all the patterns back to the next slice behind itself
for i=numslices to 1 step -1
   for j=1 to numrows
      for k=1 to numcols
         led(i,j,k)=led(i-1,j,k)
         ledcolor#(i,j,k)=ledcolor#(i-1,j,k)
      next k
   next j
next i
`restore the back pattern to the front slice
for i=1 to numrows
   for j=1 to numcols
      led(1,i,j)=templed(numslices,i,j)
      ledcolor#(1,i,j)=templedcolor#(numslices,i,j)
   next j
next i
endfunction

sync on
sync rate 66

set image colorkey 255,0,255
hide mouse
set text font "Comic Sans MS"
set text to bold
FONTSIZE=32
set text size FONTSIZE

create bitmap 1,2,2
set current bitmap 1
get image 1,0,0,2,2
set current bitmap 0
delete bitmap 1
sprite 1,screen width(),screen height(),1
 size sprite 1,screen width(),screen height()
 set sprite 1,0,1
 set sprite alpha 1,25
do
 center text screen width()/2,0,"Try your scroll wheel :)"
 ink rgb(RVAL,GVAL,BVAL),rgb(0,0,0)
 RVAL=RVAL+1 : GVAL=GVAL+2 : BVAL=BVAL+3
 if RVAL>255 then RVAL=25
 if GVAL>255 then GVAL=25
 if BVAL>255 then BVAL=25
 center text mousex(),mousey()-(FONTSIZE/2),"Hello world"
 MZ=-mousemovez()
 if MZ
  FONTSIZE=FONTSIZE+(MZ/120)
  if FONTSIZE<8 then FONTSIZE=8
  set text size FONTSIZE
 endif
 paste sprite 1,0,0
 sync
loop

sync on
sync rate 0

set image colorkey 255,0,255
hide mouse
set text font "Comic Sans MS"
set text to bold
FONTSIZE=32
set text size FONTSIZE

create bitmap 1,2,2
set current bitmap 1
get image 1,0,0,2,2
set current bitmap 0
delete bitmap 1
sprite 1,screen width(),screen height(),1
 size sprite 1,screen width(),screen height()
 set sprite 1,0,1
 set sprite alpha 1,25
make object cube 1,1
set camera to image 0,2,screen width(),screen height()
color backdrop 0
do
 set sprite image 1,2
 paste sprite 1,0,0
 turn object right 1,1
 roll object right 1,1
 center text screen width()/2,0,"Try your scroll wheel :)"
 ink rgb(RVAL,GVAL,BVAL),rgb(0,0,0)
 RVAL=RVAL+1 : GVAL=GVAL+2 : BVAL=BVAL+3
 if RVAL>255 then RVAL=25
 if GVAL>255 then GVAL=25
 if BVAL>255 then BVAL=25
 center text mousex(),mousey()-(FONTSIZE/2),"Hello world"
 MZ=-mousemovez()
 if MZ
  FONTSIZE=FONTSIZE+(MZ/120)
  if FONTSIZE<8 then FONTSIZE=8
  set text size FONTSIZE
 endif
 set sprite image 1,1
 paste sprite 1,0,0
 sync
loop

` Hello world
sync on : sync rate 0 : hide mouse
set text font "arial" : set text size 30 : set text transparent
set image colorkey 255,0,255

hw$="Hello world!            "
h=text height(hw$):w=text width(hw$)
cls rgb(255,0,255)
ink rgb(255,255,0),rgb(255,0,255)
print hw$
get image 1,1,1,w,h

ink rgb(155,155,255),0
box 0,0,64,64
for d = 1 to 512
    ink rgb(255,255,255),0
    dot rnd(64),rnd(64)
next d
get image 2,0,0,64,64

make object cylinder 1,200
scale object 1,100,10,100
texture object 1,1
set object 1,1,1,0

make object sphere 2,180,36,36
texture object 2,2

color backdrop 0,rgb(0,0,0)
point camera 0,0,0,0

do
   o1y=wrapvalue(object angle y(1)+1)
   yrotate object 1,o1y
   yrotate object 2,-o1y
   wait 10
   sync
loop

Rem Project: Fancy Hello World
Rem Code Author: Laurie Hedge
Rem Created: Sunday, December 12, 2010

type CharType
    sLetter as string
    nX as integer
    nY as integer
    dColour as dword
    nCircleX as integer
    nCircleY as integer
    dCircleColour as dword
endtype

#constant CHARNUM 0 : #constant BEENUSED 1
global dim nNumbersTable(94,1)
global dim tLettersTable(10,94) as CharType
global dim sFinished(10) as string
global nLastUpdate as integer
nLastUpdate = 0

set window off
set text font "Courier New"
set text size screen height() / 13.5

do
    cls
    ink rgb(255,255,255),0
    center text screen width() / 2,(screen height() / 4) * 3,"Loading..."
    
    for c = 32 to 126
        nNumbersTable(c-32,CHARNUM) = c
    next c
    for c = 0 to 10
        SetNotUsed()
        for d = 0 to 94
            repeat
                nChar = Random(32,126)
            until nNumbersTable(nChar-32,BEENUSED) = 0
            nNumbersTable(nChar-32,BEENUSED) = 1
            tLettersTable(c,d).sLetter = chr$(nChar)
            tLettersTable(c,d).nX = (screen width() / 13) * (c + 1)
            tLettersTable(c,d).nY = screen height()-((text height("|") * 1.5) * (d + 1))
            tLettersTable(c,d).nCircleY = tLettersTable(c,d).nY + (text height("|") / 2)
            tLettersTable(c,d).nCircleX = tLettersTable(c,d).nX + (text width("|") / 2)
            nRed = rnd(255)
            nGreen = rnd(255)
            nBlue = rnd(255)
            tLettersTable(c,d).dColour = rgb(nRed,nGreen,nBlue)
            if nRed > 127 then nRed = nRed - Random(40,127) else nRed = nRed + Random(40,127)
            if nGreen > 127 then nGreen = nGreen - Random(40,127) else nGreen = nGreen + Random(40,127)
            if nBlue > 127 then nBlue = nBlue - Random(40,127) else nBlue = nBlue + Random(40,127)
            tLettersTable(c,d).dCircleColour = rgb(nRed,nGreen,nBlue)
        next d
        sFinished(c) = mid$("Hello World",c+1)
    next c
    
    ` Main loop
    repeat
        WaitTime(100)
        StartWait()
        
        ` Move letters
        for c = 0 to 10
            if CheckIfDoneHere(c) = 0
                tTemp as CharType
                tTemp.sLetter = tLettersTable(c,0).sLetter
                tTemp.dColour = tLettersTable(c,0).dColour
                tTemp.dCircleColour = tLettersTable(c,0).dCircleColour
                for d = 0 to 93
                    tLettersTable(c,d).sLetter = tLettersTable(c,d+1).sLetter
                    tLettersTable(c,d).dColour = tLettersTable(c,d+1).dColour
                    tLettersTable(c,d).dCircleColour = tLettersTable(c,d+1).dCircleColour
                next d
                tLettersTable(c,94).sLetter = tTemp.sLetter
                tLettersTable(c,94).dColour = tTemp.dColour
                tLettersTable(c,94).dCircleColour = tTemp.dCircleColour
            endif
        next c
        
        ` Draw screen
        cls
        for c = 0 to 10
            for d = 0 to 8
                ink tLettersTable(c,d).dCircleColour,0
                circle tLettersTable(c,d).nCircleX,tLettersTable(c,d).nCircleY,(text height("|") * 1) / 2
                ink tLettersTable(c,d).dColour,0
                text tLettersTable(c,d).nX,tLettersTable(c,d).nY,tLettersTable(c,d).sLetter
            next
        next c
    until CheckIfDone()
    
    wait 1000
    ink rgb(255,255,255),0
    center text screen width() / 2,(screen height() / 4) * 3,"Press any key to run again."
    wait key
loop
end

function CheckIfDone()
    bOutput as boolean
    bOutput = 1
    for c = 0 to 10
        if tLettersTable(c,4).sLetter <> sFinished(c)
            bOutput = 0
            c = 11
        endif
    next c
endfunction bOutput

function CheckIfDoneHere(nColumn)
    bOutput as boolean
    bOutput = 1
    if tLettersTable(nColumn,4).sLetter <> sFinished(nColumn)
        bOutput = 0
    endif
endfunction bOutput

function SetNotUsed()
    for c = 0 to 94
        nNumbersTable(c,BEENUSED) = 0
    next c
endfunction

function Random(nMin,nMax)
    nOutput = rnd(nMax - nMin) + nMin
endfunction nOutput

function StartWait()
    nLastUpdate = timer()
endfunction

function WaitTime(nTime)
    do
        if timer() - nTime > nLastUpdate
            exit
        endif
    loop
endfunction

set text font "Arial"
size=0
do
while size<50
inc size,1
set text size size
print "Hello world!"
endwhile
size=1
ink rgb(rnd(255),rnd(255),rnd(255)), rgb(rnd(255),rnd(255),rnd(255))
loop

Rem Project: Fancy Hello World
Rem Code Author: Laurie Hedge
Rem Created: Sunday, December 12, 2010

type CharType
    sLetter as string
    nX as integer
    nY as integer
    dColour as dword
    nBoxX1 as integer
    nBoxY1 as integer
    nBoxX2 as integer
    nBoxY2 as integer
    dCircleColour as dword
endtype

#constant CHARNUM 0 : #constant BEENUSED 1
global dim nNumbersTable(94,1)
global dim tLettersTable(10,94) as CharType
global dim sFinished(10) as string
global nLastUpdate as integer
nLastUpdate = 0

set window off
hide mouse
set text font "Courier New"
set text size screen height() / 13.5

do
    cls
    ink rgb(255,255,255),0
    center text screen width() / 2,(screen height() / 4) * 3,"Loading..."
    
    for c = 32 to 126
        nNumbersTable(c-32,CHARNUM) = c
    next c
    for c = 0 to 10
        SetNotUsed()
        for d = 0 to 94
            repeat
                nChar = Random(32,126)
            until nNumbersTable(nChar-32,BEENUSED) = 0
            nNumbersTable(nChar-32,BEENUSED) = 1
            tLettersTable(c,d).sLetter = chr$(nChar)
            tLettersTable(c,d).nX = (screen width() / 13) * (c + 1)
            tLettersTable(c,d).nY = screen height()-((text height("|") * 1.5) * (d + 1))
            tLettersTable(c,d).nBoxY1 = tLettersTable(c,d).nY - ((text height("|") - text height(tLettersTable(c,d).sLetter)) / 2)
            tLettersTable(c,d).nBoxX1 = tLettersTable(c,d).nX - ((text height("|") - text width(tLettersTable(c,d).sLetter)) / 2)
            tLettersTable(c,d).nBoxY2 = tLettersTable(c,d).nY + ((text height("|") - text height(tLettersTable(c,d).sLetter)) / 2) + text height(tLettersTable(c,d).sLetter)
            tLettersTable(c,d).nBoxX2 = tLettersTable(c,d).nX + ((text height("|") - text width(tLettersTable(c,d).sLetter)) / 2) + text width(tLettersTable(c,d).sLetter)
            nRed = rnd(255)
            nGreen = rnd(255)
            nBlue = rnd(255)
            tLettersTable(c,d).dColour = rgb(nRed,nGreen,nBlue)
            if nRed > 127 then nRed = nRed - Random(40,127) else nRed = nRed + Random(40,127)
            if nGreen > 127 then nGreen = nGreen - Random(40,127) else nGreen = nGreen + Random(40,127)
            if nBlue > 127 then nBlue = nBlue - Random(40,127) else nBlue = nBlue + Random(40,127)
            tLettersTable(c,d).dCircleColour = rgb(nRed,nGreen,nBlue)
        next d
        sFinished(c) = mid$("Hello World",c+1)
    next c
    nHighlightY1 = tLettersTable(0,4).nBoxY1 - ((tLettersTable(0,4).nBoxY1 - tLettersTable(0,5).nBoxY2) / 2)
    nHighlightY2 = tLettersTable(0,4).nBoxY2 + ((tLettersTable(0,3).nBoxY1 - tLettersTable(0,4).nBoxY2) / 2)
    
    ` Main loop
    repeat
        WaitTime(100)
        StartWait()
        
        ` Move letters
        for c = 0 to 10
            if CheckIfDoneHere(c) = 0
                tTemp as CharType
                tTemp.sLetter = tLettersTable(c,0).sLetter
                tTemp.dColour = tLettersTable(c,0).dColour
                tTemp.dCircleColour = tLettersTable(c,0).dCircleColour
                for d = 0 to 93
                    tLettersTable(c,d).sLetter = tLettersTable(c,d+1).sLetter
                    tLettersTable(c,d).dColour = tLettersTable(c,d+1).dColour
                    tLettersTable(c,d).dCircleColour = tLettersTable(c,d+1).dCircleColour
                next d
                tLettersTable(c,94).sLetter = tTemp.sLetter
                tLettersTable(c,94).dColour = tTemp.dColour
                tLettersTable(c,94).dCircleColour = tTemp.dCircleColour
            endif
        next c
        
        ` Draw screen
        cls
        ink rgb(250,240,70),0
        box 0,nHighlightY1,screen width(),nHighlightY2
        for c = 0 to 10
            for d = 0 to 8
                ink tLettersTable(c,d).dCircleColour,0
                box tLettersTable(c,d).nBoxX1,tLettersTable(c,d).nBoxY1,tLettersTable(c,d).nBoxX2,tLettersTable(c,d).nBoxY2
                ink tLettersTable(c,d).dColour,0
                text tLettersTable(c,d).nX,tLettersTable(c,d).nY,tLettersTable(c,d).sLetter
            next
        next c
    until CheckIfDone()
    
    wait 1000
    ink rgb(255,255,255),0
    center text screen width() / 2,(screen height() / 4) * 3,"Press any key to run again."
    wait key
loop
end

function CheckIfDone()
    bOutput as boolean
    bOutput = 1
    for c = 0 to 10
        if tLettersTable(c,4).sLetter <> sFinished(c)
            bOutput = 0
            c = 11
        endif
    next c
endfunction bOutput

function CheckIfDoneHere(nColumn)
    bOutput as boolean
    bOutput = 1
    if tLettersTable(nColumn,4).sLetter <> sFinished(nColumn)
        bOutput = 0
    endif
endfunction bOutput

function SetNotUsed()
    for c = 0 to 94
        nNumbersTable(c,BEENUSED) = 0
    next c
endfunction

function Random(nMin,nMax)
    nOutput = rnd(nMax - nMin) + nMin
endfunction nOutput

function StartWait()
    nLastUpdate = timer()
endfunction

function WaitTime(nTime)
    do
        if timer() - nTime > nLastUpdate
            exit
        endif
    loop
endfunction

Rem Project: HelloWordContest
Rem Created: Friday, December 10, 2010

Rem ***** Main Source File *****
randomize timer()
Set display mode 800,600,32
set window position 0,0
sync on
sync rate 60

Type Mortar
   Global ID
   Global X
   Global Y
   Global Kind$
Endtype

Type Trail
   Global ID
   Global kind$
   Global State$
   Global TrailColor as Dword
   Global StarColor as Dword
   Global amount
   Global Radius as float
   Global Life
   Global Letter$
   
   Global LDelay
   Global EDelay
   
   Global X
   Global Y
   Global XV
   Global YV
   
   Global VDamping
Endtype

Type Particle
   Global ID
   Global PVDamping
   Global Color as Dword
   Global MaxLife
   Global Life
   Global Set
   
   Global X
   Global Y
   
   Global XV as float
   Global YV as float
   
   Global XDest
   Global YDest
endtype

Global MaxMortars=50
Dim Mrtr(MaxMortars) as Mortar

Global MaxTrails=250
Dim Trl(MaxTrails) as Trail

Global MaxParticles=10000
Dim Frwrk(MaxParticles) as Particle

Set text size 24

MakeMortar(1,150,600,"")
MakeMortar(2,300,600,"")
MakeMortar(3,450,600,"")
MakeMortar(4,600,600,"")
MakeMortar(5,400,600,"")

For x=1 to 100
   Color=rgb(rnd(155)+100,rnd(155)+100,rnd(155)+100)
   Color2=rgb(rnd(155)+100,rnd(155)+100,rnd(155)+100)
   AddFireworkToMortar(x,rnd(3)+1,"",Color,Color2,120,rnd(50)+50,rnd(170),100,30,2-rnd(4),rnd(3)+10)
Next X

SpellMessageInFireworks(101,5,"Hello",200,225,100,14)
SpellMessageInFireworks(110,5,"World",210,235,100,12)

do
   cls
   UpdateFireworks()
   text 0,0,str$(Screen FPS())
   sync
LOOP

Function SpellMessageInFireworks(IdStart,MortarID,Msg$,TimeFrmStrt,TimeFrmEnd,life,yvel)
   ID=IdStart
   Time=TimeFrmStrt
   TimeInc=(TimeFrmEnd-TimeFrmStrt)/Len(Msg$)
   For i=1 to Len(Msg$)
      Color=rgb(rnd(155)+100,rnd(155)+100,rnd(155)+100)
      Color2=rgb(rnd(155)+100,rnd(155)+100,rnd(155)+100)
      AddFireworkToMortar(ID,MortarID,Mid$(Msg$,i),Color,Color2,120,1,Time,100,life,((0-Len(Msg$)/2)+(i-1)),yvel)
      inc Time,TimeInc
      inc ID
   NEXT i
Endfunction


Function MakeMortar(MortarID,x,y,kind$)
  id=SearchMortar(0) 
  Mrtr(ID).id=MortarID
  Mrtr(ID).x=x
  Mrtr(ID).y=y
  Mrtr(ID).kind$=kind$
Endfunction

Function AddFireworkToMortar(TrailID,MortarID,Letter$,TrailColor,StarColor,amount,radius,LaunchDelay,ExplodeDelay,Life,xvel,yvel)
   ID=SearchTrail(0)
   Trl(ID).id=TrailID
   MId=SearchMortar(MortarID)
   
   Trl(ID).Letter$=Letter$
   Trl(ID).kind$=kind$
   Trl(ID).LDelay=LaunchDelay
   Trl(ID).EDelay=ExplodeDelay
   Trl(ID).TrailColor=TrailColor
   Trl(ID).StarColor=StarColor
   Trl(ID).amount=amount
   Trl(ID).radius=radius
   Trl(ID).life=life
      
   Trl(ID).x=Mrtr(MId).x
   Trl(ID).y=Mrtr(MId).y
   Trl(ID).xv=XVel
   Trl(ID).yv=YVel
ENDFUNCTION


Function UpdateFireworks()
   UpdateTrails()
   UpdateParticles()   
ENDFUNCTION


Function UpdateTrails()
   For ID=1 to MaxTrails
      If Trl(Id).id<>0
         if Trl(ID).LDelay>0
            Dec Trl(ID).LDelay
         else
            ink Trl(ID).TrailColor,0
            
            if Timer()>Trl(ID).VDamping then dec Trl(ID).yv,1; Trl(ID).VDamping=Timer()+100
            
            if Trl(ID).EDelay>0 then Dec Trl(ID).EDelay else BlowupFirework(ID)
                 
            
            inc Trl(ID).x,Trl(ID).xv
            dec Trl(ID).y,Trl(ID).yv
            box Trl(ID).x,Trl(ID).y,Trl(ID).x+2,Trl(ID).y+5
            
            ink rgb(255,255,255),0
         endif
      endif
   NEXT ID   
ENDFUNCTION

Function UpdateParticles()
   For ID=1 to MaxParticles
      if Frwrk(ID).id<>0  
         inc Frwrk(ID).x,Frwrk(ID).xv
         inc Frwrk(ID).y,Frwrk(ID).yv
            
          if Timer()>Frwrk(ID).PVDamping 
               Frwrk(ID).xv=Frwrk(ID).xv/1.3
               Frwrk(ID).yv=Frwrk(ID).yv/1.3
               Frwrk(ID).PVDamping=Timer()+80
         endif
         
         ColPerc#=((Frwrk(ID).Life*1.8)/(Frwrk(ID).MaxLife))
         if ColPerc#>1.0 then ColPerc#=1.0
         if Frwrk(ID).life>0
            dec Frwrk(ID).life
            Frwrk(ID).color=rgb((rgbr(Frwrk(ID).color)*ColPerc#),(rgbg(Frwrk(ID).color)*ColPerc#),(rgbb(Frwrk(ID).color)*ColPerc#))
         else
            Frwrk(ID).ID=0
         endif
         
         ink Frwrk(ID).color,0
         dot Frwrk(ID).x,Frwrk(ID).y
         ink rgb(255,255,255),0
      endif
   Next ID
ENDFUNCTION


Function BlowupFirework(TrlID)
   FWID=1
   For ID=1 to Trl(TrlID).amount
      while Frwrk(FWID).Id<>0
         inc FWID
      ENDWHILE
      Frwrk(FWID).ID=SearchFrwrk(0)
      Frwrk(FWID).set=Trl(TrlID).id
      Frwrk(FWID).X=Trl(TrlID).x
      Frwrk(FWID).Y=Trl(TrlID).y
      Frwrk(FWID).MaxLife=TRl(TrlID).life
      Frwrk(FWID).Life=TRl(TrlID).life
      Frwrk(FWID).Color=Trl(TrlID).StarColor
      inc FWID
   NEXT ID
   
   FWID=1
   if Trl(TrlID).Letter$=""
      Ang#=1
      For ID=1 to Trl(TrlID).Amount
         while Frwrk(FWID).set<>Trl(TrlID).id
            inc FWID
         ENDWHILE
   
         inc Ang#,(360.0/TRl(TrlID).Amount)
         Frwrk(FWID).XDest=((Cos(Ang#)) * Trl(TrlID).radius)+Frwrk(FWID).X
         Frwrk(FWID).YDest=((Sin(Ang#)) * Trl(TrlID).radius)+Frwrk(FWID).Y
         ink rgb(255,255,255),0
                  
         Frwrk(FWID).XV=(Frwrk(FWID).XDest-Frwrk(FWID).X)/10
         Frwrk(FWID).YV=(Frwrk(FWID).YDest-Frwrk(FWID).Y)/10      
         inc FWID
      NEXT ID  
   else
   
      FWID=1
      cls
      ink rgb(255,255,255),0
      Text 0,0,Trl(TrlID).Letter$
      Get Image 1,0,0,Text width(Trl(TrlID).Letter$),Text height(Trl(TrlID).Letter$)
      cls
      Make Memblock From Image 1,1
      x=0
      y=0
      For Loops=1 to Trl(TrlID).amount
         if x>Text width(Trl(TrlID).Letter$) then x=0;inc y
         pos=(3+x+(y*Text width(Trl(TrlID).Letter$)))*4
         
         while Frwrk(FWID).set<>Trl(TrlID).id
            inc FWID
         ENDWHILE
         
         if pos>0 and pos<get memblock size(1) and Total<Trl(TrlID).Amount
            If Memblock Byte(1,pos)>100 and Memblock Byte(1,pos+1)>100 and Memblock Byte(1,pos+2)>100
               Frwrk(FWID).XDest=Frwrk(FWID).X-(Text width(Trl(TrlID).Letter$)/2)*Trl(TrlID).radius+x*Trl(TrlID).radius
               Frwrk(FWID).YDest=Frwrk(FWID).Y-(Text height(Trl(TrlID).Letter$)/2)*Trl(TrlID).radius+y*Trl(TrlID).radius
               
               Frwrk(FWID).XV=(Frwrk(FWID).XDest-Frwrk(FWID).X)`/10
               Frwrk(FWID).YV=(Frwrk(FWID).YDest-Frwrk(FWID).Y)`/10   
               
               inc FWID
               inc total
               
               `dot Frwrk(FWID).XDest,Frwrk(FWID).yDest
               `dot x,y  
               `cls
               `text 0,40,str$(loops)+" / "+str$(Trl(TrlID).amount)
               `sync
               `wait key
            endif
         endif
         inc x
         
         if y>Image Height(1) then Goto ExitBF 
      NEXT loops
      Goto ExitBF:
      ExitBF:
      
      delete image 1
      delete memblock 1
      `text 0,50,str$(x)+", "+str$(y)
      `sync
      `wait key
   endif
   Trl(TrlID).id=0
ENDFUNCTION


Function SearchMortar(MortarID)
   ID=1
   while Mrtr(ID).id<>MortarID
      inc ID
   endwhile   
ENDFUNCTION ID

Function SearchTrail(TrailID)
   ID=1
   while Trl(ID).id<>TrailID
      inc ID
   endwhile 
ENDFUNCTION ID

Function SearchFrWrk(FrWkID)
   ID=1
   while FrWrk(ID).id<>FrWkID
      inc ID
   endwhile 
ENDFUNCTION ID

set text size 50
set text font "Comic Sans MS"
print "Hello world!"
get image 1,0,0,200,200
sprite 1,0,0,1
cls rgb(0,0,0)
alpha=0
do
cls rgb(0,0,0)
ink rgb(rnd(255),rnd(255),rnd(255)),rgb(rnd(255),rnd(255),rnd(255))
print "Hello world!"
get image 1,0,0,200,200
sprite 1,rnd((screen width()-200)),rnd((screen height()-200)),1
for alpha=0 to 255 step 5
set sprite alpha 1,alpha
wait 1
next alpha
for alpha=255 to 0 step -5
set sprite alpha 1,alpha
wait 1
next alpha
loop