Sorry your browser is not supported!

sync on : sync rate 60 : hide mouse
disable escapekey
set display mode 1024,768,32, 1

gosub initialize_memory

intro( )



function intro( )
    setString( "PLEASE ENTER YOUR NAME",0xFF00EEFF,"Courier",14,60 )
    
    global name$ as string
    clear entry buffer
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        name$=entry$( 1 )
        name$=upper$( name$ )
        writeString( 5,5 )
        text 5,25, name$
        sync
    endwhile
    
    clear entry buffer
    cls
    
    setString( "HELLO "+name$+CRLF$+"WELCOME TO THE TEST."+CRLF$+CRLF$+CRLF$+"YOUR TEST RESULTS WILL BE SAVED AS TEST_"+name$+".TXT"+CRLF$+CRLF$+"PRESS RETURN TO CONTINUE",0xFF00EEFF,"Courier",14,60 )
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        sync
    endwhile
    
    quoteInstructions( )
    
    cls
    
    disptext$ = "IF AT ANY POINT DURING THE COURSE OF THIS TEST YOU BEGIN TO EXPERIENCE:"+CRLF$
    disptext$ = disptext$ + "NAUSEA; DIZZINESS; VERTIGO; MOTION SICKNESS; FRUSTRATION; IRRATIONAL ANGER; OR THOUGHTS OF SUICIDE;"+CRLF$+CRLF$
    disptext$ = disptext$ + "OR IF YOU REQUIRE AN INTERMISSION FOR ANY OTHER REASON NOT LISTED ABOVE--INCLUDING, BUT NOT LIMITED TO:"+CRLF$
    disptext$ = disptext$ + "URGENT CALL OR NEED TO VISIT YOUR SUPERVISOR'S OFFICE, THE LAVATORY, THE MEDICAL CABINET, OR THE HOSPITAL;"+CRLF$
    disptext$ = disptext$ + "LACK OF MENTAL OR PHYSICAL STRENGTH, ENERGY, OR AIR; OR IF YOUR PARENTS CALL YOU TO DINNER;"+CRLF$+CRLF$
    disptext$ = disptext$ + "THEN PLEASE REMEMBER THAT ANY ATTEMPT TO LEAVE OR TERMINATE THE TEST BEFORE IT HAS BEEN COMPLETED WILL"+CRLF$
    disptext$ = disptext$ + "RESULT IN A BLACK MARK ON YOUR TEST, DELETION OF YOUR TEST SCORE, A NEGATIVE REPORT SENT"+CRLF$
    disptext$ = disptext$ + "TO YOUR SUPERVISOR, AND REPOSSESSION OF YOUR VEHICLE."+CRLF$+CRLF$+CRLF$
    disptext$ = disptext$ + "PRESS RETURN TO CONTINUE"
    //REMSTART
    setString( disptext$,0xFF00EEFF,"Courier",14,40 )
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        if escapekey( )=1 then TypingString.curtxt$=TypingString.txt$
        sync
    endwhile
    //REMEND
    cls
    
    introduceStage( curstage )
endfunction

function playStageWords( stage as integer )
    cls
    
    set text font "Arial"
    set text size 48
    
    totalreactions=stage*7
    reactioncount = 0
    
    local aquapx as vec2d
    local sparkpx as vec2d
    local movepx as vec2d
    
    local aqua$ as string
    local spark$ as string
    local move$ as string
    
    local aquac as DWORD
    local sparkc as DWORD
    local movec as DWORD
    
    aqua=-1
    spark=-1
    move=-1
    
    local col as DWORD
    
    while reactioncount <= totalreactions
        cls
        
        if escapekey( )=1 then attemptEscape( )
        
        okay=rnd(200/stage*3)
        
        if okay=1
            r=rnd(255)
            g=rnd(150)+105
            b=rnd(200)+55
            col=rgb(r,g,b)
            x=rnd( screen width( )-500 )
            y=rnd( screen height( )-80 )
            subject=rnd(2)
            select subject
            case 0
                if aqua=-1
                    wrd$=""
                    wd=rnd(4)
                    select wd
                    case 0
                        wrd$="SHARK"
                    endcase
                    case 1
                        wrd$="SALMON"
                    endcase
                    case 2
                        wrd$="TROUT"
                    endcase
                    case 3
                        wrd$="JELLYFISH"
                    endcase
                    case 4
                        wrd$="HAMMERHEAD"
                    endcase
                    endselect
                    aqua$=wrd$
                    aquapx.x#=x
                    aquapx.y#=y
                    aquac=col
                    aqua=timer( )
                endif
            endcase
            case 1
                if spark=-1
                    wrd$=""
                    wd=rnd(4)
                    select wd
                    case 0
                        wrd$="LIGHTBULB"
                    endcase
                    case 1
                        wrd$="RESISTOR"
                    endcase
                    case 2
                        wrd$="VOLTS"
                    endcase
                    case 3
                        wrd$="AMPERE"
                    endcase
                    case 4
                        wrd$="PLUG"
                    endcase
                    endselect
                    spark$=wrd$
                    sparkpx.x#=x
                    sparkpx.y#=y
                    sparkc=col
                    spark=timer( )
                endif
            endcase
            case 2
                if move=-1
                    wrd$=""
                    wd=rnd(4)
                    select wd
                    case 0
                        wrd$="FOOT"
                    endcase
                    case 1
                        wrd$="VOLKSWAGEN"
                    endcase
                    case 2
                        wrd$="SUBWAY"
                    endcase
                    case 3
                        wrd$="AIRCRAFT"
                    endcase
                    case 4
                        wrd$="CARRIER"
                    endcase
                    endselect
                    move$=wrd$
                    movepx.x#=x
                    movepx.y#=y
                    movec=col
                    move=timer( )
                endif
            endcase
            endselect
        endif
        
        if aqua > -1
            ink aquac,0
            text aquapx.x#,aquapx.y#,aqua$
        endif
        if spark > -1
            ink sparkc,0
            text sparkpx.x#,sparkpx.y#,spark$
        endif
        if move > -1
            ink movec,0
            text movepx.x#,movepx.y#,move$
        endif
        
        if keystate(2)=1
            if aqua > -1
                array insert at bottom reacttime()
                reacttime(array count( reacttime() )) = timer( )-aqua
                aqua=-1
                inc reactioncount
            endif
        endif
        if keystate(3)=1
            if spark > -1
                array insert at bottom reacttime()
                reacttime(array count( reacttime() )) = timer( )-spark
                spark=-1
                inc reactioncount
            endif
        endif
        if keystate(4)=1
            if move > -1
                array insert at bottom reacttime()
                reacttime(array count( reacttime() )) = timer( )-move
                move=-1
                inc reactioncount
            endif
        endif
        
        sync
    endwhile
    
    recordReflexes( stage )
    
    inc curstage,1
    introduceStage( curstage )
    
endfunction

function playStageMath( stage as integer )
    cls
    
    set text font "Arial"
    set text size 48
    
    totalreactions=stage*8
    reactioncount = 0
    
    local evenpx as vec2d
    local oddpx as vec2d
    local zeropx as vec2d
    
    local even$ as string
    local odd$ as string
    local zero$ as string
    
    even=-1
    odd=-1
    zero=-1
    
    while reactioncount <= totalreactions
        cls
    
        if escapekey( )=1 then attemptEscape( )
    
        okay=rnd(350/stage)
        
        if okay=1
            x=rnd( screen width( )-500 )
            y=rnd( screen height( )-80 )
            value=rnd(2)
            select value
            case 0
                if even=-1
                    equ$=""
                    eq=rnd(4)
                    select eq
                    case 0
                        equ$="1-5="
                    endcase
                    case 1
                        equ$="8x3="
                    endcase
                    case 2
                        equ$="11-2+1="
                    endcase
                    case 3
                        equ$="6*11="
                    endcase
                    case 4
                        equ$="99-73="
                    endcase
                    endselect
                    evenpx.x#=x
                    evenpx.y#=y
                    even$=equ$
                    even=timer( )
                endif
            endcase
            case 1
                if odd=-1
                    equ$=""
                    eq=rnd(4)
                    select eq
                    case 0
                        equ$="4-7="
                    endcase
                    case 1
                        equ$="17+2="
                    endcase
                    case 2
                        equ$="86-23="
                    endcase
                    case 3
                        equ$="9*17="
                    endcase
                    case 4
                        equ$="11+36-4="
                    endcase
                    endselect
                    oddpx.x#=x
                    oddpx.y#=y
                    odd$=equ$
                    odd=timer( )
                endif
            endcase
            case 2
                if zero=-1
                    equ$=""
                    eq=rnd(4)
                    select eq
                    case 0
                        equ$="4+4-(4x2)="
                    endcase
                    case 1
                        equ$="2x0="
                    endcase
                    case 2
                        equ$="-6-(3-9)="
                    endcase
                    case 3
                        equ$="11x6-33x2="
                    endcase
                    case 4
                        equ$="27-9x3="
                    endcase
                    endselect
                    zeropx.x#=x
                    zeropx.y#=y
                    zero$=equ$
                    zero=timer( )
                endif
            endcase
            endselect
        endif
            
        if even > -1
            ink 0xFFFFFFFF,0
            text evenpx.x#,evenpx.y#,even$
        endif
        if odd > -1
            ink 0xFFFFFFFF,0
            text oddpx.x#,oddpx.y#,odd$
        endif
        if zero > -1
            ink 0xFFFFFFFF,0
            text zeropx.x#,zeropx.y#,zero$
        endif
        
        if keystate(2)=1
            if odd > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-odd
                odd=-1
                inc reactioncount
            endif
        endif
        if keystate(3)=1
            if even > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-even
                even=-1
                inc reactioncount
            endif
        endif
        if keystate(4)=1
            if zero > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-zero
                zero=-1
                inc reactioncount
            endif
        endif
        
        sync
    endwhile
    
    recordReflexes( stage )
    
    inc curstage,1
    introduceStage( curstage )
                
endfunction

function playStageColor( stage as integer )
    cls
    
    set text font "Arial"
    set text size 48
    
    totalreactions=stage*7
    reactioncount = 0
    
    local bluepx as vec2d
    local redpx as vec2d
    local greenpx as vec2d
    local yellowpx as vec2d
    
    local blue$ as string
    local red$ as string
    local green$ as string
    local yellow$ as string
    
    local blues as integer
    local reds as integer
    local greens as integer
    local yellows as integer
    
    blue=-1
    red=-1
    green=-1
    yellow=-1
    
    while reactioncount < totalreactions
        cls
        
        if escapekey( )=1 then attemptEscape( )
        
        kind=rnd(2)
        okay=rnd(100/stage)
        
        if okay=1
        
            select kind
            case 0
                x=rnd( screen width( ) )
                y=rnd( screen height( ) )
                col=rnd(3)
                select col
                case 0
                    if blue=-1
                        bluepx.x#=x
                        bluepx.y#=y
                        blues=0
                        blue=timer( )
                    endif
                endcase
                case 1
                    if red=-1
                        redpx.x#=x
                        redpx.y#=y
                        reds=0
                        red=timer( )
                    endif
                endcase
                case 2
                    if green=-1
                        greenpx.x#=x
                        greenpx.y#=y
                        greens=0
                        green=timer( )
                    endif
                endcase
                case 3
                    if yellow=-1
                        yellowpx.x#=x
                        yellowpx.y#=y
                        yellows=0
                        yellow=timer( )
                    endif
                endcase
                endselect
            endcase
            case 1
                x=rnd( screen width( )-500 )
                y=rnd( screen height( )-80 )
                col=rnd(3)
                select col
                case 0
                    if blue=-1
                        bluepx.x#=x
                        bluepx.y#=y
                        blue$="RED"
                        blues=1
                        blue=timer( )
                    endif
                endcase
                case 1
                    if red=-1
                        redpx.x#=y
                        redpx.y#=y
                        red$="BLACK"
                        reds=1
                        red=timer( )
                    endif
                endcase
                case 2
                    if green=-1
                        greenpx.x#=x
                        greenpx.y#=y
                        green$="YELLOW"
                        greens=1
                        green=timer( )
                    endif
                endcase
                case 3
                    if yellow=-1
                        yellowpx.x#=x
                        yellowpx.y#=y
                        yellow$="BLUE"
                        yellows=1
                        yellow=timer( )
                    endif
                endcase
                endselect
            endcase
            endselect
            
        endif
        
        if blue > -1
            ink 0xFF0000FF,0
            if blues=0 then box bluepx.x#-50,bluepx.y#-50,bluepx.x#+50,bluepx.y#+50
            if blues=1 then text bluepx.x#,bluepx.y#,blue$
        endif
        if red > -1
            ink 0xFFFF0000,0
            if reds=0 then box redpx.x#-50,redpx.y#-50,redpx.x#+50,redpx.y#+50
            if reds=1 then text redpx.x#,redpx.y#,red$
        endif
        if green > -1
            ink 0xFF00FF00,0
            if greens=0 then box greenpx.x#-50,greenpx.y#-50,greenpx.x#+50,greenpx.y#+50
            if greens=1 then text greenpx.x#,greenpx.y#,green$
        endif
        if yellow > -1 
            ink 0xFFFFFF00,0
            if yellows=0 then box yellowpx.x#-50,yellowpx.y#-50,yellowpx.x#+50,yellowpx.y#+50
            if yellows=1 then text yellowpx.x#,yellowpx.y#,yellow$
        endif          
        
        if keystate(2)=1
            if blue > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-blue
                blue=-1
                inc reactioncount
            endif
        endif
        if keystate(3)=1
            if red > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-red
                red=-1
                inc reactioncount
            endif
        endif
        if keystate(4)=1
            if green > -1
                array insert at bottom reacttime( )
                reacttime(array count( reacttime() )) = timer( )-green
                green=-1
                inc reactioncount
            endif
        endif
        
        if yellow > -1
            if timer( )-yellow >= 5500
                yellow=-1
            endif
        endif
        
        
        sync
        
    endwhile
    
    recordReflexes( stage )
    
    inc curstage,1
    introduceStage( curstage )

endfunction

// Functions

function setString( in$ as string, col as DWORD, font$ as string, ptsize as integer, delay as integer )
    TypingString.txt$   = in$
    TypingString.col    = col
    TypingString.font$  = font$
    TypingString.ptsize = ptsize
    TypingString.delay  = delay
    
    TypingString.curtxt$   = ""
endfunction

function writeString( xp as integer, yp as integer )
    if timer( )-TypingString.lstchr >= TypingString.delay
        TypingString.curtxt$ = TypingString.curtxt$ + mid$( TypingString.txt$,len(TypingString.curtxt$)+1 )
        TypingString.lstchr = timer( ) 
    endif
    
    ink TypingString.col,0
    set text font TypingString.font$
    set text size TypingString.ptsize
    
    text xp,yp,TypingString.curtxt$+"_"
endfunction

function introduceStage( stage as integer )

    if stage = 13 then congrats( )
    
    empty array reacttime()

    disp$ = "THIS WILL BE STAGE "+STR$(stage)+" OF YOUR TEST."+CRLF$
    
    dispa$ = ""
    if stage < 5 then dispa$ = "YOU ARE IN SECTION ONE OF THIS TEST: COLORS"+CRLF$+CRLF$
    if stage >= 5 then dispa$ = "YOU ARE IN SECTION TWO OF THIS TEST: MATH"+CRLF$+CRLF$
    if stage >= 9 then dispa$ = "YOU ARE IN SECTION THREE OF THIS TEST: WORDS"+CRLF$+CRLF$
    
    disp$ = disp$ + dispa$
    
    disp$ = disp$ + "AS YOU ASCEND THROUGH ALL 3 SECTIONS OF 4 STAGES OF THIS TEST, THE DIFFICULTY OF EACH STAGE"+CRLF$
    disp$ = disp$ + "WILL INCREASE. THE FIRST FEW STAGES WILL MOVE RATHER SLOWLY,"+CRLF$
    disp$ = disp$ + "WHILE THE HIGHER STAGES WILL DEMAND MORE SPEED."+CRLF$+CRLF$+CRLF$+CRLF$
    disp$ = disp$ + "PRESS RETURN TO BEGIN TEST STAGE "+STR$(stage)
    
    setString( disp$,0xFF00EEFF,"Courier",14,40 )
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        if escapekey( )=1 then TypingString.curtxt$=TypingString.txt$
        sync
    endwhile
    
    cls
    
    setString( "WELCOME TO STAGE "+str$(stage),0xFF00EEFF,"Courier",14,60 )
    
    while TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        sync
    endwhile
    
    waiting=timer( )
    while timer( )-waiting <= 1500
    endwhile
    
    cls
    
    if stage >= 9 then playStageWords( stage )
    if stage >= 5 then playStageMath( stage )
    if stage < 5 then playStageColor( stage )
endfunction

function congrats( )
    disp$ = "CONGRATULATIONS, YOU HAVE FINISHED THE TEST."+CRLF$
    disp$ = disp$ + "YOUR TEST RESULTS HAVE BEEN SAVED AS TEST_"+name$+".TXT IN THE PROGRAM'S ROOT DIRECTORY."+CRLF$+CRLF$
    disp$ = disp$ + "TELL ALL YOUR FRIENDS."+CRLF$+CRLF$+CRLF$
    disp$ = disp$ + "PRESS RETURN TO EXIT"
    
    setString( disp$,0xFF00EEFF,"Courier",14,80 )
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        sync
    endwhile
    
    if file open( 1 )=1 then close file 1
    
    end
endfunction

function recordReflexes( stage as integer )

    open to write 1, "TEST_"+name$+".TXT"
    local average# as float
    
    if stage = 1
        write string 1,"TESTING RESULTS FOR TEST SUBJECT "+name$+CRLF$+CRLF$+CRLF$
        write string 1,"=================================================="
        write string 1,"          TESTING SECTION ONE: COLORS"
        write string 1,"--------------------------------------------------"+CRLF$+CRLF$
    endif
    if stage = 5
        write string 1,"=================================================="
        write string 1,"           TESTING SECTION TWO: MATH"
        write string 1,"--------------------------------------------------"+CRLF$+CRLF$
    endif
    if stage = 9
        write string 1,"=================================================="
        write string 1,"          TESTING SECTION THREE: WORDS"
        write string 1,"--------------------------------------------------"+CRLF$+CRLF$
    endif
    
    write string 1,"TESTING RESULTS FOR "+name$+", STAGE "+str$(stage)+CRLF$
    for i=0 to array count( reacttime() )
        write string 1,str$( reacttime(i) )+" MS"
        average#=average#+reacttime(i)
    next i
    
    average#=average#/array count( reacttime() )
    write string 1,CRLF$+"TESTING AVERAGE FOR STAGE "+str$(stage)+": "+str$(average#)+" MS"+CRLF$+CRLF$+CRLF$
    
endfunction

function attemptEscape( )
    cls
    
    //disp$ = "STAGE TERMINATED..........."+CRLF$
    //disp$ = disp$ + "SELECT AN OPTION"+CRLF$+CRLF$
    //disp$ = disp$ + "1) RESTART STAGE"+CRLF$+"2) QUIT"+CRLF$+"3) HELP"+CRLF$+CRLF$
    //disp$ = disp$ + "PLEASE REMEMBER THAT TEST RESULTS ARE ONLY SAVED FOR COMPLETED STAGES. . ."+CRLF$+CRLF$+">"
    
    disp$ = ".................."+CRLF$
    disp$ = disp$ + "ARE YOU ATTEMPTING TO TERMINATE THE TEST?"+CRLF$+CRLF$
    disp$ = disp$ + "1) NO"+CRLF$+"2) YES"+CRLF$+"3) HELP"+CRLF$+CRLF$
    disp$ = disp$ + "PLEASE REMEMBER THE CONSEQUENCES. . ."+CRLF$+CRLF$+">"
    
    setString( disp$,0xFF00EEFF,"Courier",14,85 )
    
    local response$ as string
    clear entry buffer
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        response$=entry$( 1 )
        text 13,132, response$
        sync
    endwhile
    
    select response$
    case "2"
        confirmEscape( )
    endcase
    case "1"
        introduceStage( curstage )
    endcase
    case "3"
        quoteInstructions( )
    endcase
    case default
        attemptEscape( )
    endcase
    endselect
    
    introduceStage( curstage )
    
endfunction

function confirmEscape( )
    cls
    
    setString( "GOODBYE...",0xFF00EEFF,"Courier",14,100 )
    
    while TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        sync
    endwhile
    
    waiting=timer( )
    while timer( )-waiting < 1500
    endwhile
    //REMSTART
    if file open( 1 ) then close file 1
    if file exist( "TEST_"+name$+".TXT" )=1 then delete file "TEST_"+name$+".TXT"
    open to write 1, "TEST_"+name$+".TXT"
    write string 1,"TESTING SUBJECT "+name$+" QUIT THE TEST PREMATURELY."
    write string 1,"HIS/HER TESTING SCORE HAS BEEN ERASED."+CRLF$+CRLF$
    write string 1,"I WASN'T LYING WHEN I SAID THERE WOULD BE CONSEQUENCES. . ."
    close file 1
    //REMEND
    end
endfunction

function quoteInstructions( )
    cls
    
    disptext$ = "THIS TEST IS DESIGNED TO RECORD YOUR REFLEXES BASED ON"+CRLF$+"THE AMOUNT OF TIME YOU TAKE TO RESPOND TO EACH OF THE STIMULI . . ."+CRLF$+CRLF$+CRLF$
    disptext$ = disptext$ + "TO COMPLETE THE TEST, YOU MUST RESPOND TO EACH OF THE STIMULI IN EACH OF THE THREE SECTIONS"+CRLF$+"ACCORDING TO THE FOLLOWING KEYS:"+CRLF$+CRLF$
    disptext$ = disptext$ + "SECTION ONE WILL CONSIST OF COLOR RECOGNITION TESTS. YOU MUST RESPOND TO EACH COLOR ACCORDING TO THIS KEY:"+CRLF$+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN AREA OF THE SCREEN COLORED BLUE, PRESS 1"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN AREA OF THE SCREEN COLORED RED, PRESS 2"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN AREA OF THE SCREEN COLORED GREEN, PRESS 3"+CRLF$+CRLF$
    disptext$ = disptext$ + "SECTION TWO WILL CONSIST OF SIMPLE MATHEMATICAL PROBLEMS"+CRLF$+"WHICH YOU MUST RESPOND TO ACCORDING TO THIS KEY:"+CRLF$+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN EQUATION WHOSE SUM, DIFFERENCE, OR PRODUCT IS AN ODD NUMBER, PRESS 1"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN EQUATION WHOSE SUM, DIFFERENCE, OR PRODUCT IS AN EVEN NUMBER, PRESS 2"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE AN EQUATION WHOSE SUM, DIFFERENCE, OR PRODUCT IS ZERO, PRESS 3"+CRLF$+CRLF$
    disptext$ = disptext$ + "THE FINAL SECTION OF THIS TEST WILL FOCUS ON WORD RECOGNITION. YOU MUST RESPOND"+CRLF$+"TO THE WORDS ACCORDING TO THIS KEY:"+CRLF$+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE ANY WORD HAVING TO DO WITH AQUADIC LIFE, PRESS 1"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE ANY WORD HAVING TO DO WITH ELECTRICITY, PRESS 2"+CRLF$
    disptext$ = disptext$ + "WHEN YOU SEE ANY WORD HAVING TO DO WITH TRANSPORTATION, PRESS 3"+CRLF$+CRLF$+CRLF$
    disptext$ = disptext$ + "PRESS RETURN TO CONTINUE"
    
    setString( disptext$,0xFF00EEFF,"Courier",14,40 )
    
    while returnkey( )=0 or TypingString.curtxt$<>TypingString.txt$
        cls
        writeString( 5,5 )
        if escapekey( )=1 then TypingString.curtxt$=TypingString.txt$
        sync
    endwhile    
endfunction

//Initialization Code

initialize_memory:
    type vec2d
        x# as float
        y# as float
    endtype
    
    type typestring
        col as DWORD
        txt$ as string
        font$ as string
        ptsize as integer
        curtxt$ as string
        delay as integer
        lstchr as integer
    endtype
    
    global dim reacttime(0) as integer
    
    global TypingString as typestring
    
    global CRLF$ as string
    global curstage as integer
    CRLF$ = chr$(0x0D)+chr$(0x0A)
    curstage = 1
    
    return

a grid of lamps, if you click one it and the directly nearby lights change between on/off, aim is to turn off all lamps.

// Start of code //
Set Window on
Set Window Layout 0,0,0
Set Window size 400,420
Set Display Mode 400,420,16
Sync On : Sync Rate 60

#constant cLast 3

Set Text Font "Arial"
Set Text To Bold 
set image colorkey 255,0,255

global iOn as integer : iOn=lamp_img(1)
global iOff as integer : iOff=lamp_img(0)
global Level : Level=1
global click
global space

dim field(4,4) as boolean

global Lstart as integer

load_level(1)

do : cls
	handle_lamps()
	draw_lamps()
	sync
sync : loop

function lamp_img(On as boolean)
	cls rgb(255,0,255)
	if On
		r#=135.0 : g#=135.0 : b#=105.0
	else
		r#=100.0 : g#=100.0 : b#=100.0
	endif
	
	for r=300 to 0 step -1
		ink rgb(r#,g#,b#),0
		circle 40,40,r/10.0
		circle 41,40,r/10.0
		circle 41,41,r/10.0
		circle 40,41,r/10.0
		if On then inc r#,0.5*(r#<255) : inc g#,0.4*(g#<255) : inc b#,0.3*(b#<255)
		if not On then  inc r#,0.3*(r#<255) : inc g#,0.3*(g#<255) : inc b#,0.3*(b#<255)
	next r
	num=free_image()
	get image num,0,0,80,80,1
	cls
endfunction num

function load_level(num as integer)
	select num
		case 1 : restore level1 : endcase
		case 2 : restore level2 : endcase
		case 3 : restore level3 : endcase
	endselect
	for x=0 to 4
		for y=0 to 4
			read a
			field(x,y)=a
		next y
	next x
	
	Lstart=timer()/1000
	
	repeat : until mouseclick()=0 and scancode()=0
	repeat
	click=1
	space=1
	draw_lamps()
	ink rgb(220,220,250),0
	Set Text size 26
	Center Text 200,200,"Level "+str$(num)
	ink rgb(0,0,0),0
	Set Text size 24
	Center Text 200,200,"Level "+str$(num)
	ink rgb(220,220,250),0
	Set Text size 26
	Center Text 200,230,"[press any key]"
	ink rgb(0,0,0),0
	Set Text size 24
	Center Text 200,230,"[press any key]"
	sync : sync
	until mouseclick()>0 or scancode()>0
	
endfunction

function handle_lamps()
	
	//change on click
	for x=0 to 4
		for y=0 to 4
			if sqrt((mousex()-(x*80+40))^2+(mousey()-(y*80+40))^2)< 30 and mouseclick()&&1>0 and click=0
				field(x,y)=abs(int(field(x,y))-1)
				if x-1>=0 then field(x-1,y)=abs(int(field(x-1,y))-1)
				if y-1>=0 then field(x,y-1)=abs(int(field(x,y-1))-1)
				if x+1<=4 then field(x+1,y)=abs(int(field(x+1,y))-1)
				if y+1<=4 then field(x,y+1)=abs(int(field(x,y+1))-1)
			endif
		next y
	next x
	
	click=mouseclick()&&1
	
	//check if won
	win=1
	for x=0 to 4
		for y=0 to 4
			if field(x,y)=1 then win=0
		next y
	next x
	
	if win and Level=cLast then Exit Prompt "You won the game!","Winner" : end
	if win then inc Level : load_level(Level) : exitfunction
	
	if space=0 and spacekey() then load_level(Level)
	
	space=spacekey()
	
endfunction

function draw_lamps()

	// draw lamps
	box 0,0,400,400,rgb(220,220,220),rgb(200,200,220),rgb(170,170,170),rgb(110,110,150)
	for x=0 to 4
		for y=0 to 4
			img=iOn*(field(x,y)=1)+iOff*(field(x,y)=0)
			paste image img,80*x,80*y,1
		next y
	next x
	
	//draw info-bar
	box 0,400,400,402,rgb(22,22,22),rgb(20,20,22),rgb(17,17,17),rgb(11,11,15)
	box 0,402,400,420,rgb(220,220,220),rgb(200,200,220),rgb(170,170,170),rgb(110,110,150)
	set text size 18
	ink rgb(240,240,255),0
	text 5,402,"    Level: "+str$(Level)+"/"+str$(cLast)+"    Level-time: "+str$((timer()/1000)-Lstart)+"s    [Space] to reset"
	set text size 17
	ink rgb(10,10,15),0
	text 6,403,"    Level: "+str$(Level)+"/"+str$(cLast)+"    Level-time: "+str$((timer()/1000)-Lstart)+"s    [Space] to reset"
endfunction

function free_image()
	x=0 : repeat : inc x : until image exist(x)=0
endfunction x

level1:
data 1,1,0,1,1
data 1,0,1,0,1
data 0,1,1,1,0
data 1,0,1,0,1
data 1,1,0,1,1

level2:
data 0,1,0,1,0
data 1,1,0,1,1
data 0,0,0,0,0
data 1,1,0,1,1
data 0,1,0,1,0

level3:
data 0,1,0,0,0
data 1,0,1,1,0
data 1,0,0,0,1
data 0,1,1,0,1
data 0,0,0,1,0
// End of Code //

set display mode 1024,768,screen depth()
sync on : sync rate 0
randomize timer()
set text font "arial"
set text size 20

type Peg
    Filled as boolean
    XPos as integer
    YPos as integer
    Move1Rw as Integer
    Move1Cl as Integer
    Move2Rw as Integer
    Move2Cl as Integer
    Move3Rw as Integer
    Move3Cl as Integer
    Move4Rw as Integer
    Move4Cl as Integer
    Move5Rw as Integer
    Move5Cl as Integer
    Move6Rw as Integer
    Move6Cl as Integer
    Distance as Float
    Noticed as Boolean
    Active as Boolean
endtype

DIM GameOverTexts$(8)
GameOverTexts$(8)="Very nice!  You have incredible logic skills!"
GameOverTexts$(6)="That was horrible.  Try again."
GameOverTexts$(5)="Very nice! You have excellent logic skills!"
GameOverTexts$(4)="Your logic skills need a lot of improvement."
GameOverTexts$(3)="Your logic skills are just so-so."
GameOverTexts$(2)="Not bad at all!  You have great logic."
GameOverTexts$(1)="Winner! Your logic is excellent!"

global SelectedX as integer
global SelectedY as integer
global clicked as boolean
global debug as boolean
global gameover as boolean

DIM Pegs(5,5) as Peg
SetupPegs(600,screen width()/2,screen height()/2)

cls
GetScreen(600)
Reset()

`===================================================
`======= MAIN LOOOOOOOOOOOOOOOOOOOOOOOOP!!! ========

do

cls
paste image 1,0,0

DrawTriangle(10)
PrintInstructions(10,500)
CheckClicks(10)

if gameover=1
    text 700,500,"GAME OVER"
    text 700,580,"Press spacebar to play again!"
    text 700,540,GameOverTexts$(PegsLeft())
endif

if spacekey()=1 and pressed=0
    pressed=1
    Reset()
endif
if spacekey()=0 then pressed=0

sync

loop

`=======                                     =======
`===================================================


function MovesAvailable(j,c)


    if Pegs(j,c).Move1Rw>0 and Pegs(j,c).Move1Cl>0 and c<4
        if Pegs(j,c+1).Filled=1
            if Pegs(j,c+2).Filled=0
                inc MovesAv
            endif
        endif
    endif
    if Pegs(j,c).Move2Rw>0 and Pegs(j,c).Move2Cl>0 and c>2
        if Pegs(j,c-1).Filled=1
            if Pegs(j,c-2).Filled=0
                inc MovesAv
            endif
        endif
    endif
    if Pegs(j,c).Move3Rw>0 and Pegs(j,c).Move3Cl>0 and j>2
        if Pegs(j-1,c).Filled=1
            if Pegs(j-2,c).Filled=0
                inc MovesAv
            endif
        endif
    endif
    if Pegs(j,c).Move4Rw>0 and Pegs(j,c).Move4Cl>0 and j<4
        if Pegs(j+1,c).Filled=1
            if Pegs(j+2,c).Filled=0
                inc MovesAv
            endif
        endif
    endif
    if Pegs(j,c).Move5Rw>0 and Pegs(j,c).Move5Cl>0 and c<4 and j>2
        if Pegs(j-1,c+1).Filled=1
            if Pegs(j-2,c+2).Filled=0
                inc MovesAv
            endif
        endif
    endif
    if Pegs(j,c).Move6Rw>0 and Pegs(j,c).Move6Cl>0 and j<4 and c>2
        if Pegs(j+1,c-1).Filled=1
            if Pegs(j+2,c-2).Filled=0
                inc MovesAv
            endif
        endif
    endif

endfunction MovesAv


function PegsLeft()

for j=1 to 5
    for c=1 to (6-j)
        if Pegs(j,c).Filled=1 then inc NumPegs
    next c
next j

endfunction NumPegs


function DrawTriangle(CircleRadius)

gmoverimminent=1

for j=1 to 5
    for c=1 to (6-j)
        if Pegs(j,c).Filled=1
            paste sprite 1,Pegs(j,c).XPos,Pegs(j,c).YPos
            if MovesAvailable(j,c)>0 then gmoverimminent=0
            else
            if Pegs(j,c).Noticed=0
                ink rgb(255,255,255),0
                circle Pegs(j,c).XPos,Pegs(j,c).YPos,CircleRadius
                else
                ink rgb(220,20,20),0
                circle Pegs(j,c).XPos,Pegs(j,c).YPos,CircleRadius
                circle Pegs(j,c).XPos,Pegs(j,c).YPos,CircleRadius-3
            endif
        endif
    next c
next j
if SelectedX>0 and SelectedY>0
    ink rgb(20,220,20),0
    circle Pegs(SelectedX,SelectedY).XPos,Pegs(SelectedX,SelectedY).YPos,CircleRadius+4
    ink rgb(255,255,255),0
endif

if gmoverimminent=1 then gameover=1

endfunction


function PrintInstructions(XPos,YPos)

text XPos+20,YPos+180,"FPS: "+str$(screen fps())

endfunction


function CheckClicks(Radius)

for j=1 to 5
    for c=1 to (6-j)
        Pegs(j,c).Distance=SQRT((Pegs(j,c).XPos-mousex())^2+(Pegs(j,c).YPos-mousey())^2)
        if mouseclick()=1 and clicked=0
            if Pegs(j,c).Distance=<10
                erase=0
                clicked=1
                if SelectedX=0 or SelectedY=0
                    if Pegs(j,c).Filled=1
                        EraseNoticed()
                        SelectedX=j
                        SelectedY=c
                        Pegs(Pegs(j,c).Move1Rw,Pegs(j,c).Move1Cl).Noticed=1
                        Pegs(Pegs(j,c).Move2Rw,Pegs(j,c).Move2Cl).Noticed=1
                        Pegs(Pegs(j,c).Move3Rw,Pegs(j,c).Move3Cl).Noticed=1
                        Pegs(Pegs(j,c).Move4Rw,Pegs(j,c).Move4Cl).Noticed=1
                        Pegs(Pegs(j,c).Move5Rw,Pegs(j,c).Move5Cl).Noticed=1
                        Pegs(Pegs(j,c).Move6Rw,Pegs(j,c).Move6Cl).Noticed=1
                    endif
                    else
                    if Pegs(j,c).Noticed=1 and Pegs(j,c).Filled=0
                        debug=1
                        if j>SelectedX then pegX=SelectedX+1
                        if j<SelectedX then pegX=SelectedX-1
                        if j=SelectedX then pegX=SelectedX
                        if c>SelectedY then pegy=SelectedY+1
                        if c<SelectedY then pegy=SelectedY-1
                        if c=SelectedY then pegy=SelectedY
                        if Pegs(pegx,pegy).Filled=1
                            Pegs(j,c).Filled=1
                            Pegs(SelectedX,SelectedY).Filled=0
                            Pegs(pegx,pegy).Filled=0
                            EraseNoticed()
                        endif
                    endif
                endif
            endif
        endif
        if mouseclick()=0 then clicked=0
    next c
next j

if mouseclick()=2 then EraseNoticed()

endfunction


function Reset()
for c=1 to 5
    for j=1 to 5
        Pegs(c,j).Filled=1
    next j
next c
gameover=0

EraseNoticed()

pegrow=rnd(4)+1
pegcolumn=rnd(5-pegrow)+1

Pegs(pegrow,pegcolumn).Filled=0

endfunction


function SetupPegs(Side,CenterX,CenterY)

Height=Side/2*SQRT(3)
Corner1X=CenterX-Side/2
offsetx=Side/7

for j=1 to 5
    pegspotx=Corner1X
    pegspoty=(j*Height)/7+(CenterY-Height/2)
    for i=1 to j
        inc pegspotx,offsetx/2
    next i
    for c=1 to (6-j)
        inc pegspotx,offsetx
        Pegs(j,c).XPos=pegspotx
        Pegs(j,c).YPos=pegspoty
    next c
next j

for j=1 to 5
    for c=1 to (6-j)
        if c+2<6
            Pegs(j,c).Move1Rw=j
            Pegs(j,c).Move1Cl=c+2
        endif
        if c-2>0
            Pegs(j,c).Move2Rw=j
            Pegs(j,c).Move2Cl=c-2
        endif
        if j-2>0
            Pegs(j,c).Move3Rw=j-2
            Pegs(j,c).Move3Cl=c
        endif
        if j+2<6
            Pegs(j,c).Move4Rw=j+2
            Pegs(j,c).Move4Cl=c
        endif
        if j-2>0 and c+2<6
            Pegs(j,c).Move5Rw=j-2
            Pegs(j,c).Move5Cl=c+2
        endif
        if j+2<6 and c-2>0
            Pegs(j,c).Move6Rw=j+2
            Pegs(j,c).Move6Cl=c-2
        endif
        Pegs(j,c).Active=1
    next c
next j

endfunction


function EraseNoticed()
for j=1 to 5
    for c=1 to (6-j)
        Pegs(j,c).Noticed=0
    next c
next c
SelectedX=0
SelectedY=0
endfunction


function GetScreen(Side)

XPos=10
YPos=400

CenterX=screen width()/2
CenterY=screen height()/2

Height=Side/2*SQRT(3)

Corner1X=CenterX-Side/2
Corner2X=CenterX+Side/2
Corner3X=CenterX

Corner1Y=CenterY-Height/2
Corner2Y=CenterY-Height/2
Corner3Y=CenterY+Height/2

line Corner1X,Corner1Y,Corner2X,Corner2Y
line Corner1X,Corner1Y,Corner3X,Corner3Y
line Corner2X,Corner2Y,Corner3X,Corner3Y

ink rgb(0,0,255),0
for c=1 to 5
    line Pegs(1,c).XPos,Pegs(1,c).YPos,Pegs(c,1).XPos,Pegs(c,1).YPos
    line Pegs(1,c).XPos,Pegs(1,c).YPos,Pegs((6-c),c).XPos,Pegs((6-c),c).YPos
    line Pegs(c,1).XPos,Pegs(c,1).YPos,Pegs(c,(6-c)).XPos,Pegs(c,(6-c)).YPos
next c

ink rgb(255,255,255),0

center text screen width()/2,20,"'The Original IQ Tester'"
center text screen width()/2,40,"(Based on a board game by Venture Manufacturing)"

text XPos,YPos,"Directions:"
text XPos+10,YPos+20,"These holes contain pegs.  Click a peg to"
text XPos+10,YPos+40,"select it.  Right-click to unselect."
text XPos+10,YPos+60,"Remove a peg from the board by jumping over it"
text Xpos+10,YPos+80,"   with another peg along the marked blue lines."
text XPos+10,YPos+110,"Press spacebar to reset the board."
text XPos+10,YPos+140,"The less pegs left at the end, the smarter you are."
text XPos+10,YPos+160,"If you have 8 pegs left and no jumps available, you're"
text XPos+10,YPos+180,"   a genius!"
text XPos+10,YPos+210,"A green circle shows the peg you have selected."
text XPos+10,YPos+230,"Red circles show possible moves."

get image 1,0,0,screen width(),screen height(),1

for f=1 to 10
    circle 10,10,f
next f
get image 2,0,0,21,21,1
sprite 1,-20,-20,2
offset sprite 1,sprite width(1)/2,sprite height(1)/2

endfunction

REM Project: NumberZ
REM Created: 4/26/2008 8:45:23 PM
REM
REM ***** Main Source File *****
REM
set text size 50
center text screen width()/2,100,"NUMBERZ"
set text size 30
center text screen width()/2,155,"by flashing_snall"

set text size 20
text 20,200,"The goal of this game is to reach a certain number 1-50."
text 20,220,"You are presented with 6 numbers. the number in the middle"
text 20,240,"is the number you must reach. The 5 surrounding numbers"
text 20,260,"are the numbers you can work with. You can add/subtract them"
text 20,280,"from eachother. To add, left click, and to subtract, right click."
text 20,300,"Your current number value is shown at the top left of the screen."
text 20,320,"If you dont think you can get to the number with the 5 you have,"
text 20,340,"click the impossible key. If you get it right, you get a point."
text 20,360,"If you mess up, you can press return to reset the problem. IF you "
text 20,380,"hit impossible when it is possible, you loose all your points."
text 20,400,"Your score is displayed below your current number value. "
text 20,420,"EXAMPLE:"
text 20,440,"center num=5. Surrounding numbers equal 1,2,1,6,40"
text 20,460,"0+6=6 | 6-1=5 | 5=5 | you win!!!"
text 20,500,"press any key to play     press anykey to play. good luck :)"
wait key

dim blocknum(11)
dim addnum(6)
dim numused(7)

box 0,0,50,50
get image 1,0,0,50,50,1

CLS

for c=1 to 120
 ellipse 120,120,c,c
next c
get image 2,0,0,240,240

CLS

word$="IMPOSSIBLE"
set text size 40
text 0,0,word$
get image 3,0,0,text width(word$),text height(word$),1


set text size 90
for n=1 to 50
 CLS
 num$=str$(n)
 text 0,0,num$
 get image n+99,0,0,text width(num$),text height(num$)
next n

set text size 50
for n=1 to 50
 CLS
 num$=str$(n)
 text 0,0,num$
 get image n+149,0,0,text width(num$),text height(num$)
next n
ink rgb(255,255,255),1
box 0,0,screen width()/5,screen height()-20
get image 200,0,0,screen width()/2,screen height()-20
color backdrop rgb(0,0,0)

box 0,0,400,300
ink rgb(5,1,1),0
set text size 20
text 20,10,"YOU WIN!"
text 20,50,"Press any key to go to next level!"
get image 250,0,0,400,300,1
CLS
ink rgb(255,255,255),0
box 0,0,400,300
ink rgb(5,1,1),0
set text size 20
text 20,10,"YOU LOOSE!"
text 20,50,"Press any key to reset!"
get image 251,0,0,400,300,1
CLS
finalnum=rnd(50)
addnum=0
for b=2 to 6
 blocknum(b)=rnd(49)+1
next b

time=1000
do
ink rgb(255,255,255),1

REM VISUAL BASIC
sprite 1,screen width()/2,screen height()/2,2
offset sprite 1,sprite width(1)/2,sprite height(1)/2

for b=2 to 6
 sprite b,screen width()/2,screen height()/2,1
 offset sprite b,sprite width(b)/2,sprite height(b)/2
 rotate sprite b,72*b
 move sprite b,150

 sprite b+6,sprite x(b),sprite y(b),blocknum(b)+149
 set sprite diffuse b+6,255,0,0
 offset sprite b+6,sprite width(b+6)/2,sprite height(b+6)/2
next b

sprite 7,screen width()/2,screen height()-(text height(word$)*1.5),3
offset sprite 7,sprite width(7)/2,sprite height(7)/2

sprite 100,screen width()/2,screen height()/2,finalnum+99
set sprite diffuse 100,255,0,0
offset sprite 100,sprite width(100)/2,sprite height(100)/2


REM INTERFACE
if mouseclick()>0 and timer()>mouseclicktime
 c=0
 for s=2 to 7
 c=xyhit(mousex(),mousey(),s)
  if c=1 and numused(s)=0
   if mouseclick()=1
    if sprite exist(s+6)=1
     addnum(s)=blocknum(s)
     addnum=addnum(s)+addnum
     set sprite diffuse s,255,128,64
     set sprite diffuse s+6,64,128,255
     numused(s)=1
    endif
    if s=7
     if possible=0
      win=1
      else
      loose=1
     endif
     set sprite diffuse s,255,0,0
    endif
   endif
   if mouseclick()=2
    if sprite exist(s+6)=1
     addnum(s)=blocknum(s)
     addnum=addnum-addnum(s)
     set sprite diffuse s,64,128,255
     set sprite diffuse s+6,255,128,64
     numused(s)=1
    endif
   endif
  endif
 next s
mouseclicktime=timer()+200
endif

`BEHIND DA SCENES
if addnum=finalnum OR win=1
 sprite 250,screen width()/2,screen height()/2,250
 offset sprite 250,200,150
 set sprite diffuse 250,100,100,100
 suspend for key
 delete sprite 250
 finalnum=rnd(50)
 addnum=0
 possible=0
 addnum=0
 usernotpossible=0
 win=0
 loose=0
 inc score
 for b=2 to 6
  blocknum(b)=rnd(49)+1
 next b
 for s=2 to 7
  set sprite diffuse s,255,255,255
 next s
endif

if loose=1
 sprite 251,screen width()/2,screen height()/2,251
 offset sprite 251,200,150
 set sprite diffuse 251,100,100,100
 suspend for key
 delete sprite 251
 finalnum=rnd(50)
 addnum=0
 possible=0
 addnum=0
 usernotpossible=0
 win=0
 loose=0
 score=0
 for b=2 to 6
  blocknum(b)=rnd(49)+1
 next b
 for s=2 to 7
  set sprite diffuse s,255,255,255
  numused(s)=0
 next s
endif


for c=2 to 6
blocknum(7) = blocknum(2)
blocknum(8) = blocknum(3)
blocknum(9) = blocknum(4)
blocknum(10) = blocknum(5)
blocknum(11) = blocknum(6)

blocknum(2) = blocknum(8)
blocknum(3) = blocknum(9)
blocknum(4) = blocknum(10)
blocknum(5) = blocknum(11)
blocknum(6) = blocknum(7)

for c1=-1 to 1
 for c2=-1 to 1
  for c3=-1 to 1
   for c4=-1 to 1
    for c5=-1 to 1
    if (c1*blocknum(2))+(c2*blocknum(3))+(c3*blocknum(4))+(c4*blocknum(5))+(c5*blocknum(6))=finalnum
     possible=1
    endif
    next c5
   next c4
  next c3
 next c2
next c1
next c

text 0,0,"CURRENT VALUE="+str$(addnum)
`text 0,50,str$(possible)
text 0,100,"SCORE:"+str$(score)
if returnkey()=1
addnum=0
usernotpossible=0
for s=2 to 7
set sprite diffuse s,255,255,255
numused(s)=0
next s
endif

loop


Function xyhit(x,y,s)
coll=0
if x<sprite x(s)+sprite width(s)/2 and x>sprite x(s)-sprite width(s)/2
if y>sprite y(s)-sprite height(s)/2 and y<sprite y(s)+sprite height(s)/2
exitfunction 1
endif
endif
endfunction 0

Red flames

bmaczero

// 3D explosion
// By Jeff Huijsmans

Sync on
Sync rate 30
Autocam off
Backdrop on
Color backdrop RGB(100, 100, 255)

// Generate media
// Yellow color
box 0,0,1,1,RGB(255,255,0),RGB(255,255,0),RGB(255,255,0),RGB(255,255,0)
get image 1, 0, 0, 1, 1
cls

// Rainbow shade color
box 0,0,100,100,RGB(255,155,0), RGB(155,255,0), RGB(255,55,0), RGB(255,55,0)
get image 2, 0, 0, 100, 100
cls

// Smoke
// Make a new bitmap to paint on
create bitmap 5,50,50
// Set the color of the smoke
ink rgb(250,200,100),0
// Make dots
for x=1 to 1000
   angle = rnd(360)
   radius = rnd(20)
   
   dot 25 + sin(angle) * radius, 25 + cos(angle) * radius
next x
// Blur dots
blur bitmap 5,4
// Grab the image and put it in "3"
get image 3, 0, 0, 50, 50
// Get rid of the bitmap.
delete bitmap 5


// Make sphere
make object sphere 1, 1
// Texture it with yellow colour
texture object 1, 1
// Move camera slightly backwards
position camera 0, 200, -200
point camera object position x(1), object position y(1), object position z(1)
// Make sphere transparent
ghost object on 1
// Rainbowshade it with previous generated media
`set rainbow shading on 1, 

// Make plain for floor
make object plain 2, 500, 500
// Scale it
scale object 2, 400, 400, 400
// Make it almost white
color object 2, RGB(200, 200, 200)
// Position it lower
position object 2, 0, -25, 0
// Rotate it
rotate object 2, 90, 0, 0

// Make particles (Bomb)
make particles 1, 2, 100, 2.5
// Set parameters (Bomb)
set particle emissions 1, 0
set particle velocity 1, 20
set particle gravity 1, 5
set particle speed 1, 0.01
set particle life 1, 500
set particle chaos 1, 20
ghost particles on 1, 3

// Make particles (Smoke)
make particles 2, 3, 100, 50
// Set parameters (Smoke)
set particle emissions 2, 0
set particle velocity 2, 2
set particle gravity 2, 0
set particle speed 2, 0.05
set particle life 2, 100
ghost particles on 2, 3

center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : sync : cls
center text screen width()/2, screen height()/2, "Press any key to ignite the bomb..." : sync : wait key : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 2..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 1..." : sync : wait 1000 : cls


scale# = 1
xx#    = 1
for x = 0 to 600 step 1
	position camera camera position x(), camera position y(), camera position z()-(xx#*1.05)
	rotate camera 0, 0, 0
	point camera object position x(1), object position y(1), object position z(1)
	scale# = scale# * 1.1
	if x < 10
		scale# = scale# * 1.1
		scale# = scale# * 1.1
		scale# = scale# * 1.1
	endif
	
	if x > 10 and x < 20
		set particle emissions 1, 50
		rotate camera camera angle x()-(3+rnd(6)), camera angle y()-(3+rnd(6)), camera angle z()-(3+rnd(6))
	endif
	
	if x > 20 and x < 40
		set particle emissions 1, 100
		rotate camera camera angle x()-(2+rnd(4)), camera angle y()-(2+rnd(4)), camera angle z()-(2+rnd(4))
	endif
	
	if x > 40 and x < 100
		set particle emissions 1, 0
		set particle emissions 2, 25
		rotate camera camera angle x()-(1+rnd(2)), camera angle y()-(1+rnd(2)), camera angle z()-(1+rnd(2))
	endif 
	
	if x > 100 and x < 150
		rotate camera camera angle x()-(0.5+rnd(1)), camera angle y()-(0.5+rnd(1)), camera angle z()-(0.5+rnd(1))
	endif
	
	if x > 150
		set camera to follow 0, 10, 0, 0, 50, 0, 50.0, 0
	endif
	
	if x > 130
		set particle emissions 2, 0
	endif
	
	scale object 1, scale#, scale#, scale#
	
	// Debugging
	set cursor 0, 0
	print "X = " + str$(x)
	
	sync
next x

end

Rem ***** Main Source File *****
Autocam Off

REM TYPES
Type vectors
   x As Float
   y As Float
   z As Float
endType

Type particleProperties
   pos As vectors
   ang As vectors
   vel As vectors
   size As vectors
endType

Type colorProperties
   r As Float
   g As Float
   b As Float
endType

Type explosionParticle
   num  As Integer
   prop As particleProperties
   fade As Float
   diff As colorProperties
endType

REM SET MAXIMUM DIMS
GLOBAL DIM explode(10, 200) As explosionParticle

imgSmoke = createSmoke(255, 255, 255, 64)

REM MAIN LOOP
Sync Rate 34 : Sync On
DO
REM MOVE CAMERA
ax# = wrapvalue(ax# + mousemovey())
ay# = wrapvalue(ay# + mousemovex())
rotate camera ax#, ay#, 0.0
if mouseclick()=1 then move camera 1
if mouseclick()=2 then move camera -1

   exp1 = particleExplosion(1, 50, 0, 2, 50, exp1, imgSmoke)

REM INFO
set cursor 0, 0
print "USE MOUSE TO MOVE AROUND"

Sync
Loop

Function particleExplosion(n As Integer, amount As Integer, x As Float, y As Float, z As Float, ctr As Integer, img As Integer)
If explode(n, 0).num = 0
   obj = freeObject()
   For f = obj To obj + amount
      i = f-obj
      explode(n, i).num          = f
      explode(n, i).prop.pos.x   = x
      explode(n, i).prop.pos.y   = y
      explode(n, i).prop.pos.z   = z
      explode(n, i).prop.size.x  = 2.0
      explode(n, i).prop.size.y  = 2.0
      explode(n, i).prop.size.z  = 2.0
      explode(n, i).prop.ang.x   = 0.0
      explode(n, i).prop.ang.y   = 0.0
      explode(n, i).prop.ang.z   = 0.0
         Make Object Sphere explode(n, i).num, explode(n, i).prop.size.x, 8, 8 `explode(n, i).prop.size.y
         Texture Object explode(n, i).num, img
         Hide Object explode(n, i).num
            Set Object Cull explode(n, i).num, 1
            Set Object Fog explode(n, i).num, 0
            `Set Object Light explode(n, i).num, 0
            Ghost Object On explode(n, i).num, 2
            Set Object Transparency explode(n, i).num, 3
            Disable Object Zwrite explode(n, i).num
            `Set Alpha Mapping On explode(n, i).num, 50
   Next f
EndIf

   For f = 0 To amount
      explode(n, f).prop.size.x = explode(n, f).prop.size.x + 10.0
      explode(n, f).prop.size.y = explode(n, f).prop.size.y + 10.0
      explode(n, f).prop.size.z = explode(n, f).prop.size.z + 10.0
      explode(n, f).prop.pos.x  = explode(n, f).prop.pos.x + explode(n, f).prop.vel.x
      explode(n, f).prop.pos.y  = explode(n, f).prop.pos.y + explode(n, f).prop.vel.y
      explode(n, f).prop.pos.z  = explode(n, f).prop.pos.z + explode(n, f).prop.vel.z
         `Fade particle value
         explode(n, f).fade = explode(n, f).fade - 1
         `Diffuse Alter
         If explode(n, f).diff.r =< 250 Then explode(n, f).diff.r = explode(n, f).diff.r + 0.8
         If explode(n, f).diff.g =< 250 Then explode(n, f).diff.g = explode(n, f).diff.g + 0.4
         explode(n, f).diff.b = explode(n, f).diff.b
            `Position, scale and fade particle object
            Position Object explode(n, f).num, explode(n, f).prop.pos.x, explode(n, f).prop.pos.y, explode(n, f).prop.pos.z
            Scale Object explode(n, f).num, explode(n, f).prop.size.x, explode(n, f).prop.size.y, 100
            Set Object Diffuse explode(n, f).num, Rgb(explode(n, f).diff.r, explode(n, f).diff.g, explode(n, f).diff.b)
            `Fade Object explode(n, f).num, explode(n, f).fade
            `Point at camera
            Set Object To Camera Orientation explode(n, f).num
   Next f

   For f = 0 To amount
      If explode(n, f).fade =< 0
         `Position
         explode(n, f).prop.pos.x = x
         explode(n, f).prop.pos.y = y
         explode(n, f).prop.pos.z = z
         `Scale
         explode(n, f).prop.size.x = 1
         explode(n, f).prop.size.y = 1
         explode(n, f).prop.size.z = 1
         `Velocity (randomize)
         explode(n, f).prop.vel.x = Rnd(100) / 500.0 - 0.1
         explode(n, f).prop.vel.y = Rnd(100) / 500.0 - 0.1
         explode(n, f).prop.vel.z = Rnd(100) / 500.0 - 0.1
         `Fade
         explode(n, f).fade = 200
         `Color
         explode(n, f).diff.r = 50
         explode(n, f).diff.g = 50
         explode(n, f).diff.b = 0
         `Show the particle
         Show Object explode(n, f).num
      endif
   next f

endFunction ctr


Function createSmoke(r As Byte, g As Byte, b As Byte, s As Integer)
Create Bitmap 1, s, s
   Ink Rgb(r, g, b), 0
      For x = 1 To 2000
         ang = Rnd(360) : rad = Rnd((s/2)-5) : Dot (s/2) + (Sin(ang)*rad), (s/2) + (Cos(ang)*rad)
      Next x
Blur Bitmap 1, 4
   img = freeImage() : Get Image img, 0, 0, s, s
Delete Bitmap 1
endFunction img

Function freeObject()
   Repeat
      Inc i
   Until Object Exist(i) = 0
EndFunction i

Function freeImage()
   Repeat
      Inc i
   Until Image Exist(i) = 0
EndFunction i

Rem ***** Main Source File *****
Autocam Off

REM TYPES
Type vectors
   x As Float
   y As Float
   z As Float
endType

Type particleProperties
   pos As vectors
   ang As vectors
   vel As vectors
   size As vectors
endType

Type colorProperties
   r As Float
   g As Float
   b As Float
endType

Type explosionParticle
   num  As Integer
   prop As particleProperties
   fade As Float
   diff As colorProperties
endType

REM SET MAXIMUM DIMS
GLOBAL DIM explode(10, 360) As explosionParticle

imgSmoke = createSmoke(255, 255, 255, 64)

REM MAIN LOOP
Sync Rate 34 : Sync On
DO
REM MOVE CAMERA
ax# = wrapvalue(ax# + mousemovey())
ay# = wrapvalue(ay# + mousemovex())
rotate camera ax#, ay#, 0.0
if mouseclick()=1 then move camera 1
if mouseclick()=2 then move camera -1

   exp1 = particleExplosion(1, 360, 0, -10, 50, exp1, imgSmoke)

REM INFO
set cursor 0, 0
print "USE MOUSE TO MOVE AROUND"

Sync
Loop

Function particleExplosion(n As Integer, amount As Integer, x As Float, y As Float, z As Float, ctr As Integer, img As Integer)
If explode(n, 0).num = 0
   obj = freeObject()
   For f = obj To obj + amount
      i = f-obj
      explode(n, i).num          = f
      explode(n, i).prop.pos.x   = x
      explode(n, i).prop.pos.y   = y
      explode(n, i).prop.pos.z   = z
      explode(n, i).prop.size.x  = 2.0
      explode(n, i).prop.size.y  = 2.0
      explode(n, i).prop.size.z  = 2.0
      explode(n, i).prop.ang.x   = 0.0
      explode(n, i).prop.ang.y   = 0.0
      explode(n, i).prop.ang.z   = 0.0
         Make Object Sphere explode(n, i).num, explode(n, i).prop.size.x, 8, 8 `explode(n, i).prop.size.y
         Texture Object explode(n, i).num, img
         Hide Object explode(n, i).num
            Set Object Cull explode(n, i).num, 1
            Set Object Fog explode(n, i).num, 0
            `Set Object Light explode(n, i).num, 0
            Ghost Object On explode(n, i).num, 2
            Set Object Transparency explode(n, i).num, 3
            Disable Object Zwrite explode(n, i).num
            `Set Alpha Mapping On explode(n, i).num, 50
   Next f
EndIf

   For f = 0 To amount
      explode(n, f).prop.size.x = explode(n, f).prop.size.x + 20.0
      explode(n, f).prop.size.y = explode(n, f).prop.size.y + 10.0
      explode(n, f).prop.size.z = explode(n, f).prop.size.z + 10.0
      explode(n, f).prop.pos.x  = explode(n, f).prop.pos.x + explode(n, f).prop.vel.x + Sin(f)
      explode(n, f).prop.pos.y  = explode(n, f).prop.pos.y + explode(n, f).prop.vel.y
      explode(n, f).prop.pos.z  = explode(n, f).prop.pos.z + explode(n, f).prop.vel.z + Cos(f)
         `Fade particle value
         explode(n, f).fade = explode(n, f).fade - 1
         `Diffuse Alter
         If explode(n, f).diff.r =< 250 Then explode(n, f).diff.r = explode(n, f).diff.r + 0.8
         If explode(n, f).diff.g =< 250 Then explode(n, f).diff.g = explode(n, f).diff.g + 0.4
         explode(n, f).diff.b = explode(n, f).diff.b
            `Position, scale and fade particle object
            Position Object explode(n, f).num, explode(n, f).prop.pos.x, explode(n, f).prop.pos.y, explode(n, f).prop.pos.z
            Scale Object explode(n, f).num, explode(n, f).prop.size.x, explode(n, f).prop.size.y, 100
            Set Object Diffuse explode(n, f).num, Rgb(explode(n, f).diff.r, explode(n, f).diff.g, explode(n, f).diff.b)
            `Fade Object explode(n, f).num, explode(n, f).fade
            `Point at camera
            Set Object To Camera Orientation explode(n, f).num
   Next f

   For f = 0 To amount
      If explode(n, f).fade =< 0
         `Position
         explode(n, f).prop.pos.x = x
         explode(n, f).prop.pos.y = y
         explode(n, f).prop.pos.z = z
         `Scale
         explode(n, f).prop.size.x = 1
         explode(n, f).prop.size.y = 1
         explode(n, f).prop.size.z = 1
         `Velocity (randomize)
         explode(n, f).prop.vel.x = Rnd(100) / 500.0 - 0.1
         explode(n, f).prop.vel.y = Rnd(100) / 500.0 - 0.1
         explode(n, f).prop.vel.z = Rnd(100) / 500.0 - 0.1
         `Fade
         explode(n, f).fade = 200
         `Color
         explode(n, f).diff.r = 150
         explode(n, f).diff.g = 150
         explode(n, f).diff.b = 0
         `Show the particle
         Show Object explode(n, f).num
      endif
   next f

endFunction ctr


Function createSmoke(r As Byte, g As Byte, b As Byte, s As Integer)
Create Bitmap 1, s, s
   Ink Rgb(r, g, b), 0
      For x = 1 To 2000
         ang = Rnd(360) : rad = Rnd((s/2)-5) : Dot (s/2) + (Sin(ang)*rad), (s/2) + (Cos(ang)*rad)
      Next x
Blur Bitmap 1, 4
   img = freeImage() : Get Image img, 0, 0, s, s
Delete Bitmap 1
endFunction img

Function freeObject()
   Repeat
      Inc i
   Until Object Exist(i) = 0
EndFunction i

Function freeImage()
   Repeat
      Inc i
   Until Image Exist(i) = 0
EndFunction i

rem CREATING SOME TEXTURES
for i= 1 to 80
ink rgb(50,50,50),1
a=rnd(40)
a2=rnd(40)
box a,a2,a+8,a2+8
ink rgb(130,130,130),1
box a,a2,a+6,a2+6
next i
get image 180,0,0,50,50,1
cls
rem =============================================================================================
ink rgb(30,30,30),1
box 0,0,50,50
for i= 1 to 180
ink rgb(50,50,50),1
a=rnd(40)
a2=rnd(40)
box a,a2,a+3,a2+3
ink rgb(130,130,130),1
box a,a2,a+1,a2+1
next i
get image 300,0,0,50,50,1
cls
rem =============================================================================================
ink rgb(15,15,15),1:box 0,0,30,30
ink rgb(0,0,0),1
for i= 1 to 30
  line 0,0,rnd(100),rnd(100)
next i
get image 100,0,0,40,40,1
cls
rem =============================================================================================
ink rgb(220,250,0),1:box 0,0,60,60
ink rgb(250,50,0),1
for i= 1 to 100
line rnd(20),rnd(20),rnd(100),rnd(100)
next i
get image 11,0,0,20,20,1
cls
rem =============================================================================================
ink rgb(255,255,255),1:for i= 1 to 250:dot rnd(100),rnd(100):next i:get image 2,0,0,100,100,1
ink rgb(0,130,210),1:box 0,0,50,50:ink rgb(0,70,100),1:box 10,10,40,40:ink rgb(0,30,40),1:box 2,2,10,10
get image 1,0,0,50,50,1
rem ============================================================================================
autocam off
sync on
hide mouse

rem creating the sky
make object sphere 5777,1000:texture object 5777,2:set object cull 5777,0:scale object texture 5777,20,20:ghost object on 5777
make object sphere 5778,980:texture object 5778,2:set object cull 5778,0:scale object texture 5778,20,20:ghost object on 5778

rem parts of star
for i= 1 to 360 step 3:make object box i,10,10,10:rotate object i,i,0,0:offset limb i,0,0,260,0:next i
for i= 2 to 359 step 3:make object box i,10,15+rnd(6),10:rotate object i,i,0,0:offset limb i,0,8,265,0:next i
for i= 3 to 359 step 3:make object box i,10,15+rnd(6),10:rotate object i,i,0,0:offset limb i,0,-8,265,0:next i
for i= 1 to 360:if object exist(i):texture object i,180:endif:next i
set object emissive 5777,11111
set object emissive 5778,11111

make object sphere 1000,3
position object 1000,0,270,-15
scale object 1000,30,30,300
make mesh from object 1,1000
add limb 1000,1,1:rotate limb 1000,1,90,0,90:texture object 1000,1
set ambient light 0:make light 1:position light 1,0,250,0
position camera -0,270,10
point camera 0,270,0

do
mi_time=mi_time+3
if mi_time>2000
  for i= 1 to 2000
    if object exist(i) then delete object i
  next i
  goto explo
endif

color backdrop rgb(0,30,60)
g#=g#+0.07
rotate object 5777,g#/2,0,0
rotate object 5778,g#/2,0,5
r=r+1
if r<200 then inc su#,0.06
if r>200 then dec su#,0.06
if r>400 then r=0
position camera -1+su#/7,266+su#/8,10
position object 1000,0,267+su#/8,-15
rotate object 1000,0,0,-15+su#*2

for i= 1 to 360 step 3
rotate object i,i+g#,0,0
next i
zrotate object 1000,-40+rnd(90)

for i= 2 to 359 step 3
  rotate object i,i+g#,0,0
next i

for i= 3 to 359 step 3
  rotate object i,i+g#,0,0
next i
sync
loop


explo:
rem creating particles
for i= 1 to 500
   make object plain i,4,4
   rotate object i,rnd(180),rnd(180),rnd(180)
   texture object i,11
   set object light i,rgb(255,155,55)
   move object i,2
next i

position camera -100,100,-100
point camera 0,0,0

make object sphere 1000,50,30,30:set object 1000,1,1,1,0:set object cull 1000,0:texture object 1000,300
make object sphere 1001,48,30,30:set object 1001,1,1,1,0:set object cull 1001,0:texture object 1001,100
scale object texture 1001,2,12


 set object emissive 5777,1111111111111111111111111111111111111111111111111
 set object emissive 5778,1111111111111111111111111111111111111111111111111
do

g#=g#+0.03
rt#=rt#+0.03
yrotate object 1000,180+rt#
yrotate object 1001,-80+rt#

t=t+1
if t>800 then b=b+2:hide object 1000:hide object 1001
if t>950 then texture object 1000,100:show object 1000:show object 1001

for i= 1 to 500
    ghost object on i
    scale object i,b*50,b*50,b*50
    move object i,b/40
    if t>950
      position object i,0,0,0
      move object i,24
      scale object i,25,25,25
      rotate object i,rnd(180),rnd(180),rnd(180)
    endif
next i

sync
loop

autocam off
randomize timer()
set display mode 1024,768,32 

global y
global xfac=420
global rad=0
global curvangle=10
global yang=440
global xpar=400
global ypar=475

land_and_sun()

repeat
   scenery()
   line 420,y-10,420,y
   line 421,y-10,421,y
   smoke_dots()
      inc y,1
   REM 505 is the Y value for missile contact with the earth!
   text 0,320,str$(screen fps())
until y=505

repeat
   scenery()
   explosion()
until returnkey()
end

function smoke_dots()
   `smokes dots
   `third row
   dot 415,y-20
   dot 420,y-20
   dot 425,y-20
   `second row
   dot 418,y-15
   dot 423,y-15
endfunction

function scenery()
   `Flat beginning
   line 0,500,50,490
   `Mountain
   line 50,490,80,300
   line 80,300,110,510
   `Valley
   line 110,510,450,505
   `Hill
   line 450,505,500,450
   line 500,450,550,450
   line 550,450,600,503
   `Valley 2
   line 600,503,700,510
   line 700,510,900,510
   `Big mountain
   line 900,510,1100,290
endfunction

function land_and_sun()
   `makes the ground
   make object plain 1,5,100
   color object 1,rgb(0,255,0)
   zrotate object 1,90
   position object 1,0,-4.5,10

   `makes the sun
   make object sphere 2,3
   color object 2,rgb(255,255,0)
   position object 2,-6.8,5,10

   `light 1
   make light 1
   position light 1,-6.8,3,7
   `light 2
   make light 2
   position light 1,-5,3,9
endfunction

function explosion()
   `Shockwave
   inc rad,5
   `780 is the maxium radius then it dissapears
   circle xfac,y,rad
   `Particles
   particles()
   `Exploding lines
   line xpar,505,xpar-50,yang+rnd(20)
   line xpar,505,xpar+50,block+yang+rnd(20)
   
   line xpar,505,xpar-30,yang+rnd(20)
   line xpar,505,xpar+30,block+yang+rnd(20)
   
   line xpar,505,xpar-20,yang+rnd(20)
   line xpar,505,xpar+20,block+yang+rnd(20)
   
   line xpar,505,xpar-40,yang+rnd(20)
   line xpar,505,xpar+40,block+yang+rnd(20)
endfunction

function particles()
   `Particles one
   dot xpar+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+rnd(12),ypar+rnd(20),rgb(255,255,0)
   `Particles two
   dot xpar+10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   `Particles three
   dot xpar+10+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar+10+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   `Particles four
   dot xpar-10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar-10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar-10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar-10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar-10+rnd(20),ypar+rnd(12),rgb(255,255,0)
   dot xpar-10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar-10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar-10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar-10+rnd(12),ypar+rnd(20),rgb(255,255,0)
   dot xpar-10+rnd(12),ypar+rnd(20),rgb(255,255,0)
      `Particles four
   dot xpar-20+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar-20+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar-20+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar-20+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar-20+rnd(20),ypar+10+rnd(12),rgb(255,255,0)
   dot xpar-20+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar-20+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar-20+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar-20+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
   dot xpar-20+rnd(12),ypar+10+rnd(20),rgb(255,255,0)
endfunction

// 3D explosion
// By Jeff Huijsmans

Sync on
Sync rate 30
Autocam off
Backdrop on
Color backdrop RGB(100, 100, 255)

// Generate media
// Yellow color
box 0,0,1,1,RGB(255,255,0),RGB(255,255,0),RGB(255,255,0),RGB(255,255,0)
get image 1, 0, 0, 1, 1
cls

// Rainbow shade color
box 0,0,100,100,RGB(255,155,0), RGB(155,255,0), RGB(255,55,0), RGB(255,55,0)
get image 2, 0, 0, 100, 100
cls

// Smoke
// Make a new bitmap to paint on
create bitmap 5,50,50
// Set the color of the smoke
ink rgb(250,200,100),0
// Make dots
for x=1 to 1000
angle = rnd(360)
radius = rnd(20)
dot 25 + sin(angle) * radius, 25 + cos(angle) * radius
next x
// Blur dots
blur bitmap 5,4
// Grab the image and put it in "3"
get image 3, 0, 0, 50, 50
// Get rid of the bitmap.
delete bitmap 5


// Make sphere
make object sphere 1, 1
// Texture it with yellow colour
texture object 1, 1
// Move camera slightly backwards
position camera 0, 200, -200
point camera object position x(1), object position y(1), object position z(1)
// Make sphere transparent
ghost object on 1
// Make it collidable
Automatic object collision 1, 0, 1
`Set global collision on 
// Rainbowshade it with previous generated media
`set rainbow shading on 1, 

// Make plain for floor
make object plain 2, 500, 500
// Scale it
scale object 2, 400, 400, 400
// Make it almost white
color object 2, RGB(200, 200, 200)
// Position it lower
`position object 2, 0, -25, 0
// Rotate it
rotate object 2, 90, 0, 0

// Make randomly placed objects
Type CubeSpec
	Shocked as BOOLEAN
EndType
dim Cubes(120) as CubeSpec
for Cube = 10 to 100
	Radius = 10+rnd(10)
	make object cube Cube, Radius
	position object Cube, -500+rnd(1000), 0, -500+rnd(1000)
	color object Cube, RGB(RND(255), RND(255), RND(255))
	point object Cube, 0,0,0
	`Automatic object collision Cube, Radius, 1 
Next Cube

// Make particles (Bomb)
make particles 1, 2, 100, 2.5
// Set parameters (Bomb)
set particle emissions 1, 0
set particle velocity 1, 20
set particle gravity 1, 5
set particle speed 1, 0.01
set particle life 1, 500
set particle chaos 1, 20
ghost particles on 1, 3

// Make particles (Smoke)
make particles 2, 3, 100, 50
// Set parameters (Smoke)
set particle emissions 2, 0
set particle velocity 2, 2
set particle gravity 2, 0
set particle speed 2, 0.05
set particle life 2, 100
ghost particles on 2, 3

center text screen width()/2, screen height()/2, "" : sync : sync : cls
center text screen width()/2, screen height()/2, "Press any key to ignite the bomb..." : sync : wait key : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 2..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 1..." : sync : wait 1000 : cls


scale# = 1
xx#    = 1
for x# = 0 to 600 step 0.5
	position camera camera position x(), camera position y(), camera position z()-(xx#*1.05)
	rotate camera 0, 0, 0
	point camera object position x(1), object position y(1), object position z(1)
	scale# = scale# * 1.05
	if x# < 10
		scale# = scale# * 1.05
		scale# = scale# * 1.05
		scale# = scale# * 1.05
	endif
	
	if x# > 10 and x# < 20
		FORCE SHOOT 100, 0
		set particle emissions 1, 50
		rotate camera camera angle x()-(3+rnd(6)), camera angle y()-(3+rnd(6)), camera angle z()-(3+rnd(6))
	endif
	
	if x# > 20 and x# < 40
		set particle emissions 1, 100
		rotate camera camera angle x()-(2+rnd(4)), camera angle y()-(2+rnd(4)), camera angle z()-(2+rnd(4))
	endif
	
	if x# > 20 and x# < 150
		for Cube = 10 to 100
			if object collision(Cube, 1)
				move object cube, -5
				rotate object Cube, object angle x(Cube), object angle y(Cube), object angle z(Cube)+Rnd(5)
				position object Cube, object position x(Cube), object position y(Cube)+rnd(15), object position z(Cube)
			endif
		next cube
	endif
	
	if x# > 40 and x# < 100
		FORCE SHOOT 50, 0
		set particle emissions 1, 0
		set particle emissions 2, 25
		rotate camera camera angle x()-(1+rnd(2)), camera angle y()-(1+rnd(2)), camera angle z()-(1+rnd(2))
	endif 
	
	if x# > 100 and x# < 150
		FORCE SHOOT 25, 10
		rotate camera camera angle x()-(0.5+rnd(1)), camera angle y()-(0.5+rnd(1)), camera angle z()-(0.5+rnd(1))
	endif
	
	if x# > 150
		inc Gravity#, 0.1
		for Cube = 10 to 100
			if object collision(Cube, 2) = 0
				position object Cube, object position x(Cube), object position y(Cube)-Gravity#, object position z(Cube)
			endif
			if object collision(Cube, 2) = 1
				if Cubes(Cube).Shocked = 0
					Cubes(Cube).Shocked = 1
					FORCE CHAINSAW 50, 10
				endif
			endif
		next Cube
		FORCE SHOOT 10, 100
		set camera to follow 0, 10, 0, 0, 50, 0, 50.0, 0
	endif
	
	if x# > 200
		FORCE SHOOT 0, 0
	endif
	
	if x# > 130
		set particle emissions 2, 0
	endif
	
	scale object 1, scale#, scale#, scale#
	
	// Debugging
	set cursor 0, 0
	print "x# = " + str$(x#)
	`for Cube = 10 to 100
		`print object collision(Cube, 1)
	`next cube


	
	`Set object radius 1, scale# 
	
	sync
next x#

end

center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : wait 1000 : cls center text screen width()/2, screen height()/2, "Bomb will ignite in 2..." : sync : wait 1000 : cls

center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : wait 1000 : cls 

center text screen width()/2, screen height()/2, "Bomb will ignite in 2..." : sync : wait 1000 : cls

look// 3D explosion
// By Jeff Huijsmans

Sync on
Sync rate 30
Autocam off
Backdrop on
Color backdrop RGB(100, 100, 255)

// Generate media
// Yellow color
box 0,0,1,1,RGB(255,255,0),RGB(255,255,0),RGB(255,255,0),RGB(255,255,0)
get image 1, 0, 0, 1, 1
cls

// Rainbow shade color
box 0,0,100,100,RGB(255,155,0), RGB(155,255,0), RGB(255,55,0), RGB(255,55,0)
get image 2, 0, 0, 100, 100
cls

// Smoke
// Make a new bitmap to paint on
create bitmap 5,50,50
// Set the color of the smoke
ink rgb(250,200,100),0
// Make dots
for x=1 to 1000
angle = rnd(360)
radius = rnd(20)
dot 25 + sin(angle) * radius, 25 + cos(angle) * radius
next x
// Blur dots
blur bitmap 5,4
// Grab the image and put it in "3"
get image 3, 0, 0, 50, 50
// Get rid of the bitmap.
delete bitmap 5


// Make sphere
make object sphere 1, 1
// Texture it with yellow colour
texture object 1, 1
// Move camera slightly backwards
position camera 0, 200, -200
point camera object position x(1), object position y(1), object position z(1)
// Make sphere transparent
ghost object on 1
// Make it collidable
Automatic object collision 1, 0, 1
`Set global collision on
// Rainbowshade it with previous generated media
`set rainbow shading on 1,

// Make plain for floor
make object plain 2, 500, 500
// Scale it
scale object 2, 400, 400, 400
// Make it almost white
color object 2, RGB(200, 200, 200)
// Position it lower
`position object 2, 0, -25, 0
// Rotate it
rotate object 2, 90, 0, 0

// Make randomly placed objects
Type CubeSpec
   Shocked as BOOLEAN
EndType
dim Cubes(120) as CubeSpec
for Cube = 10 to 100
   Radius = 10+rnd(10)
   make object cube Cube, Radius
   position object Cube, -500+rnd(1000), 0, -500+rnd(1000)
   color object Cube, RGB(RND(255), RND(255), RND(255))
   point object Cube, 0,0,0
   `Automatic object collision Cube, Radius, 1
Next Cube

// Make particles (Bomb)
make particles 1, 2, 100, 2.5
// Set parameters (Bomb)
set particle emissions 1, 0
set particle velocity 1, 20
set particle gravity 1, 5
set particle speed 1, 0.01
set particle life 1, 500
set particle chaos 1, 20
ghost particles on 1, 3

// Make particles (Smoke)
make particles 2, 3, 100, 50
// Set parameters (Smoke)
set particle emissions 2, 0
set particle velocity 2, 2
set particle gravity 2, 0
set particle speed 2, 0.05
set particle life 2, 100
ghost particles on 2, 3

center text screen width()/2, screen height()/2, "" : sync : sync : cls
center text screen width()/2, screen height()/2, "Press any key to ignite the bomb..." : sync : wait key : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 3..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 2..." : sync : wait 1000 : cls
center text screen width()/2, screen height()/2, "Bomb will ignite in 1..." : sync : wait 1000 : cls


scale# = 1
xx#    = 1
for x# = 0 to 600 step 0.5
   position camera camera position x(), camera position y(), camera position z()-(xx#*1.05)
   rotate camera 0, 0, 0
   point camera object position x(1), object position y(1), object position z(1)
   scale# = scale# * 1.05
   if x# < 10
      scale# = scale# * 1.05
      scale# = scale# * 1.05
      scale# = scale# * 1.05
   endif

   if x# > 10 and x# < 20

      set particle emissions 1, 50
      rotate camera camera angle x()-(3+rnd(6)), camera angle y()-(3+rnd(6)), camera angle z()-(3+rnd(6))
   endif

   if x# > 20 and x# < 40
      set particle emissions 1, 100
      rotate camera camera angle x()-(2+rnd(4)), camera angle y()-(2+rnd(4)), camera angle z()-(2+rnd(4))
   endif

   if x# > 20 and x# < 150
      for Cube = 10 to 100
         if object collision(Cube, 1)
            move object cube, -5
            rotate object Cube, object angle x(Cube), object angle y(Cube), object angle z(Cube)+Rnd(5)
            position object Cube, object position x(Cube), object position y(Cube)+rnd(15), object position z(Cube)
         endif
      next cube
   endif

   if x# > 40 and x# < 100

      set particle emissions 1, 0
      set particle emissions 2, 25
      rotate camera camera angle x()-(1+rnd(2)), camera angle y()-(1+rnd(2)), camera angle z()-(1+rnd(2))
   endif

   if x# > 100 and x# < 150

      rotate camera camera angle x()-(0.5+rnd(1)), camera angle y()-(0.5+rnd(1)), camera angle z()-(0.5+rnd(1))
   endif

   if x# > 150
      inc Gravity#, 0.1
      for Cube = 10 to 100
         if object collision(Cube, 2) = 0
            position object Cube, object position x(Cube), object position y(Cube)-Gravity#, object position z(Cube)
         endif
         if object collision(Cube, 2) = 1
            if Cubes(Cube).Shocked = 0
               Cubes(Cube).Shocked = 1

            endif
         endif
      next Cube

      set camera to follow 0, 10, 0, 0, 50, 0, 50.0, 0
   endif

   if x# > 200

   endif

   if x# > 130
      set particle emissions 2, 0
   endif

   scale object 1, scale#, scale#, scale#

   // Debugging
   set cursor 0, 0
   print "x# = " + str$(x#)
   `for Cube = 10 to 100
      `print object collision(Cube, 1)
   `next cube



   `Set object radius 1, scale#

   sync
next x#

end