Sorry your browser is not supported!

remstart
By AurumKnight
Started: July/05/2009

remend

`Window title:
#CONSTANT wTitle "RPG Text"

//////////////////////

//////////////////////
/////Globals:



`Leave alone {
global user32_
global dbpw as dword
global ffont
global SW `screen width
global SH `screen height
global SD `screen depth
global SWD2 as float `screen width divided by 2
global SHD2 as float `screen height divided by 2
global AppPath as string
global entchar as string

global fdll
global fimage
global fsprite
global fmemblock
//  }

//////////////////////
//Input {
global mmx as float
global mmy as float
global mmz as float
global mx as float
global my as float
global mz as float
global mc
global pmc
//  }
///////////////////////

/////////////////////
//Scrollie  {
global scrollx as float
global scrolly as float
global zoom as float

////////////////
//// these two are in pixels, not units.
//// If you put sxd2 and syd2, and set scrollx and y to 0,
//// then the point 0 will be in the middle of the screen
global scrollcox as float `center offset
global scrollcoy as float `center offset y
//  }
/////////////////////
/////////////////////
//2D {

remstart
For dots use:
pdraw = ppix+x*4+y*pixpitch
*pdraw = colord
remend
global ppix as dword
global pdraw as dword
global pixpitch as dword
global lvect2d
//  }

type Key_T
    keycode          ` Keyboard code(for 'keystate')
    char as string   ` Regular Character
    state            ` 0 off, 1 down, 2 just released, 3 just hit
    down             ` (boolean)
    pdown            ` last loop

    time             ` when the key was pressed
endtype
type Entity
    x as float
    y as float
    r                ` radius
    c as dword       ` color
    ent              ` entity talking to
    tstr as string   ` talking string
    delete
endtype

dim Keys(-1) as Key_T
dim Ents(-1) as Entity

global g_tpl as float= .04       `time per letter (ms)
global g_pause as float = .2   `pause at commas/periods
global g_lt as float           `letter time
global g_cl
global g_ls=1                   `start
global g_cwt                    `current wait type.  0 for regular letter, 1 for comma/period
global g_str as string 
global g_wait
global g_skip
global g_textx = 10
global g_texty = 10

gosub Init




do
    if timer()-time >10
        cls 0
        timep = (timer()-time)*.001
        time=timer()
        DoInput()
        `KeyBoardInput()
        text SW-200,0,"FPS : "+str$(screen fps())
        
        
        ControlEntWithArrowKeys(0)
        ControlEntTalk(0)
        DrawEnts()
        if Ents(0).ent > -1
            DrawText(Ents(Ents(0).ent).tstr)
            TextCalc(Ents(Ents(0).ent).tstr,0)
        endif
        
`        text 0,0,left$(g_str,g_cl)
`        text 0,20,str$(g_cl)
`        lock pixels
`        DrawDotParticles(1)
`        gosub DrawMouse
`        unlock pixels

        sync
    endif
loop
Init:
    StartS()
    calcsinandcos()
    bmpstart()
    scrollinit()
    scrollcox = SWD2
    scrollcoy = SHD2


    `drawstring("")
    `wait key
    MakeEnt(0,0,12,0xFFFF0000)
    makeEnt(-40,50,12, 0xFF0000FF)
    makeEnt(-30,-50,12, 0xFF00FFFF)
    makeEnt(55,-80,12, 0xFFF080FF)
    readcharacterstrings()


    global time : time = timer()
    global timep as double float
    DoInput()



return

function DrawText(dstr as string)
    l = len(dstr)
    th = text height("ABCDEFG")
    ink 0xFFFFFFFF,0
    for i = g_ls to g_cl
        s$ = mid$(dstr,i)
        if s$ = "|"
            s2$ = mid$(dstr,i+1)
            if s2$ = "n"
                `twd2 = text width(dt$)/2
                text g_textx,y+g_texty,dt$
                inc y,th
                dt$ = ""
                inc i
            endif
            if s2$ = "e"
                `twd2 = text width(dt$)/2
                text g_textx,y+g_texty,dt$
                y=0
                `g_ls = i+2
                dt$ = ""
                g_wait = 1
                exit
            endif
        else
            dt$ = dt$ + s$
        endif
        
    next i
    if i > g_cl
        `twd2 = text width(dt$)/2
        text g_textx,y+g_texty,dt$
    endif
    if g_wait = 1
        inc y,th*2
        ink 0xFF888888,0
        text g_textx,g_texty+y,"Click to continue..."
    endif
endfunction
function ReadCharacterStrings()
    restore StringData
    ac = array count(Ents())
    do
        read s$
        if s$ = "|c"
            inc i
            if i > ac then exit
        else
            Ents(i).tstr = Ents(i).tstr + s$
        endif
        if s$ = "" then exit
    loop
endfunction


`This function calculates timing of letters
function TextCalc(dstr as string,Ent)
    wt# = g_tpl
    if g_cwt = 1 then wt# = g_pause
    l = len(dstr)
    if g_wait = 0
        if g_cl <= l
            inc g_lt, timep `increment letter timer
            if g_lt > wt# or g_skip = 1
                `if the time for the letter has passed, go to the next letter
                `and reset the letter timer
                inc g_cl
                g_lt=0

                `check for punctuation to set the letter timing
                c = asc(mid$(dstr,g_cl))
                if c=44 or c=46 or c=58 or c=59 or c=63
                    g_cwt = 1
                else
                    g_cwt = 0
                endif
            endif
        else
            Ents(ent).ent = -1
        endif
    endif
endfunction


function MakeEnt(x as float,y as float,r as float,c as dword)
    ac = array count(Ents())
    ind = ac+1
    if ac > -1
        for i = 0 to ac
            if Ents(i).delete = 1 then exit
        next i
        ind = i
    endif
    
    if i > ac
        array insert at bottom Ents()
    endif
    Ents(ind).x = x
    Ents(ind).y = y
    Ents(ind).r = r
    Ents(ind).c = c
    Ents(ind).ent = -1
    Ents(ind).delete = 0
endfunction ind
function DrawEnts()
    ac = array count(Ents())
    if ac = -1 then exitfunction
    for i = 0 to ac
        if Ents(i).delete = 0
            ink Ents(i).c, 0
            circle (Ents(i).x-scrollx)/zoom+scrollcox,(Ents(i).y-scrolly)/zoom+scrollcoy,Ents(i).r
        endif
    next i
endfunction
function ControlEntWithArrowkeys(Ent)
    if Ents(ent).ent = -1
        speed# = 75.0
        inc Ents(ent).x,(rightkey()-leftkey())*speed#*timep
        inc Ents(ent).y,(downkey()-upkey())*speed#*timep
        ac = array count(Ents())
        if ac = 0 then exitfunction
        for i = 0 to ac
            if i <> Ent
                d# = range2d(Ents(i).x,Ents(i).y,Ents(ent).x,Ents(ent).y)
                cp#=Ents(i).r+Ents(ent).r
                if d# < cp#
                    a# = getangle(Ents(i).x,Ents(i).y,Ents(ent).x,Ents(ent).y)
                    Ents(ent).x = Ents(i).x+sin_(int(wrapvalue(a#)))*cp#
                    Ents(ent).y = Ents(i).y-cos_(int(wrapvalue(a#)))*cp#
                endif
            endif
        next i
    endif
endfunction

`this controls user input
function ControlEntTalk(Ent)  `put in Player entity index
    if Ents(ent).ent = -1
        ac = array count(Ents())
        if ac = -1 then exitfunction
        tr# = 18.0 `how close you have to be to talk
        ptent=-1

        for i = 0 to ac
            if i <> Ent
                d# = range2d(Ents(i).x,Ents(i).y,Ents(ent).x,Ents(ent).y)
                cp#=Ents(i).r+Ents(ent).r
                if d#-cp# <= tr#
                    if d#-cp# < er# or ptEnt=-1
                        er# = d#-cp#
                        ptEnt = i
                    endif
                endif
            endif
        next i
        if ptent > -1
            ink 0xFF888888,0
            text g_textx,g_texty,"Click to talk to this character."
        endif
    endif
    if mc > 0 and pmc = 0
        if Ents(ent).ent = -1
            
            Ents(ent).ent = ptEnt
            g_lt = 0
            g_wait = 0
            g_skip = 0
            g_cl = 1
            g_ls = 1
        else
            if g_wait = 0
                g_skip = 1
            else
                g_cl = g_cl+2
                g_ls = g_cl
                g_wait = 0
                g_skip = 0
            endif
        endif
    endif
    
endfunction



/////////////////////////////////////////////
//System functions {
function StartS()
    dim sin_(359) as float
    dim cos_(359) as float
    `All dll crap goes here:
    user32_= FreeDll()
    load dll "User32.dll",user32_

    `Set display and all:
    SetDispMode()
    sync on : sync : sync rate 0: hide mouse

    dbpw=call dll(user32_,"GetActiveWindow")
    n=call dll(user32_,"SetWindowTextA",dbpw,wTitle)

    entchar = chr$(13)
endfunction

function SetDispMode()
    perform checklist for display modes
    a = checklist quantity()
    m=0
    ind=0
    `check for highest resolution
    for i = 1 to a
        g = checklist value a(i)*checklist value b(i)*checklist value c(i)
        if g > m
            m = g
            ind = i
        endif
    next i
    SW = checklist value a(ind)
    SH = checklist value b(ind)
    SD = checklist value c(ind)
    SWD2 = SW / 2
    SHD2 = SH / 2
    set display mode SW,SH,SD
endfunction

function MessageBox(Caption$, Message$, flag as dword)
    RV = call dll(user32_,"MessageBoxA",dbpw,Message$,Caption$,flag)
    remstart

    FLAGS:
    question 32
    info 64
    critical 16
    exclamation 48
    yesno 4
    yesnocancel 3

    RESULTS:
    cancel 2
    no 7
    yes 6
    ok 1

    remend
endfunction RV
function FreeDll()
    inc fdll
endfunction fdll
function calcsinandcos()
    //  Remember when using these arrays to use int() and, when needed, to wrap the angle.
    for i = 0 to 359
        sin_(i)=sin(i)
        cos_(i)=cos(i)
    next i
endfunction

//  }
///////////////////////


///////////////////////
//Scrollie {
function scrollinit()
    zoom = 1.0
endfunction
function scrollwitharrowkeys(speed#)
    scrolly = scrolly +(downkey()-upkey()) * speed#*zoom
    scrollx = scrollx +(rightkey()-leftkey()) * speed#*zoom
endfunction
function zoomwithwheel(multiple#)
    if mmz > 0
        zoom = zoom * multiple#
    endif
    if mmz < 0
        zoom = zoom / multiple#
    endif
endfunction

function boxinscreen(x1 as float, y1 as float,x2 as float, y2 as float)
    // these are global, not screen relative
    sw as float
    if x1 > x2
        sw = x1
        x1=x2
        x2=sw
    endif
    if y1 > y2
        sw = y1
        y1=y2
        y2=sw
    endif
    RV = 1
    if ((x1-scrollx)/zoom+scrollcox > SW) or ((x2-scrollx)/zoom+scrollcox < 0) or ((y1-scrolly)/zoom+scrollcoy > SH) or ((y2-scrolly)/zoom+scrollcoy < 0) then RV = 0
endfunction RV

remstart

To calculate the screen position, use these
(replace 'globalxpos' and 'globalypos' with your variable):

    ( globalxpos -scrollx)/zoom+scrollcox
    ( globalypos -scrolly)/zoom+scrollcoy

To turn the local screen position into global coordinates,
use these (screenxpos and screenypos are screen
coordinates to be replaced with your variable):

    ( screenxpos -scrollcox)*zoom+scrollx
    ( screenypos -scrollcoy)*zoom+scrolly

remend

//  }
///////////////

function DoInput()
    mmx = mousemovex()
    mmy = mousemovey()
    mmz = mousemovez()
    mx = mousex()
    my = mousey()
    mz = mousez()
    pmc = mc
    mc = mouseclick()

endfunction
function KeyBoardInput()
    ac = array count(Keys())
    if ac < 0 then exitfunction
    for i = 0 to ac
        p = keystate(Keys(i).keycode)
        Keys(i).pdown = Keys(i).down
        Keys(i).down = p

        Keys(i).state = Keys(i).down
        if Keys(i).down <> Keys(i).pdown then Keys(i).state = Keys(i).state+2


        if Keys(i).state = 3
            Keys(i).time = time
            TXT$=TXT$+keys(i).char
        endif
        `if Keys(i).state = 1 and timer()-Keys(i).time >

    next i
endfunction
function bmpStart()
    lock pixels
    ppix = get pixels pointer()
    pixpitch = get pixels pitch()
    unlock pixels
    lvect2d=find free vector()
    n=make vector2(lvect2d)
endfunction

`Very fast pixel drawing routine.
`Using the code inside without the function is about 6 times faster,
`  but here it is just for the heck of it
function bmpDot(x,y,col as dword)
    pdraw = ppix+x*4+y*pixpitch
    *pdraw = col
endfunction

function AngDif(a1#,a2#)
    // Returns the actual difference in angles
    // from -180 up to 180
    // (It won't return -180)
    a2# = (a2#-a1#) mod 360
    if a2# > 180 then a2#=a2#-360
endfunction a2#
function GetAngle(x1#,y1#,x2#,y2#)
    //  Returns the angle from (x1#,y1#), to (x2#,y2#)
    //  It Inverts the y since in computer 2d, positive y goes down.
    //  if Params are GetAngle(0,0,1,1), it returns 135.0
    RV# = atanfull(x2#-x1#,y1#-y2#)
endfunction RV#

function range2D(x1#,y1#,x2#,y2#)
    set vector2 lvect2d,x1#-x2#,y1#-y2# : RV#=length vector2(lvect2d)
endfunction RV#







// Use |n for a new line, use |e for a new text section
// Use |c for the next character.  This command must be on it's own line.
// Remember to keep the order right!
// You can add more without adding the actual character, It's just left unread.
StringData:
data "|c"
data "Hey, my name is Bob!|eI'm the king of this area, no matter what anyone else tells you.|nI killed everyone who said I'm not, so watch out.|e"
data "This is the town square.|nAs you can see, there are a lot of shops around here.|e"
data "If you need any help, just talk to me.|e"
data "|c"
data "Hi I'm Mark.|eDon't worry about that guy Bob over there.|eHe likes to think he's someone, but he's the poorest guy here.|e"
data "I'm the actual King around here, don't let anyone tell you any different.|e"
data "|c"
data "What's up?|nMy name is John|eDon't listen to those two idiots over there.|n"
data "Neither of them are the king; They're just trying to get attention.|e"
data "|c"

function MakeEnt(x as float,y as float,r as float,c as dword)
    ac = array count(Ents())
    ind = ac+1
    if ac > -1
        for i = 0 to ac
            if Ents(i).delete = 1 then exit
        next i
        ind = i
    endif
    
    if i > ac
        array insert at bottom Ents()
    endif
    Ents(ind).x = x
    Ents(ind).y = y
    Ents(ind).r = r
    Ents(ind).c = c
    Ents(ind).ent = -1
    Ents(ind).delete = 0
endfunction ind

function makeEnt( x as float,y as float, r as float, c as float)
	array insert at bottom Ents()
	i = array count( Ents() )
	
	Ents(i).x = x
	Ents(i).y = y
	Ents(i).r = r
	Ents(i).c = c
endfunction i

Sync On
Sync Rate 60
Randomize Timer()

Type Rocket
     ObjNum as Integer
     BoxObj as Integer
     Particle as Integer
     Status as Integer // 1 = waiting, 2 is flying
     Delay as Integer
     FlyTime as Integer
EndType

// 1 Explosion
Type FireWork1
     X as Float
     Y As Float
     Z As Float
     LifeTime as Integer
     Delay as Integer
     Status as Integer
     PartNum as Integer
EndType

// 3 Upfollowing Explosions
Type FireWork2
     X As Float
     Y As Float
     Z As Float
     LifeTime as Integer
     Delay as Integer
     Status as Integer
     PartNum as Integer
     PartNum2 as Integer
     PartNum3 as Integer
EndType

// Smog
Type FireWork3
     X As Float
     Y As Float
     Z As Float
     LifeTime as Integer
     Delay as Integer
     Status as Integer
     PartNum as Integer
EndType

#Constant C_Red RGB(255, 0, 0)
#Constant C_Yellow RGB(255, 255, 0)
#Constant C_Blue RGB(0, 0, 255)
#Constant C_Green RGB(0, 255, 0)
#Constant C_Purple RGB(60, 0, 60)
#Constant C_Pink RGB(255, 94, 174)

Make Camera 1
Color Backdrop 1, 0
Position Camera 1, 0, 50, 100
Point Camera 1, 0, 50, 0

Ink RGB(0, 0, 255), 0
Box 0, 0, 20, 20

For X = 1 to 5
    Ink RGB(255, 0, 0), 0
    Circle 10, 10, X
Next X
Get Image 1, 0, 0, 20, 20

Cnt = 1
Stepz# = 140/15.0
For X = 0 to 8
    Make Object Cube Cnt, 10
    Texture Object Cnt, 1
    Position Object Cnt, -70+X*17.5, 0, 0
    Inc Cnt 
Next X

Make Object Cone 1000, 8
Make Object Box 1001, 3, 10, 3
`Scale Limb 1001, 0, 50, 100, 50

Make Mesh from Object 1, 1000
Add Limb 1001, 1, 1
Offset Limb 1001, 1, 0, 12, 0
Offset Limb 1001, 0, 0, 5, 0

Delete Mesh 1
Delete Object 1000

Ink RGB(255, 255, 0), 0
Box 0, 0, 5, 5
Ink RGB(255, 0, 0), 0
Circle 3, 0, 2
Get Image 2, 0, 0, 5, 5
Texture Limb 1001, 0, 2
Ink RGB(0, 0, 255), 0
Box 0, 0, 5, 5
Ink RGB(0, 255, 64), 0
Circle 3, 0, 2
Get Image 3, 0, 0, 5, 5
Texture Limb 1001, 1, 3
Set Object Light 1001, 0

Exclude Object On 1001

Box 0, 0, 5, 5, C_Red, C_Red, C_Yellow, C_Red
Box 5, 0, 10, 5, C_Yellow, C_Red, C_Red, C_Red
Box 0, 5, 5, 10, C_Red, C_Red, C_Red, C_Yellow
Box 5, 5, 10, 10, C_Red, C_Yellow, C_Red, C_Red
Get Image 4, 0, 0, 10, 10

Box 0, 0, 5, 5, C_Blue, C_Blue, C_Green, C_Blue
Box 5, 0, 10, 5, C_Green, C_Blue, C_Blue, C_Blue
Box 0, 5, 5, 10, C_Blue, C_Blue, C_Blue, C_Green
Box 5, 5, 10, 10, C_Blue, C_Green, C_Blue, C_Blue
Get Image 5, 0, 0, 10, 10

Box 0, 0, 5, 5, C_Purple, C_Purple, C_Pink, C_Purple
Box 5, 0, 10, 5, C_Pink, C_Purple, C_Purple, C_Purple
Box 0, 5, 5, 10, C_Purple, C_Purple, C_Purple, C_Pink
Box 5, 5, 10, 10, C_Purple, C_Pink, C_Purple, C_Purple
Get Image 6, 0, 0, 10, 10


Dim Rockets(8) as Rocket

Cnt = 10
For X = 0 To 8
    Instance Object Cnt, 1001 
    Position Object Cnt, -70+X*17.5, -5, 0
    
    Rockets(X).ObjNum = Cnt
    Rockets(X).BoxObj = Object Collision(Cnt, 0)
    Rockets(X).Status = 1
    
    Inc Cnt
Next X

Dim Fx1() As FireWork1
Dim Fx2() As FireWork2
Dim Fx3() As FireWork3

Make Object Plain 100, 200, 200
Box 0, 0, Screen Width(), Screen Height(), RGB(0, 128, 255), RGB(0, 64, 128), RGB(0, 128, 255), RGB(0, 64, 128)
Get Image 7, 0, 0, Screen Width(), Screen Height()
Texture Object 100, 7
Position Object 100, 0, 30, -22

Make Object Box 101, 200, 10, 100
Position Object 101, 0, -10, 0
Color Object 101, RGB(0, 128, 0)

Do
  If MouseClick() && 1 Then Fired = FireRocket()
  
  HandleRockets()
  
  HandleExplosions(1, 0)
  
  Sync
Loop

End

Function FireRocket()
         RocketObj = Pick Object(MouseX(), MouseY(), 1, 9)
         RetVal = 0
         If RocketObj > 0 AND RocketObj < 10
            For X = 0 To Array Count(Rockets())
                If Rockets(X).BoxObj = RocketObj
                   If Rockets(X).Status = 1
                      Rockets(X).Status = 2
                      Rockets(X).FlyTime = Rnd(300)+1200
                      Rockets(X).Delay = Timer()
                      
                      PartNum = FindFreeParticle()
                      Rockets(X).Particle = PartNum
                      Make Particles PartNum, 4, 800, 5
                      Position Particles PartNum, Object Position X(Rockets(X).ObjNum), Object Position Y(Rockets(X).ObjNum), Object Position Z(Rockets(X).ObjNum)
                      Set Particle Velocity PartNum, -2
                      SET PARTICLE FLOOR PartNum, 0
                      Set Particle Life PartNum, 15
                      Set Particle Speed PartNum, 0.025
                      RetVal = 1
                   EndIf 
                EndIf
            Next X
         EndIf
EndFunction RetVal

Function FindFreeParticle()
         For X = 1 to 100
             If Particles Exist(X) = 0
                RetVal = X
                Exit
             EndIf
         Next X
EndFunction RetVal

Function HandleRockets()
         For X = 0 To Array Count(Rockets())
             If Rockets(X).Status = 2 
                Move Object Up Rockets(X).ObjNum, 1
                Position Particles Rockets(X).Particle, Object Position X(Rockets(X).ObjNum), Object Position Y(Rockets(X).ObjNum), Object Position Z(Rockets(X).ObjNum)
                
                If Timer() - Rockets(X).Delay => Rockets(X).FlyTime
                   HandleExplosions(2, Rockets(X).ObjNum)
                   Move Object Down Rockets(X).ObjNum, Object Position Y(Rockets(X).ObjNum)+5
                   Rockets(X).Status = 1
                   Delete Particles Rockets(X).Particle
                EndIf
             EndIf
         Next X
EndFunction

Function HandleExplosions(Handle, Obj)
         Select Handle
                Case 1:
                     For X = 0 To Array Count(Fx1())
                         If Particles Exist(Fx1(X).PartNum)
                            If Timer() - Fx1(X).Delay => Fx1(X).LifeTime And Fx1(X).Status = 1
                               SET PARTICLE EMISSIONS Fx1(X).PartNum, 0
                               Fx1(X).Delay = Timer()
                               Fx1(X).LifeTime = 3000
                               Fx1(X).Status = 2
                            EndIf
                            If Timer() - Fx1(X).Delay => Fx1(X).LifeTime And Fx1(X).Status = 2
                               Delete Particles Fx1(X).PartNum
                               Array Delete Element Fx1(0), X
                            EndIf
                         EndIf
                     Next X
                     
                     For X = 0 To Array Count(Fx2())
                         `If Particles Exist(Fx2(X).PartNum)
                            If Timer() - Fx2(X).Delay => Fx2(X).LifeTime AND Fx2(X).Status = -1
                               Inc Fx2(X).Status
                               Set Particle Emissions Fx2(X).PartNum, 0
                               
                               Part = FindFreeParticle()
                               Fx2(X).PartNum2 = Part
                               
                               Make Particles Part, Rnd(2)+4, 400, 10
                               Position Particles Fx2(X).PartNum2, Fx2(X).X, Fx2(X).Y, Fx2(X).Z
                               Set Particle Floor Part, 0
                               Set Particle Life Part, 20
                               Fx2(X).Delay = Timer()
                            EndIf
                            If Timer() - Fx2(X).Delay => Fx2(X).LifeTime AND Fx2(X).Status = 0
                               Inc Fx2(X).Status
                               Set Particle Emissions Fx2(X).PartNum2, 0
                               
                               Part = FindFreeParticle()
                               Fx2(X).PartNum3 = Part
                               
                               Make Particles Part, Rnd(2)+4, 400, 10
                               Position Particles Fx2(X).PartNum3, Fx2(X).X+10, Fx2(X).Y, Fx2(X).Z
                               Set Particle Floor Part, 0
                               Set Particle Life Part, 20
                               Fx2(X).Delay = Timer()
                            EndIf
                            If Timer() - Fx2(X).Delay => Fx2(X).LifeTime AND Fx2(X).Status = 1
                               Inc Fx2(X).Status
                               Fx2(X).Delay = Timer()
                               Fx2(X).LifeTime = 3000
                               Set Particle Emissions Fx2(X).PartNum3, 0
                            EndIf
                            If Timer() - Fx2(X).Delay => Fx2(X).LifeTime AND Fx2(X).Status = 2
                               Delete Particles Fx2(X).PartNum
                               Delete Particles Fx2(X).PartNum2
                               Delete Particles Fx2(X).PartNum3
                               Array Delete Element Fx2(0), X
                            EndIf
                         `EndIf
                     Next X
                     
                     For X = 0 To Array Count(Fx3())
                         If Particles Exist(Fx3(X).PartNum)
                            If Timer() - Fx3(X).Delay => Fx3(X).LifeTime And Fx3(X).Status = 1
                               SET PARTICLE EMISSIONS Fx3(X).PartNum, 0
                               Fx3(X).Delay = Timer()
                               Fx3(X).LifeTime = 3000
                               Fx3(X).Status = 2
                            EndIf
                            If Timer() - Fx3(X).Delay => Fx3(X).LifeTime And Fx3(X).Status = 2
                               Delete Particles Fx3(X).PartNum
                               Array Delete Element Fx3(0), X
                            EndIf
                         EndIf
                     Next X
                EndCase
                Case 2:
                     C = Rnd(2)+1
                     Select C
                            Case 1:
                                 Array Insert at Bottom Fx1()
                                 Ar = Array Count(Fx1())
                                 Fx1(Ar).X = Object Position X(Obj)
                                 Fx1(Ar).Y = Object Position Y(Obj)
                                 Fx1(Ar).Z = Object Position Z(Obj)
                                 Fx1(Ar).LifeTime = 200
                                 Fx1(Ar).Delay = Timer()
                                 Fx1(Ar).Status = 1
                                 
                                 Part = FindFreeParticle()
                                 Fx1(Ar).PartNum = Part
                                 
                                 Make Particles Part, Rnd(2)+4, 400, 10
                                 Position Particles Part, Fx1(Ar).X, Fx1(Ar).Y, Fx1(Ar).Z
                                 Set Particle Floor Part, 0
                                 Set Particle Life Part, 20
                                 
                            EndCase
                            Case 2:
                                 Array Insert at Bottom Fx2()
                                 Ar = Array Count(Fx2())
                                 Fx2(Ar).X = Object Position X(Obj)
                                 Fx2(Ar).Y = Object Position Y(Obj)
                                 Fx2(Ar).Z = Object Position Z(Obj)
                                 Fx2(Ar).LifeTime = 200
                                 Fx2(Ar).Delay = Timer()
                                 Fx2(Ar).Status = -1
                                 
                                 Part = FindFreeParticle()
                                 Fx2(Ar).PartNum = Part
                                 
                                 Make Particles Part, Rnd(2)+4, 400, 10
                                 Position Particles Part, Fx2(Ar).X-10, Fx2(Ar).Y, Fx2(Ar).Z
                                 Set Particle Floor Part, 0
                                 Set Particle Life Part, 20     
                            EndCase
                            Case 3:
                                 Array Insert at Bottom Fx3()
                                 Ar = Array Count(Fx3())
                                 Fx3(Ar).X = Object Position X(Obj)
                                 Fx3(Ar).Y = Object Position Y(Obj)
                                 Fx3(Ar).Z = Object Position Z(Obj)
                                 Fx3(Ar).LifeTime = 500
                                 Fx3(Ar).Delay = Timer()
                                 Fx3(Ar).Status = 1
                                 
                                 Part = FindFreeParticle()
                                 Fx3(Ar).PartNum = Part
                                 
                                 Make Particles Part, Rnd(2)+4, 800, 10
                                 Position Particles Part, Fx3(Ar).X, Fx3(Ar).Y, Fx3(Ar).Z
                                 Set Particle Floor Part, 0
                                 Set Particle Chaos Part, 10
                                 Set Particle Gravity Part, 0
                                 Set Particle Velocity Part, 1
                                 Set Particle Speed Part, 0.0028
                                 Set Particle Life Part, 37
                              EndCase
                     EndSelect
                EndCase
         EndSelect
EndFunction

Rem Project: Fire Works 3d
Rem Created: 7/27/2009 7:18:16 PM
Rem Jesus is The Way the Truth and the Life
Rem ***** Main Source File *****

set display mode 1024,768,16
backdrop off
sw=screen width()
sh=screen height()
set camera range 0.1,100000
maxfire=10
stars=7777
Camera$="Aim"
camax#=270
weight#=0.2
hud=1



for s=1 to stars
   starcolor=RGB(255,255,200+rnd(55))
   dot rnd(sw),rnd(sh),starcolor
next stars

sync
get image 1000,0,0,sw,sh,1

for x=0 to 50
for y=0 to 50
shade=rnd(30)-20
dot x,y,RGB(0,59+shade,0)
next y
next x
sync
for d=1 to 300
shade=rnd(30)-20
dot rnd(50),rnd(50),RGB(59+shade,25+shade/2,0)
next d
get image 2,0,0,50,50,3


box 0,0,200,20,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0)

radius=10

for g=0 to 9
ay#=0
mx=g*20+10
my=10



if g=0 then rd#=1 : gr#=0 : bl#=0
if g=1 then rd#=0 : gr#=1 : bl#=0
if g=2 then rd#=0 : gr#=0 : bl#=1
if g=3 then rd#=1 : gr#=1 : bl#=0
if g=4 then rd#=0 : gr#=1 : bl#=1
if g=5 then rd#=0.5 : gr#=0 : bl#=1
if g=6 then rd#=1 : gr#=1 : bl#=1
if g=7 then rd#=1 : gr#=0.5 : bl#=0.5
if g=8 then rd#=0.5 : gr#=1 : bl#=1
if g=9 then rd#=1 : gr#=0 : bl#=0.5



for x=mx-radius to mx+radius
ay#=ay#+Wrapvalue(180/(radius*2))
ah#=newxvalue(0,ay#,255)
`a#=-(180/(radius*2))
a#=0
for y=my-radius to my+radius
a#=Wrapvalue(a#+180/(radius*2))
h#=newxvalue(0,a#,ah#)
base=point(x,y)
rd=RGBR(base)+h#*rd#
gr=RGBG(base)+h#*gr#
bl=RGBB(base)+h#*bl#
if rd<0 then rd=0
if gr<0 then gr=0
if bl<0 then bl=0
if rd>255 then rd=255
if gr>255 then gr=255
if bl>255 then bl=255
dot x,y,RGB(rd,gr,bl)
next y
next x

sync
get image g+3,g*20,0,g*20+20,20,3
next g


cls
box 0,0,100,30,RGB(255,255,255),RGB(255,255,255),RGB(255,255,255),RGB(255,255,255)
for t=0 to 4
for u=-5 to 4
if ABS(u)=>2 then ink RGB(0,0,255),RGB(0,0,0) else ink RGB(255,0,0),RGB(0,0,0)
line t*20,30+u,t*20+10,u
next u
next t

for t=0 to 4
for u=-5 to 4
if ABS(u)=>2 then ink RGB(0,0,255),RGB(0,0,0) else ink RGB(255,0,0),RGB(0,0,0)
line t*20+10,u,t*20+20,u+30
next u
next t
sync
get image 11,0,0,40,20,3




autocam off
make object sphere 1000,7000,16,16
texture object 1000,1000
set object cull 1000,0

make matrix 1,7000,7000,70,70
position matrix 1,-3500,0,-3500
prepare matrix texture 1,2,1,1
for angle=1 to 30
radius=20
height=100+rnd(300)
dis=30
mx=newxvalue(35,angle*(360/30),dis)
mz=newzvalue(35,angle*(360/30),dis)
ay#=-(180/(radius*2))
for x=mx-radius to mx+radius
ay#=ay#+Wrapvalue(180/(radius*2))
ah#=newxvalue(0,ay#,height)
a#=-(180/(radius*2))
for z=mz-radius to mz+radius
a#=Wrapvalue(a#+180/(radius*2))
h#=newxvalue(0,a#,ah#)
if x>=0 and x<=70 and z>=0 and z<=70
set matrix height 1,x,z,get matrix height(1,x,z)+h#
endif
next z
next x
next angle
update matrix 1

rem fire works
dim fireworks(maxfire,1)
dim fws(maxfire,7)
dim grav#(maxfire)
dim loada#(maxfire)
position camera 0,200,0
make object cone 1,15
make object cylinder 2,10
scale object 2,100,500,100
make mesh from object 1,2
delete object 2
add limb 1,1,1
texture object 1,11
offset limb 1,1,0,-30,0
xrotate object 1,90
fix object pivot 1
set object cull 1,0
scale object 1,50,50,50
for f=2 to maxfire
clone object f,1,1
next f
delete mesh 1

make object cylinder 2000,250
scale object 2000,100,15,100
make object cylinder 2001,262
scale object 2001,100,15,100
make object box 2002,100,30,10
position object 2002,-180,0,0
texture object 2002,11

color object 2000,RGB(0,0,255)
set object ambience 2000,RGB(0,0,255)
set object diffuse 2000,RGB(0,0,255)
color object 2001,RGB(70,70,70)
set object ambience 2001,RGB(255,255,255)
set object diffuse 2001,RGB(70,70,70)


for t=2000 to 2001
set object cull t,0
next t

carta#=270
for f=1 to maxfire
xrotate object f,270
position object f,newxvalue(0,carta#,127.6),24,newzvalue(0,carta#,127.6)
loada#(f)=carta#
dec carta#,12
make particles 999+f,6,10,10
set particle speed 999+f,0.1
set particle gravity 999+f,0
rotate particles 999+f,180,0,0
set particle emissions 999+f,0
set particle floor 999+f,0
set particle velocity 999+f,7
rotate particles 999+f,180,0,0
next f


empty checklist
perform checklist for fonts
for t=1 to checklist quantity()
if checklist string$(t)="Arial Bold" then set text font "Arial Bold"
if checklist string$(t)="Biondi" then set text font "Biondi"
next t
set text size 20

rem **********************************************************************************************************
rem *************************************************LOADING**************************************************
rem **********************************************************************************************************

sync on
sync rate 60

do
ink RGB(0,255,255),RGB(0,0,0)
camx#=camera position x()
camy#=camera position y()
camz#=camera position z()

if controlkey()=1 then inc con else con=0
if con=1 and Camera$="Aim" then Camera$="Free" : con=2
if con=1 and Camera$="Free" then Camera$="Aim" : con=2 : rotate camera 270,0,0


if spacekey()=1 then inc fire else fire=0



if fire=1 and loaded>0
loada#(loaded)=0
`if fw>maxfire then fw=1
fws(loaded,4)=40+rnd(20)
fws(loaded,1)=object position x(loaded)
fws(loaded,2)=0
fws(loaded,3)=object position z(loaded)
fws(loaded,0)=1

if camera$="Aim" then rotate object loaded,camax#,0,camaz# else xrotate object loaded,270
position object loaded,fws(loaded,1),fws(loaded,2),fws(loaded,3)
set particle emissions 999+loaded,20
loaded=0
loading=0
endif

rem fireworks in the air
for f=1 to maxfire
if fws(f)=1
move object f,30

if fws(f,2)>60 and fws(f,2)<100 then set particle emissions 999+f,0
position particles 999+f,fws(f,1),fws(f,2)-10,fws(f,3)

fws(f,1)=object position x(f)
fws(f,2)=object position y(f)
fws(f,3)=object position z(f)
grav#(f)=grav#(f)+weight#
position object f,fws(f,1),fws(f,2)-grav#(f),fws(f,3)

fws(f,5)=fws(f,1)
fws(f,6)=fws(f,2)
fws(f,7)=fws(f,3)

dec fws(f,4)
if fws(f,4)<=0 or fws(f,2)-grav#(f)<get ground height(1,fws(f,1)+3500,fws(f,3)+3500)
inc explosion
if explosion>maxfire then explosion=1
make particles explosion,rnd(9)+3,10,21+rnd(14)
set particle floor explosion,0
position particles explosion,fws(f,1),fws(f,2),fws(f,3)
set particle velocity explosion,7+rnd(7)
set particle speed explosion,0.1
set particle gravity explosion,0
set particle emissions explosion,7
`rotate particles explosion,Wrapvalue(camax#+90),Wrapvalue(camera angle y()),0
fireworks(explosion,0)=1
fws(f,1)=0
fws(f,2)=0
fws(f,3)=0
fws(f,0)=0
fws(f,4)=0
position object f,0,0,0
rotate object f,270,0,0
grav#(f)=0
loada#(f)=0
endif
endif
next f

rem fire works on ground
loading=0
carta#=280

for f=1 to maxfire
if fws(f,0)=0
xrotate object f,270
nla#=280
for a=1 to maxfire
if loada#(a)>loada#(f) and loada#(a)<nla# then nla#=loada#(a)
next a

if loada#(f)=>270 and loading=f or loading=0 and loada#(f)=>270
if loaded=0
loadx#=object position x(f)
loady#=object position y(f)
loadz#=object position z(f)


if loady#<40 then inc loady#,7 : loading=f
if loady#=>40 and loadx#>-210 then dec loadx#,10 : loading=f : else loading=0

position object f,loadx#,loady#,loadz#
if loadx#<-200 and loady#<50 then loaded=f else loaded=0
endif
else
if loada#(f)<nla#-10 then loada#(f)=Wrapvalue(loada#(f)+3)
position object f,newxvalue(0,loada#(f),127.6),24,newzvalue(0,loada#(f),127.6)
endif





endif
next t




rem explosions
for f=1 to maxfire
if fireworks(f,0)=1
inc fireworks(f,1),1
if fireworks(f,1)=10 then set particle emissions f,0
if fireworks(f,1)>30 then delete particles f : fireworks(f,0)=0 : fireworks(f,1)=1
endif
next f


if camera$="Free"
Center text sw/2,0,"Press Spacekey To Launch"
Center text sw/2,30,"Use WSAD or arrow Keys To Move The Camera"

camay#=Wrapvalue(camera angle y()+mousemovex()/3.0)
camax#=Wrapvalue(camera angle x()+mousemovey()/3.0)
rotate camera camax#,camay#,0
if upkey()=1 or keystate(17)=1 then move camera 10
if downkey()=1 or keystate(31)=1 then move camera -10
camx#=camera position x()
camy#=camera position y()
camz#=camera position z()

if rightkey()=1 or keystate(32)=1
camx#=newxvalue(camx#,Wrapvalue(camay#+90),10)
camz#=newzvalue(camz#,Wrapvalue(camay#+90),10)
endif
if leftkey()=1 or keystate(30)=1
camx#=newxvalue(camx#,Wrapvalue(camay#-90),10)
camz#=newzvalue(camz#,Wrapvalue(camay#-90),10)
endif


position camera camx#,camy#,camz#
endif

if camera$="Aim"

Center text sw/2,0,"Press Spacekey To Launch"
Center text sw/2,30,"Use WSAD Keys To Aim"

Center text sw/2,50,"Press The Enter Key To Toggle The Targetting System"

if returnkey()=1 then inc hudt else hudt=0
if hudt=1 then inc hud : if hud>1 then hud=0

if keystate(17)=1 then inc up#,0.1
if keystate(31)=1 then dec up#,0.1
if keystate(30)=1 then dec side#,0.1
if keystate(32)=1 then inc side#,0.1

rem camera bounds
if up#>0 then dec up#,0.05
if up#<0 then inc up#,0.05
if side#>0 then dec side#,0.05
if side#<0 then inc side#,0.05
if up#>2 then up#=2
if up#<-2 then up#=-2
if side#>2 then side#=2
if side#<-2 then side#=-2
if up#>-0.05 and up#<0.05 then up#=0
if side#>-0.05 and side#<0.05 then side#=0

camaz#=Wrapvalue(camaz#-side#)
camax#=Wrapvalue(camax#-up#)
if camax#>330 then camax#=330
if camax#<200 then camax#=200
if camaz#<290 and camaz#>180 then camaz#=290
if camaz#>70 and camaz#<180 then camaz#=70

position camera 0,100,0
rotate camera camax#,0,camaz#

if loaded>0
rotate object loaded,camax#,0,camaz#
endif

rem Targeting System
live=0
if hud=1
for f=1 to maxfire
if fws(f,0)=1 and object in screen(f)=1
sox=object screen x(f)
soy=object screen x(f)

dis#=sqrt((fws(f,1))^2+(fws(f,2))^2+(fws(f,3))^2)
ink RGB(0,255,0),RGB(0,0,0)
circle sox,soy,(dis#/100)
TEXT sox,soy,"Distance : "+STR$(dis#,2)
live=1
endif
next f
if live=1 then ink RGB(0,255,0),RGB(0,0,0) : ink RGB(255,0,0),RGB(0,0,0)
line sw/2-200,sh/2,sw/2-100,sh/2
line sw/2+200,sh/2,sw/2+100,sh/2
line sw/2,sh/2-50,sw/2,sh/2-100
line sw/2,sh/2+50,sw/2,sh/2+100



endif

endif

position object 1000,camera position x(),camera position y(),camera position z()
set cursor 0,0
if loaded>0 then Print "Fire Work Cartridge in Place" else if loading>0 then Print "Loading Cartridge..."
Text sw-text width("Toggle Camera Modes With The Control Key"),sh-30,"Toggle Camera Modes With The Control Key"

sync
loop

Rem Project: Fire Works 3d
Rem Created: 7/27/2009 7:18:16 PM
Rem Jesus is The Way the Truth and the Life
Rem ***** Main Source File *****

set display mode 1024,768,16
backdrop off
sw=screen width()
sh=screen height()
set camera range 0.1,100000
maxfire=10
stars=7777
Camera$="Aim"
camax#=270
weight#=0.2
hud=1

while spacekey()=0
cls
Print "Press Spacekey to Record Whistle Sound"
sync
endwhile
record sound 2,3000
wait 200
while spacekey()=0
cls
Print "Press Again To Stop Recording..."
sync
endwhile
stop recording sound
cls
Print "Recording stopped"
sync
wait 500
while spacekey()=0
cls
Print "Press Spacekey to Record Explosion Sound"
sync
endwhile
record sound 1,3000
wait 200
while spacekey()=0
cls
Print "Press Again To Stop Recording..."
sync
endwhile
stop recording sound
cls



for s=1 to stars
   starcolor=RGB(255,255,200+rnd(55))
   dot rnd(sw),rnd(sh),starcolor
next stars

sync
get image 1000,0,0,sw,sh,1

for x=0 to 50
for y=0 to 50
shade=rnd(30)-20
dot x,y,RGB(0,59+shade,0)
next y
next x
sync
for d=1 to 300
shade=rnd(30)-20
dot rnd(50),rnd(50),RGB(59+shade,25+shade/2,0)
next d
get image 2,0,0,50,50,3


box 0,0,200,20,RGB(0,0,0),RGB(0,0,0),RGB(0,0,0),RGB(0,0,0)

radius=10

for g=0 to 9
ay#=0
mx=g*20+10
my=10



if g=0 then rd#=1 : gr#=0 : bl#=0
if g=1 then rd#=0 : gr#=1 : bl#=0
if g=2 then rd#=0 : gr#=0 : bl#=1
if g=3 then rd#=1 : gr#=1 : bl#=0
if g=4 then rd#=0 : gr#=1 : bl#=1
if g=5 then rd#=0.5 : gr#=0 : bl#=1
if g=6 then rd#=1 : gr#=1 : bl#=1
if g=7 then rd#=1 : gr#=0.5 : bl#=0.5
if g=8 then rd#=0.5 : gr#=1 : bl#=1
if g=9 then rd#=1 : gr#=0 : bl#=0.5



for x=mx-radius to mx+radius
ay#=ay#+Wrapvalue(180/(radius*2))
ah#=newxvalue(0,ay#,255)
`a#=-(180/(radius*2))
a#=0
for y=my-radius to my+radius
a#=Wrapvalue(a#+180/(radius*2))
h#=newxvalue(0,a#,ah#)
base=point(x,y)
rd=RGBR(base)+h#*rd#
gr=RGBG(base)+h#*gr#
bl=RGBB(base)+h#*bl#
if rd<0 then rd=0
if gr<0 then gr=0
if bl<0 then bl=0
if rd>255 then rd=255
if gr>255 then gr=255
if bl>255 then bl=255
dot x,y,RGB(rd,gr,bl)
next y
next x

sync
get image g+3,g*20,0,g*20+20,20,3
next g


cls
box 0,0,100,30,RGB(255,255,255),RGB(255,255,255),RGB(255,255,255),RGB(255,255,255)
for t=0 to 4
for u=-5 to 4
if ABS(u)=>2 then ink RGB(0,0,255),RGB(0,0,0) else ink RGB(255,0,0),RGB(0,0,0)
line t*20,30+u,t*20+10,u
next u
next t

for t=0 to 4
for u=-5 to 4
if ABS(u)=>2 then ink RGB(0,0,255),RGB(0,0,0) else ink RGB(255,0,0),RGB(0,0,0)
line t*20+10,u,t*20+20,u+30
next u
next t
sync
get image 11,0,0,40,20,3




autocam off
make object sphere 1000,7000,16,16
texture object 1000,1000
set object cull 1000,0

make matrix 1,7000,7000,70,70
position matrix 1,-3500,0,-3500
prepare matrix texture 1,2,1,1
for angle=1 to 30
radius=20
height=100+rnd(300)
dis=30
mx=newxvalue(35,angle*(360/30),dis)
mz=newzvalue(35,angle*(360/30),dis)
ay#=-(180/(radius*2))
for x=mx-radius to mx+radius
ay#=ay#+Wrapvalue(180/(radius*2))
ah#=newxvalue(0,ay#,height)
a#=-(180/(radius*2))
for z=mz-radius to mz+radius
a#=Wrapvalue(a#+180/(radius*2))
h#=newxvalue(0,a#,ah#)
if x>=0 and x<=70 and z>=0 and z<=70
set matrix height 1,x,z,get matrix height(1,x,z)+h#
endif
next z
next x
next angle
update matrix 1

rem fire works
dim fireworks(maxfire,1)
dim fws(maxfire,7)
dim grav#(maxfire)
dim loada#(maxfire)
position camera 0,200,0
make object cone 1,15
make object cylinder 2,10
scale object 2,100,500,100
make mesh from object 1,2
delete object 2
add limb 1,1,1
texture object 1,11
offset limb 1,1,0,-30,0
xrotate object 1,90
fix object pivot 1
set object cull 1,0
scale object 1,50,50,50
for f=2 to maxfire
clone object f,1,1
next f
delete mesh 1

make object cylinder 2000,250
scale object 2000,100,15,100
make object cylinder 2001,262
scale object 2001,100,15,100
make object box 2002,100,30,10
position object 2002,-180,0,0
texture object 2002,11

color object 2000,RGB(0,0,255)
set object ambience 2000,RGB(0,0,255)
set object diffuse 2000,RGB(0,0,255)
color object 2001,RGB(70,70,70)
set object ambience 2001,RGB(255,255,255)
set object diffuse 2001,RGB(70,70,70)


for t=2000 to 2001
set object cull t,0
next t

carta#=270
for f=1 to maxfire
xrotate object f,270
position object f,newxvalue(0,carta#,127.6),24,newzvalue(0,carta#,127.6)
loada#(f)=carta#
dec carta#,12
make particles 999+f,6,10,10
set particle speed 999+f,0.1
set particle gravity 999+f,0
rotate particles 999+f,180,0,0
set particle emissions 999+f,0
set particle floor 999+f,0
set particle velocity 999+f,7
rotate particles 999+f,180,0,0
next f


make object sphere 300,4
make object cylinder 301,100
scale object 301,2,50,2
make mesh from object 301,301
make object box 302,2,2,20
make mesh from object 302,302

delete object 301
delete object 302

add limb 300,1,301
add limb 300,2,301
add limb 300,3,302
offset limb 300,1,0,-24,-10
offset limb 300,2,0,-24,10
offset limb 300,3,0,0,0
delete mesh 301
delete mesh 302

position object 300,0,50,0

make object cylinder 301,100
scale object 301,4,100,4
zrotate object 301,90
position object 301,-180,4,-10

make object cylinder 302,100
scale object 302,4,100,4
zrotate object 302,90
position object 302,-180,4,10

for t=301 to 302
color object t,RGB(80,80,80)
set object diffuse t,RGB(90,90,90)
set object ambience t,RGB(70,70,70)
next t

color object 300,RGB(255,0,0)
set object diffuse 300,RGB(255,0,0)
set object ambience 300,RGB(255,255,255)
set object ambient 300,0
color limb 300,1,RGB(0,0,255)
color limb 300,2,RGB(0,0,255)
color limb 300,3,RGB(255,255,255)

make object box 303,40,35,40
position object 303,0,17.5,125
texture object 303,11

make object cylinder 304,20
position object 304,0,10,0
make object sphere 305,50
scale object 305,100,0.5,100
position object 305,0,20,0
make object sphere 306,100
color object 306,RGB(0,255,255)
position object 306,0,20,0
ghost object on 306

make object box 307,2,2,100
make object box 308,100,2,2

position object 307,0,20,0
position object 308,0,20,0

make object sphere 309,14
position object 309,0,30,0
set reflection shading on 309


for t=304 to 308
if t<>306
color object t,RGB(80,80,80)
set object diffuse t,RGB(90,90,90)
set object ambience t,RGB(70,70,70)
endif
next t

empty checklist
perform checklist for fonts
for t=1 to checklist quantity()
if checklist string$(t)="Arial Bold" then set text font "Arial Bold"
if checklist string$(t)="Biondi" then set text font "Biondi"
next t
set text size 20

rem **********************************************************************************************************
rem *************************************************LOADING**************************************************
rem **********************************************************************************************************

sync on
sync rate 60

do
ink RGB(0,255,255),RGB(0,0,0)
camx#=camera position x()
camy#=camera position y()
camz#=camera position z()

if controlkey()=1 then inc con else con=0
if con=1 and Camera$="Aim" then Camera$="Free" : con=2
if con=1 and Camera$="Free" then Camera$="Aim" : con=2 : rotate camera 270,0,0


if spacekey()=1 then inc fire else fire=0



if fire=1 and loaded>0
loada#(loaded)=0
play sound 2
`if fw>maxfire then fw=1
fws(loaded,4)=40+rnd(20)
fws(loaded,1)=object position x(loaded)
fws(loaded,2)=0
fws(loaded,3)=object position z(loaded)
fws(loaded,0)=1

if camera$="Aim" then rotate object loaded,camax#,0,camaz#
position object loaded,fws(loaded,1),fws(loaded,2),fws(loaded,3)
set particle emissions 999+loaded,20
loaded=0
loading=0
endif
rem fireworks in the air
for f=1 to maxfire
if fws(f)=1
move object f,30

if fws(f,2)>60 and fws(f,2)<100 then set particle emissions 999+f,0
position particles 999+f,fws(f,1),fws(f,2)-10,fws(f,3)

fws(f,1)=object position x(f)
fws(f,2)=object position y(f)
fws(f,3)=object position z(f)
grav#(f)=grav#(f)+weight#
position object f,fws(f,1),fws(f,2)-grav#(f),fws(f,3)

fws(f,5)=fws(f,1)
fws(f,6)=fws(f,2)
fws(f,7)=fws(f,3)

dec fws(f,4)
if fws(f,4)<=0 or fws(f,2)-grav#(f)<get ground height(1,fws(f,1)+3500,fws(f,3)+3500)
inc explosion
if explosion>maxfire then explosion=1
make particles explosion,rnd(9)+3,10,21+rnd(14)
set particle floor explosion,0
position particles explosion,fws(f,1),fws(f,2),fws(f,3)
set particle velocity explosion,7+rnd(7)
set particle speed explosion,0.1
set particle gravity explosion,0
set particle emissions explosion,14
set particle life explosion,200
play sound 1

make particles explosion+3000,rnd(9)+3,10,21+rnd(14)
set particle floor explosion+3000,0
position particles explosion+3000,fws(f,1),fws(f,2),fws(f,3)
set particle velocity explosion+3000,7+rnd(7)
set particle speed explosion+3000,0.1
set particle gravity explosion+3000,0
set particle emissions explosion+3000,7

if rnd(5)=1
rotate particles explosion+3000,Wrapvalue(object angle x(f)+180),object angle y(f),object angle z(f)
rotate particles explosion,object angle x(f),object angle y(f),object angle z(f)
else
rotate particles explosion+3000,Wrapvalue(object angle x(f)+90),object angle y(f),object angle z(f)
rotate particles explosion,Wrapvalue(object angle x(f)+90),object angle y(f),object angle z(f)
endif

`rotate particles explosion,Wrapvalue(camax#+90),Wrapvalue(camera angle y()),0
fireworks(explosion,0)=1
fws(f,1)=0
fws(f,2)=0
fws(f,3)=0
fws(f,0)=0
fws(f,4)=0
position object f,0,0,0
rotate object f,270,0,0
grav#(f)=0
loada#(f)=0
endif
endif
next f

rem fire works on ground
loading=0
carta#=280

for f=1 to maxfire
if fws(f,0)=0
xrotate object f,270
nla#=280
for a=1 to maxfire
if loada#(a)>loada#(f) and loada#(a)<nla# then nla#=loada#(a)
next a

if loada#(f)=>270 and loading=f or loading=0 and loada#(f)=>270
if loaded=0
loadx#=object position x(f)
loady#=object position y(f)
loadz#=object position z(f)

if loady#<40 then inc loady#,7 : loading=f
if loady#=>40 and loadx#>-210 then dec loadx#,10 : loading=f : else loading=0

if loading>0
position object 300,loadx#,loady#,loadz#
if oldloading=0 then rotate object loading,270+rnd(30)-15,0,Wrapvalue(rnd(30)-15)
endif


position object f,loadx#,loady#,loadz#
if loadx#<-200 and loady#<50 then loaded=f else loaded=0
endif
else
if loada#(f)<nla#-10 then loada#(f)=Wrapvalue(loada#(f)+3)
position object f,newxvalue(0,loada#(f),127.6),24,newzvalue(0,loada#(f),127.6)
endif





endif
next t

oldloading=loading


rem explosions
for f=1 to maxfire
if fireworks(f,0)=1
inc fireworks(f,1),1
if fireworks(f,1)=15 then set particle emissions f+3000,0
if fireworks(f,1)=23 then set particle emissions f+3000,25
if fireworks(f,1)=30 then set particle emissions f,0 : set particle emissions f+3000,0
if fireworks(f,1)>130 then delete particles f : fireworks(f,0)=0 : fireworks(f,1)=1 : delete particles f+3000

endif
next f


if camera$="Free"
Center text sw/2,0,"Press Spacekey To Launch"
Center text sw/2,30,"Use WSAD or arrow Keys To Move The Camera"
camay#=Wrapvalue(camera angle y()+mousemovex()/3.0)
camax#=Wrapvalue(camera angle x()+mousemovey()/3.0)
rotate camera camax#,camay#,0
if upkey()=1 or keystate(17)=1 then move camera 10
if downkey()=1 or keystate(31)=1 then move camera -10
camx#=camera position x()
camy#=camera position y()
camz#=camera position z()
if rightkey()=1 or keystate(32)=1
camx#=newxvalue(camx#,Wrapvalue(camay#+90),10)
camz#=newzvalue(camz#,Wrapvalue(camay#+90),10)
endif
if leftkey()=1 or keystate(30)=1
camx#=newxvalue(camx#,Wrapvalue(camay#-90),10)
camz#=newzvalue(camz#,Wrapvalue(camay#-90),10)
endif
position camera camx#,camy#,camz#
endif

if camera$="Aim"
Center text sw/2,0,"Press Spacekey To Launch"
Center text sw/2,30,"Use WSAD Keys To Aim"
Center text sw/2,50,"Press The Enter Key To Toggle The Targetting System"
if returnkey()=1 then inc hudt else hudt=0
if hudt=1 then inc hud : if hud>1 then hud=0
if keystate(17)=1 or upkey()=1 then inc up#,0.1
if keystate(31)=1 or downkey()=1 then dec up#,0.1
if keystate(30)=1 or leftkey()=1 then dec side#,0.1
if keystate(32)=1 or rightkey()=1 then inc side#,0.1

rem camera bounds
if up#>0 then dec up#,0.05
if up#<0 then inc up#,0.05
if side#>0 then dec side#,0.05
if side#<0 then inc side#,0.05
if up#>2 then up#=2
if up#<-2 then up#=-2
if side#>2 then side#=2
if side#<-2 then side#=-2
if up#>-0.05 and up#<0.05 then up#=0
if side#>-0.05 and side#<0.05 then side#=0

camaz#=Wrapvalue(camaz#-side#)
camax#=Wrapvalue(camax#-up#)
if camax#>330 then camax#=330 : up#=-up#/1.5
if camax#<200 then camax#=200 : up#=-up#/1.5
if camaz#<290 and camaz#>180 then camaz#=290 : side#=-side#/1.5
if camaz#>70 and camaz#<180 then camaz#=70 : side#=-side#/1.5

position camera 0,40,0
rotate camera camax#,0,camaz#

if loaded>0
rotate object loaded,camax#,0,camaz#
endif



rem Targeting System
live=0
if hud=1
for f=1 to maxfire
if fws(f,0)=1 and object in screen(f)=1
sox=object screen x(f)
soy=object screen x(f)
dis#=sqrt((fws(f,1))^2+(fws(f,2))^2+(fws(f,3))^2)
ink RGB(0,255,0),RGB(0,0,0)
circle sox,soy,(dis#/100)
TEXT sox,soy,"Distance : "+STR$(dis#,2)
live=1
endif
next f
if live=1 then ink RGB(0,255,0),RGB(0,0,0) : ink RGB(255,0,0),RGB(0,0,0)
line sw/2-200,sh/2,sw/2-100,sh/2
line sw/2+200,sh/2,sw/2+100,sh/2
line sw/2,sh/2-50,sw/2,sh/2-100
line sw/2,sh/2+50,sw/2,sh/2+100
endif
endif



position object 1000,camera position x(),camera position y(),camera position z()
set cursor 0,0
if loaded>0 then Print "Fire Work Cartridge in Place" else if loading>0 then Print "Loading Cartridge..."
Text sw-text width("Toggle Camera Modes With The Control Key"),sh-30,"Toggle Camera Modes With The Control Key"

sync
loop

REM *** Coding Challenge: 2D Spaceship game
REM *** By: Martin 'eLeit' Enderleit
REM *** Started: 15. August, 2009.

ScreenWidth = 1680      REM - Screen Width (set to something that works for you)
ScreenHeight = 1050     REM - Screen Depth (set to something that works for you)
ScreenDepth = 32        REM - Screen Depth (set to something that works for you)
NumStars = 500          REM - Number of stars in the starfield. (decrease if it runs slow)

REM - Create a user type to hold the info for the stars.
type star
    xpos as FLOAT
    ypos as FLOAT
    col as INTEGER
endtype

REM - Create a user type to hold the info for the player ship.
type ship
    xpos as FLOAT
    ypos as FLOAT
    turnspeed as FLOAT
    angle as FLOAT
    hp as INTEGER
    speed as FLOAT
endtype

set display mode ScreenWidth,ScreenHeight,32
sync on : sync rate 0
hide mouse
color backdrop 0

player as ship
gosub CreateShip
dim starfield(NumStars) as star
gosub CreateStarfield

sprite 1,player.xpos,player.ypos,1
offset sprite 1,15,15

speedTimer = 0

REM - Main Loop.
oldTime = timer()
do
    difTime = timer() - oldTime
    oldTime = timer()

    inc speedTimer,difTime
    if speedTimer > 100
        inc player.speed,0.0001
        if player.speed > 1.0 then player.speed = 1.0
        speedTimer = 0
    endif
        
    gosub DrawStarfield
    sprite 1,player.xpos,player.ypos,1
    rotate sprite 1,player.angle
    gosub Controls
    
    ink rgb(255,255,255),0    
    text 0,0,"FPS: "+str$(screen fps())
    text 0,15,"Speed: "+str$(int(player.speed*1000))
    sync
loop


REM - Control the Ship.
Controls:
    LK = leftkey()
    RK = rightkey()
    
    if LK
        dec player.turnspeed,0.001*difTime
        if player.turnspeed<-1.0 then player.turnspeed = -1.0
        dec player.angle,0.035*difTime
        if player.angle<-35.0 then player.angle = -35.0
    endif
    if RK
        inc player.turnspeed,0.001*difTime
        if player.turnspeed>1.0 then player.turnspeed = 1.0
        inc player.angle,0.035*difTime
        if player.angle>35.0 then player.angle = 35.0
    endif
    if LK=0 and RK=0
        if player.turnspeed<0.0
            inc player.turnspeed,0.001*difTime
            inc player.angle,0.035*difTime
            if player.turnspeed>0.0
                player.turnspeed = 0.0
                player.angle = 0.0
            endif
        endif
        if player.turnspeed>0.0
            dec player.turnspeed,0.001*difTime
            dec player.angle,0.035*difTime
            if player.turnspeed<0.0
                player.turnspeed = 0.0
                player.angle = 0.0
            endif
        endif
    endif

    inc player.xpos,player.turnspeed
    if player.xpos < 15
        player.xpos = 15
        if player.turnspeed < 0.0
            player.turnspeed = 0.0
            player.angle = 0.0
        endif
    endif
    if player.xpos > ScreenWidth-16
        player.xpos = ScreenWidth-16
        if player.turnspeed > 0.0
            player.turnspeed = 0.0
            player.angle = 0.0
        endif
    endif
return


REM - Draw and move the stars.
DrawStarfield:
    lock pixels
    for i=0 to NumStars
        ink rgb(starfield(i).col,starfield(i).col,255),0
        dot starfield(i).xpos,starfield(i).ypos
        inc starfield(i).ypos,player.speed*difTime
        if starfield(i).ypos > ScreenHeight then starfield(i).ypos = 0.0
    next i
    unlock pixels
return


REM - Create the ship image.
CreateShip:
    width as FLOAT
    width = 0.0
    col = 255

    for y=0 to 31
        ink rgb(col,0,0),0
        line 15-int(width),y,15+int(width),y
        inc width,0.5
        dec col,4
    next y

    ink rgb(255,255,255),0
    box 14,10,16,20
    box 13,11,17,20

    get image 1,0,0,32,32
    cls
    
    player.xpos = ScreenWidth/2
    player.ypos = ScreenHeight - 64
    player.hp = 100
    player.speed = 0.01
    player.turnspeed = 0.0
return


REM - Create the random starfield.
CreateStarfield:
    for i=0 to NumStars
        starfield(i).xpos = rnd(ScreenWidth-1)
        starfield(i).ypos = rnd(ScreenHeight-1)
        starfield(i).col = rnd(128)+127
    next i
return