Sorry your browser is not supported!

//Finds the largest palindrome made from the product of two n-digit numbers

n = 3

//Find first and last numbers
temp$ = "1"
for c = 1 to n - 1
    temp$ = temp$ + "0"
next c
first = val(temp$)
temp$ = ""
for c = 1 to n
    temp$ = temp$ + "9"
next c
last  = val(temp$)


current1 = first
current2 = first

answer1 = 0
answer2 = 0


//Solve
while current2 <= last
    
    while current1 <= last
        
        inc current1
        
        tempProd = current1 * current2
        
        if isPalindrome(str$(tempProd))
        
            if tempProd > answer1 * answer2
                answer1 = current1
                answer2 = current2
                
                print "Greater palindrome Found:"
                print "- Product of "; current1; " and "; current2
                print " = "; tempProd
                print
            endif
            
        endif
        
    endwhile
    
    inc current2
    current1 = current2
    
endwhile

print
print "FINAL SOLUTION:"
print answer1; " * "; answer2; " = "; answer1*answer2

wait key
end



function isPalindrome(num as string)

if len(num) = 0 then exitfunction 1

if left$(num,1) <> right$(num, 1)
    exitfunction 0
    else
    temp$ = left$(num, len(num)-1)
    next$ = right$(temp$, len(temp$)-1)
    exitfunction isPalindrome(next$)
endif

endfunction 1

function isPalindrome(s as string)
	L = len(s)
	for i = 1 to L/2
		if mid$(s, i) <> mid$(s, L-(i-1)) then exitfunction 0
	next i
endfunction 1

// TexGen Operator functions.

// Might be used to describe operations...
#constant DT_TEXOP_START        1
#constant DT_TEXOP_WRITE        2
#constant DT_TEXOP_READ         3
#constant DT_TEXOP_DESTROY      4
#constant DT_TEXOP_DOT          5
#constant DT_TEXOP_LINE         6
#constant DT_TEXOP_BOX          7
#constant DT_TEXOP_CIRCLE       8
#constant DT_TEXOP_POLYGON      9
#constant DT_TEXOP_RNDNOISE     10
#constant DT_TEXOP_BLUR         11
#constant DT_TEXOP_BRIGHTEN     12
#constant DT_TEXOP_DARKEN       13
#constant DT_TEXOP_ADD          14
#constant DT_TEXOP_SUB          15
#constant DT_TEXOP_BLEND        16

sync on : sync rate 50
randomize timer()

for i=0 to 99
    cls 0
    sync
next i

REM - Create the texture...    
create bitmap 1,256,256
set current bitmap 0
ink rgb(127,127,127),0
box 4,4,252,252
sync : wait 1000
ink rgb(255,255,255),0
box 4,4,248,8
box 4,4,8,248
sync : wait 1000
copy bitmap 0,0,0,256,256,1,0,0,128,128
copy bitmap 0,0,0,256,256,1,128,0,256,128
copy bitmap 0,0,0,256,256,1,0,128,128,256
copy bitmap 0,0,0,256,256,1,128,128,256,256
cls 0
copy bitmap 1,0,0,256,256,0,0,0,256,256
OP_BMUNINoise(1, 64, 256, 256)
OP_BMBlur(1,256,256)
sync : wait 1000
OP_BMSubtract(0,128,256,256)
sync : wait 1000
OP_BMBrighten(0,100,256,256)
sync : wait 1000
OP_BMBlur(0,256,256) : OP_BMBlur(0,256,256)
sync : wait 1000
OP_BMBlur(0,256,256) : OP_BMBlur(0,256,256)
sync : wait 1000
OP_BMBlur(0,256,256) : OP_BMBlur(0,256,256)
sync : wait 1000
OP_BMBrighten(0,100,256,256)
sync : wait 1000
OP_BMBlend(0,1,256,256)
sync : wait 1000
get image 1,0,0,256,256,1
cls 0
delete bitmap 1

// Create an object and texture it with our Texture...
autocam off
make object cube 1,10
position object 1,0,0,0
texture object 1,1
position camera 0,0,-17.5
point camera 0,0,0

// Show it! :)
do
    turn object right 1,0.5
    sync
loop

end


// **********************************
// *** TEXTURE OPERATOR FUNCTIONS ***
// **********************************

// Generate Uniform Noise
function OP_BMUNINoise(bm as integer, amount as integer, width as integer, height as integer)
    col as dword
    am2 = amount >> 1   // am2 = Amount / 2
    oldBM = current bitmap()
    set current bitmap bm
    pixptr as dword
    ptr as dword
    lock pixels
    pixptr = get pixels pointer()   // Get a pointer to the pixel map...
    pP = get pixels pitch()         // Get the width of each row, in bytes...
    for y=0 to height - 1
        for x=0 to width - 1
            n = rnd(amount) + am2
            ptr = pixptr + y*pP + (x<<2)   // Get color from the pixmap
            col = *ptr
            r = (0x00ff0000 and col) >> 16  // Extract the red component...
            g = (0x0000ff00 and col) >> 8
            b = (0x000000ff and col)
            r = (n+r) >> 1                  // Blend noise value and red component...
            g = (n+g) >> 1
            b = (n+b) >> 1
            if r < 0 then r = 0             // Make sure that we are in range...
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            *ptr = (255 << 24) or (r << 16) or (g << 8) or b    // Set pixmap to new color...
        next x
    next y
    unlock pixels
    set current bitmap oldBM
endfunction

// Brighten the bitmap by a percentage. (100% = double the brightness)
function OP_BMBrighten(bm as integer, percent as float, width as integer, height as integer)
    pixptr as dword
    ptr as dword
    col as dword
    percent = 1.0 + (percent / 100.0)
    oldBM = current bitmap()
    set current bitmap bm
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col = *ptr
            r = ((0x00ff0000 and col) >> 16) * percent
            g = ((0x0000ff00 and col) >> 8) * percent
            b = (0x000000ff and col) * percent
            if r < 0 then r = 0
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            if r > 0 or g > 0 or b > 0
                *ptr = (255 << 24) or (r << 16) or (g << 8) or b
            endif
        next x
    next y
    unlock pixels
    set current bitmap oldBM
endfunction

function OP_BMDarken(bm as integer, percent as float, width as integer, height as integer)
    pixptr as dword
    ptr as dword
    col as dword
    percent = 1.0 - (percent / 100.0)
    oldBM = current bitmap()
    set current bitmap bm
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col = *ptr
            r = ((0x00ff0000 and col) >> 16) * percent
            g = ((0x0000ff00 and col) >> 8) * percent
            b = (0x000000ff and col) * percent
            if r < 0 then r = 0
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            if r > 0 or g > 0 or b > 0
                *ptr = (255 << 24) or (r << 16) or (g << 8) or b
            endif
        next x
    next y
    unlock pixels
    set current bitmap oldBM
endfunction

// Subtract a constant value from all colors.
function OP_BMSubtract(bm as integer, value as integer, width as integer, height as integer)
    pixptr as dword
    ptr as dword
    col as dword
    oldBM = current bitmap()
    set current bitmap bm
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col = *ptr
            r = ((0x00ff0000 and col) >> 16) - value
            g = ((0x0000ff00 and col) >> 8) - value
            b = (0x000000ff and col) - value
            if r < 0 then r = 0
            if g < 0 then g = 0
            if b < 0 then b = 0
            if r > 0 or g > 0 or b > 0
                *ptr = (255 << 24) or (r << 16) or (g << 8) or b
            else
                *ptr = 0xff000000
            endif
        next x
    next y
    unlock pixels
    set current bitmap oldBM
endfunction

// Add a constant value to all colors.
function OP_BMAdd(bm as integer, value as integer, width as integer, height as integer)
    pixptr as dword
    ptr as dword
    col as dword
    oldBM = current bitmap()
    set current bitmap bm
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col = *ptr
            r = ((0x00ff0000 and col) >> 16) + value
            g = ((0x0000ff00 and col) >> 8) + value
            b = (0x000000ff and col) + value
            if r > 255 then r = 255
            if g > 255 then g = 255
            if b > 255 then b = 255
            if r > 0 or g > 0 or b > 0
                *ptr = (255 << 24) or (r << 16) or (g << 8) or b
            else
                *ptr = 0xff000000
            endif
        next x
    next y
    unlock pixels
    set current bitmap oldBM
endfunction

function OP_BMBlend(primary as integer, secondary as integer, width as integer, height as integer)
    pixptr as dword
    ptr as dword
    dim col1(width-1,height-1) as dword
    oldBM = current bitmap()
    set current bitmap secondary
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col1(x,y) = *ptr
        next x
    next y
    unlock pixels
    set current bitmap primary
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 1
            ptr = pixptr + y*pP + (x<<2)
            col2 = *ptr
            r1 = (0x00ff0000 and col1(x,y)) >> 16
            r2 = (0x00ff0000 and col2) >> 16
            r3 = (r1 + r2) >> 1
            g1 = (0x0000ff00 and col1(x,y)) >> 8
            g2 = (0x0000ff00 and col2) >> 8
            g3 = (g1 + g2) >> 1
            b1 = (0x000000ff and col1(x,y))
            b2 = (0x000000ff and col2)
            b3 = (b1 + b2) >> 1
            *ptr = (255 << 24) or (r3 << 16) or (g3 << 8) or b3
        next x
    next y
    unlock pixels
    set current bitmap oldBM
    undim col1()
endfunction

function OP_BMBlur(bm as integer, width as integer, height as integer)
    pixptr as dword
    ptr1 as dword
    ptr2 as dword
    col1 as dword
    col2 as dword
    col3 as dword
    col4 as dword
    oldBM = current bitmap()
    set current bitmap bm
    lock pixels
    pixptr = get pixels pointer()
    pP = get pixels pitch()
    for y=0 to height - 1
        for x=0 to width - 2 step 2
            ptr1 = pixptr + y*pP + (x<<2)
            ptr2 = ptr1 + 4
            col1 = *ptr1
            col2 = *ptr2
            r1 = (0x00ff0000 and col1) >> 16
            g1 = (0x0000ff00 and col1) >> 8
            b1 = (0x000000ff and col1)
            r2 = (0x00ff0000 and col2) >> 16
            g2 = (0x0000ff00 and col2) >> 8
            b2 = (0x000000ff and col2)
            col3 = ((255 << 24) or (((r1<<1) + r2) / 3) << 16 or (((g1<<1) + g2) / 3) << 8 or (((b1<<1) + b2) / 3))
            col4 = ((255 << 24) or ((r1 + (r2<<1)) / 3) << 16 or ((g1 + (g2<<1)) / 3) << 8 or ((b1 + (b2<<1)) / 3))
            *ptr1 = col3
            *ptr2 = col4
        next x
        for x=1 to width - 3 step 2
            ptr1 = pixptr + y*pP + (x<<2)
            ptr2 = ptr1 + 4
            col1 = *ptr1
            col2 = *ptr2
            r1 = (0x00ff0000 and col1) >> 16
            g1 = (0x0000ff00 and col1) >> 8
            b1 = (0x000000ff and col1)
            r2 = (0x00ff0000 and col2) >> 16
            g2 = (0x0000ff00 and col2) >> 8
            b2 = (0x000000ff and col2)
            col3 = ((255 << 24) or (((r1<<1) + r2) / 3) << 16 or (((g1<<1) + g2) / 3) << 8 or (((b1<<1) + b2) / 3))
            col4 = ((255 << 24) or ((r1 + (r2<<1)) / 3) << 16 or ((g1 + (g2<<1)) / 3) << 8 or ((b1 + (b2<<1)) / 3))
            *ptr1 = col3
            *ptr2 = col4
        next x
    next y

    for x=0 to width - 1
        for y=0 to height - 2 step 2
            ptr1 = pixptr + y*pP + (x<<2)
            ptr2 = ptr1 + pP
            col1 = *ptr1
            col2 = *ptr2
            r1 = (0x00ff0000 and col1) >> 16
            g1 = (0x0000ff00 and col1) >> 8
            b1 = (0x000000ff and col1)
            r2 = (0x00ff0000 and col2) >> 16
            g2 = (0x0000ff00 and col2) >> 8
            b2 = (0x000000ff and col2)
            col3 = ((255 << 24) or (((r1<<1) + r2) / 3) << 16 or (((g1<<1) + g2) / 3) << 8 or (((b1<<1) + b2) / 3))
            col4 = ((255 << 24) or ((r1 + (r2<<1)) / 3) << 16 or ((g1 + (g2<<1)) / 3) << 8 or ((b1 + (b2<<1)) / 3))
            *ptr1 = col3
            *ptr2 = col4
        next y
        for y=1 to height - 3 step 2
            ptr1 = pixptr + y*pP + (x<<2)
            ptr2 = ptr1 + pP
            col1 = *ptr1
            col2 = *ptr2
            r1 = (0x00ff0000 and col1) >> 16
            g1 = (0x0000ff00 and col1) >> 8
            b1 = (0x000000ff and col1)
            r2 = (0x00ff0000 and col2) >> 16
            g2 = (0x0000ff00 and col2) >> 8
            b2 = (0x000000ff and col2)
            col3 = ((255 << 24) or (((r1<<1) + r2) / 3) << 16 or (((g1<<1) + g2) / 3) << 8 or (((b1<<1) + b2) / 3))
            col4 = ((255 << 24) or ((r1 + (r2<<1)) / 3) << 16 or ((g1 + (g2<<1)) / 3) << 8 or ((b1 + (b2<<1)) / 3))
            *ptr1 = col3
            *ptr2 = col4
        next y
    next x
    unlock pixels
    set current bitmap oldBM
endfunction

type num_type
 one as integer
 two as integer
 three as integer
endtype

num AS num_type
sub AS integer

num.one = 1000
num.two = 999
num.three = 999

sub = 1


do
   if sub = 1
      sub = 2
      dec num.one, 1
      teststring$ = str$(num.one * num.two * num.three)
      string2$ = rev(teststring$)
      if teststring$ = string2$ then exit
   endif
   if sub = 2
      sub = 3
      dec num.two, 1
      teststring$ = str$(num.one * num.two * num.three)
      string2$ = rev(teststring$)
      if teststring$ = string2$ then exit
   endif
   if sub = 3
      sub = 1
      dec num.three, 1
      teststring$ = str$(num.one * num.two * num.three)
      string2$ = rev(teststring$)
      if teststring$ = string2$ then exit
   endif
loop

print str$(sub)
print "Total Product : " + teststring$
print "Numbers : " + str$(num.one) + " : " + str$(num.two) + " : " + str$(num.three)
wait key

end

function rev(input$ as string)

output$ = ""

for i = len(input$) to 1 step -1
 output$ = output$ + mid$(input$,i)
next i

endfunction output$

[href=http://forum.thegamecreators.com/?m=forum_view&t=48011&b=1&p=183][IMG]http://i635.photobucket.com/albums/uu78/Dead_Legend/DBPLandChalBan.jpg[/IMG][/href]

Rem Project: looney lander
Rem Created: Friday, May 27, 2011

Rem ***** Main Source File *****
//system_setup________________________________________________________________
maximize window
set display mode 1920,1080,32
set text size 60
gosub startup:
randomize timer()
sync on: sync rate 60
hide mouse
disable escapekey
autocam off
ink rgb(255,255,0),0
set text size 60
color backdrop 0
position camera 250,30,250
//load_objects_______________________________________________________________
MAKE OBJECT cube 3,6
make object cone 1,6
make object plane 6,6,6
make object plane 10,5000,5000
make object sphere 11,100
scale object 6, 10, 10, 10
//position_objects___________________________________________________________
position object 1,250,90,370
position object 3,250,-2,370
position object 6, 250,0,360
position object 10,0,0,0
position object 11,300,100,600
//Rotate_planes_______________________________________________________________
rotate object 6,90,0,0
rotate object 10,270,0,0
//colour_objects______________________________________________________________
color object 1,rgb(0,255,0)
color object 3,rgb(255,255,0)
color object 6, rgb(5,5,5)
color object 10,rgb(100,100,100)
rem rotate camera 30,0,0
//declare arrays_and_variables____________________________________________________
fall# = .001
ground = 0
highscore$ = ""
highscore = 0
fuelmarker$ = "I"
fuel = 18
dim win$(10)
dim lose$(10)
//winner_messages_____________________________________________________________
win$(1) = "Winner!"
win$(2) = "Safe landing!"
win$(3) = "Nifty lifting!"
win$(4) = "Touchdown!"
win$(5) = "Safe and sound!"
win$(6) = "Awsome effort!"
win$(7) = "You're pretty good at this!"
win$(8) = "so many random stupid winner messages!"
win$(9) = "Not even a scratch!"
win$(10) = "you could park on a ninja's bum without him knowing!"
//loser_messages_______________________________________________________________
lose$(1) = "You broke your spaceship!!!"
lose$(2) = "I'll bet that landing hurt your nads!"
lose$(3) = "You drive like a future quadraplegic!"
lose$(4) = "That was the ground you just crashed into!"
lose$(5) = "Eat some toast and think about the lives you just ended!"
lose$(6) = "You killed your crew, and some ants on the ground!"
lose$(7) = "Whats that over there?!  Parts of your trashed ship!"
lose$(8) = "spaceships are too expensive to thrash like this!"
lose$(9) = "you played destruction derby as a kid didn't you!"
lose$(10) = "how does the windshield taste?"
//main_loop____________________________________________________________________
do
    gosub gravity:
    gosub thrust:
    gosub score:
    gosub control:
    gosub fuel:
    if reset = 1 then gosub reset:
    if KEYSTATE(1) = 1  
            gosub gameover:
            end
    endif
    
    sync
loop
//setup_monitor_and_calculate gravity_and_ground_effects_________________________________
gravity:
            // control timers for gravity + downward force applied to ship
            t1#=timer()
            if t1# > t2# then time = time + 1
            if t1# > t2#
                     if reset = 0 then fall# = fall# + .004
                     x# = object position x(1)
                     y# = object position y(1) - fall#
                     z# = object position z(1)
                     position object 1,x#,y#,z#
            endif
            t2# = timer()
            
            // settle ship on ground
            if object position y(1) <= 3
                    position object 1,object position x(1),3,object position z(1)
            endif
            
            // control shadow position and size
            position object 6,object position x(1),.1,object position z(1)
            if object position y(1) < 30 then shadow = 100
            if object position y(1) > 30 and object position y(1) < 40  then shadow = 75
             if object position y(1) > 40 and object position y(1) < 50  then shadow = 50
              if object position y(1) > 50 and object position y(1) < 60  then shadow = 25
              if object position y(1) > 60 then shadow = 10
              scale object 6, shadow, shadow, shadow
return
//__________________________________________________________________
thrust:
            // control and apply rocket thrust
            if spacekey() = 1 and konk = 0
                    fall# = fall# - .006
            endif
            
             
            
return
//__________________________________________________________________
score:
            // detect landing, check speed and determine win or lose.
            if object position y(1) = 3
                        score# = fall#
                        home = object collision (1,3)
                        if score# <.1 and home = 1
                                    // variable for random end of level message
                                    c = rnd(9)+1
                                    // repeat loop that holds the message on screen for 4 seconds
                                    repeat
                                                
                                                time1 = timer()/1000
                                                if time1>time2 then time3 = time3+1
                                                ink rgb(255,255,0),0
                                               draw to front: center text screen width()/2,screen height()/2, win$(c)
                                                time2 = timer()/1000
                                                text 0,0,score$
                                                sync
                                    until time3 > 3
                                    win = win + 1
                                    reset = 1
                        endif
             
                        //same as above for losing messages
                        if score# >.1 or home = 0
                                    c = rnd(9)+1
                                    repeat
                                    time1 = timer()/1000
                                    if time1>time2 then time3 = time3+1
                                    ink rgb(255,0,0),0
                                    if home = 1
                                            draw to front: center text screen width()/2,screen height()/2, lose$(c)
                                   else
                                            draw to front: center text screen width()/2,screen height()/2, "You need to land on the yellow square!!!"
                                    endif
                                   text 0,0,score$
                                    time2 = timer()/1000
                                    sync
                                    until time3 > 3
                                    if win > highscore
                                                highscore = win
                                                
                                                draw to camera:center text screen width()/2,screen height()/2, "HIGH SCORE!!! CONGRATULATIONS!!!"
                                                
                                                high$ = str$(highscore)
                                                highscore$ = "highest score: " + high$
                                    endif   
                                    win = 0
                                    reset = 1
                         endif
             endif
             //print stuff to screen
             score$ = str$(win) + " successfull landings"
             if win = 1 then score$ = str$(win) + " successfull landing"
             text 0,0,score$
             totalfuel$ = "fuel level: "+ fuel$
             text screen width() / 2,0,totalfuel$
             text 0,screen height() - 60,highscore$
return
//reset_the_game_for_next_round_____________________________________
reset:  
            sleep 2000
            repeat
                    draw to front: center text screen width()/2,screen height()/2,"press space to start again!"
                    text 0,0,score$
                    sync
            until KEYSTATE(57) = 1 or keystate(1) = 1
            position object 1,250,90,370
            repeat
                position object 3,rnd(240)+130,-2,rnd(150)+310
                peat = object visible (3)
            until peat = 1
            fall# = 0
            fuel = 20
            score# = 0
            konk = 0
            reset = 0
            ink rgb(255,255,0),0
            
return  
//Horizontal_controls_______________________________________________
control:
                
               if upkey() = 1 then move object 1,.5
               
               if downkey() = 1 then move object 1,-.5
               
               if rightkey() = 1 then move object right 1,.5
               
               if leftkey() = 1 then move object left 1,.5
 return
 //Intro_screen______________________________________________________
 startup:
 
             center text screen width()/2,screen height()/2 -200,"LOONEY LANDER"
             center text screen width()/2,screen height()/2+60,"CONTROLS"
             center text screen width()/2,screen height()/2+120,"Arrow keys for horizontal control"
             center text screen width()/2,screen height()/2+180,"Space bar for thrusters"
             center text screen width()/2,screen height()-100,"PRESS ANY KEY TO BEGIN"
             wait key
             cls
             center text screen width()/2,screen height()/2,"Get ready!"
             wait 2000
             cls
             center text screen width()/2,screen height()/2,"Go!"
             wait 1000
             cls             
 return
 //end_game__________________________________________________________
 gameover:
                     q = 0
                     sync off
                     cls
                     repeat
                                 a = timer()/1000
                                 cls
                                draw to front:center text screen width()/2,screen height()/2,"Thanks for playing!"
                                
                                if a>b then q = q+1
                                b = timer()/1000
                     until q = 5
 return
 //control_fuel_levels_______________________________________________
 fuel:
            fuel$ = ""
            for f = 0 to fuel
                fuel$ = fuel$ + fuelmarker$
            next f
            f1 = timer()/500
            if spacekey() = 1 and f1>f2 then fuel = fuel - 1
            f2 = timer()/500
            if fuel = 0 then konk = 1
 return

gosub startup:

gosub startup

if score# <.1 and home = 1
                                   
 if score# >.1 or home = 0

REM ===============================================
REM Title: Looney Lander Challenge
REM Author: Phaelax
REM Date: March 31, 2011
REM ===============================================

set display mode 1024, 768, 32

randomize timer()

#CONSTANT GRAV = 0.01
#CONSTANT EPSILON = 0.01

REM ==== start variables for terrain ========================
Global DEPTH = 5
numOfPts = 2^DEPTH + 1
Global PT_COUNT = numOfPts
Global LANDING_POINT = 0
dim points(numOfPts,2)
REM ==== end terrain variables ==============================

dim msg$(5)
msg$(1) = "Perfect!"  : ` < 0.3
msg$(2) = "Rough Landing" : ` 0.4 > 0.7
msg$(3) = "You got lucky!" : ` 0.7 > 1.0
msg$(4) = "Too hard!" : ` > 1.0
msg$(5) = "Kamikaze!" : ` >= 1.5


Type ShipObject
	x as float
	y as float
	vx as float
	vy as float
	thrust as float
EndType

ship as ShipObject
ship.thrust = 0.04
ship.x = 300


rem build a random lunar map
buildRandomMap()


hide mouse
sync on
sync rate 60

do
	cls
	
	rem add gravity to ship's vertical velocity
	inc ship.vy, GRAV
	
	rem player controls
	thrust = 0
	if upkey()
		thrust = 1
		dec ship.vy, ship.thrust
		if ship.vy < -1.5 then ship.vy = -1.5
	endif
	if rightkey()
		inc ship.vx, ship.thrust
	endif
	if leftkey()
		dec ship.vx, ship.thrust
	endif
	
	rem cheap form of wind resistance, pushes
	rem horizontal movement back to 0 velocity
	if ship.vx > 0 then dec ship.vx, 0.01
	if ship.vx < 0 then inc ship.vx, 0.01
	if abs(ship.vx) < EPSILON then ship.vx = 0
		

	rem check landing
	if ship.y+16 >= points(LANDING_POINT, 2)-1
		if ship.x-28 >= points(LANDING_POINT, 1) and ship.x+28 <= points(LANDING_POINT+2, 1)
			ship.y = points(LANDING_POINT, 2)-17
			if hasLanded# = 0 then hasLanded# = abs(ship.vy)+abs(ship.vx)
			if thrust = 0 then ship.vy = 0
		endif
	endif
	
	rem add velocity forces to ship's current position
	inc ship.x, ship.vx
	inc ship.y, ship.vy
	
	rem screen boundaries
	if ship.x > screen width()+21 then ship.x = -20
	if ship.x < -20 then ship.x = screen width()+20
	
	rem check collision
	for t = 1 to PT_COUNT-1
		`if t = LANDING_POINT or t = LANDING_POINT+1 then ink rgb(0, 255, 0), 0
		line points(t,1),points(t,2), points(t+1,1),points(t+1,2)
		
		rem check if ship's left leg is within this terrain segment's region
		if ship.x-28 >= points(t, 1) and ship.x-28 <= points(t+1, 1)
			y# = getHeight#(ship.x-28)
			rem if ship hit ground
			if ship.y+16 >= y#
				ship.vy = 0
				ship.y = y#-16
			endif
		endif
		rem check if ship's right leg is within this terrain segment's region
		if ship.x+28 >= points(t, 1) and ship.x+28 <= points(t+1, 1)
			y# = getHeight#(ship.x+28)
			rem if ship hit ground
			if ship.y+16 >= y#
				ship.vy = 0
				ship.y = y#-16
			endif
		endif
	next t
	
	
	
	
	
	rem draw the ship
	drawShip(ship.x, ship.y)

	
	if thrust = 1
		hasLanded# = 0
		t = rnd(10)+10
		ink rgb(255,128,0),0
		line ship.x-10, ship.y, ship.x, ship.y+t
		line ship.x+10, ship.y, ship.x, ship.y+t
		ink rgb(255,255,0),0
		line ship.x-7, ship.y, ship.x, ship.y+t-5
		line ship.x+7, ship.y, ship.x, ship.y+t-5
	endif
	
	
	drawTerrain()
	

	if hasLanded# > 0 then center text screen width()/2, 40, getLandingMessage$(hasLanded#)
		
	set cursor 0,0
	print "Landed: ", hasLanded#
	print "VX: ", ship.vx
	print "VY: ", ship.vy
	
	sync
loop


function getLandingMessage$(landingValue#)
	t$ = "Out of range"
	if landingValue# <= 0.3 then t$ = msg$(1)
	if landingValue# > 0.3 and landingValue# <= 0.7 then t$ = msg$(2)
	if landingValue# > 0.7 and landingValue# <= 1.0 then t$ = msg$(3)
	if landingValue# > 1.0 and landingValue# < 1.5 then t$ = msg$(4)
	if landingValue# >= 1.5 then t$ = msg$(5)
endfunction t$


REM ===============================================
REM Draws the lunar lander
REM ===============================================
function drawShip(x, y)
	ink rgb(255,255,255),0
	rem top
	DrawPolyCircle(x, y-20, 20, 6, 90)
	rem base
	box x-20, y-10, x+20, y
	rem left leg
	line x-20, y-5,  x-28, y+8
	line x-16, y,    x-28, y+8
	line x-28, y+8,  x-28, y+16
	line x-32, y+16, x-24, y+16
	rem right leg
	line x+20, y-5,  x+28, y+8
	line x+16, y,    x+28, y+8
	line x+28, y+8,  x+28, y+16
	line x+32, y+16, x+24, y+16
endfunction



REM ===============================================
REM Draw polygon with center at [x,y] and
REM a radius of 'r' with 'segs' number of
REM segments and rotated at 'Rot#' angle
REM ===============================================
function DrawPolyCircle(x,y,r,segs,Rot#)
	AngStep# = 360.0 / segs
	Ang# = Rot#
	For s = 1 To segs
		OldAng# = Ang#
		Ang# = Ang# + AngStep#
		x1 = x + (r * Sin(Ang#))
		y1 = y + (r * Cos(Ang#))
		x2 = x + (r * Sin(OldAng#))
		y2 = y + (r * Cos(OldAng#))
		Line x1,y1,x2,y2
	Next s
endfunction



REM ===============================================
REM 
REM ===============================================
function buildRandomMap()
	rem set begin and end points
	points(1,2) = screen height()
	points(PT_COUNT,2) = screen height()
	
	segLength = screen width() / (PT_COUNT-1)
	for i = 1 to PT_COUNT
		points(i, 1) = (i-1)*segLength
	next i

	
	rem call the midpoint displacement function
	midpoint(points(1,1),points(1,2),points(PT_COUNT,1),points(PT_COUNT,2),screen height()-50,500,0.6,DEPTH,1,PT_COUNT)
	rem smooth the terrain
	smooth()
	rem set landing point
	LANDING_POINT = rnd(PT_COUNT-2)
	points(LANDING_POINT+1, 2) = points(LANDING_POINT, 2)
	points(LANDING_POINT+2, 2) = points(LANDING_POINT, 2)
endfunction



REM ===============================================
REM 
REM ===============================================
function drawTerrain()
	for t = 1 to PT_COUNT-1
		ink rgb(255,255,255),0
		if t = LANDING_POINT or t = LANDING_POINT+1 then ink rgb(0, 255, 0), 0
		line points(t,1),points(t,2), points(t+1,1),points(t+1,2)
	next t
	
	rem show landing score
	ink rgb(0, 255, 0), 0
	center text points(LANDING_POINT+1, 1), points(LANDING_POINT+1, 2)+4, "10"
endfunction



REM ===============================================
REM recursive method using midpoint displacement
REM (x1,y1)    - starting point of line
REM (x2,y2)    - ending point of line
REM baseline   - the base or ground of where the points start
REM height#    - places midpoint Y-coord randomly between 0 and height#
REM h#         - 0 < h# <= 1 : higher makes a very ridged line, lower makes smoother
REM depth      - how many times should the line be split
REM arr1       - used for storing values in array
REM arr2       - used for storing values in array
REM ===============================================
function midpoint(x1,y1,x2,y2,baseline,height#,h#,depth, arr1,arr2)
   y = baseline - rnd(height#)
   arrIndex = arr1 + (arr2-arr1)/2

   points(arrIndex,2) = y

   dec depth, 1

   if depth > 0
      midpoint(x1,y1,x,y,baseline,height#*h#,h#,depth,arr1,arrIndex)
      midpoint(x,y,x2,y2,baseline,height#*h#,h#,depth,arrIndex,arr2)
   endif
endfunction



REM ===============================================
REM Smooths out terrain
REM ===============================================
function smooth()
   rem define an array to temporarily store the points.
   local dim temp(PT_COUNT)
   
   for i = 2 to PT_COUNT - 1
      y = points(i,2)
      y1 = points(i-1,2)
      y2 = points(i+1,2)
      temp(i) = (y+y1+y2)/3
   next i

   for i = 2 to PT_COUNT - 1
      points(i,2) = temp(i)
   next i
endfunction



REM ===============================================
REM Returns the height on the terrain at point X
REM ===============================================
function getHeight#(x as float)
	mapWidth# = points(PT_COUNT, 1) - points(1, 1)
	segLength# = mapWidth# / (PT_COUNT-1)
	p1 = ceil(x / segLength#)
	p2 = p1+1
	
	t# = (x - points(p1, 1)) / segLength#
	h# = points(p1, 2) + (points(p2, 2)-points(p1, 2))*t#
endfunction h#

Rem Project: Dark Basic Pro Project
Rem Created: Monday, May 30, 2011

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

set text font "courier new"
set text size 24

type particle
x as float
y as float
dx as float
dy as float
L# as float
endtype

dim pa(101) as particle

` THE OBJECT:
` LAND 10 SHIPS SUCCESSFULLY ON THE PLANET.
` GET A PERFECT SCORE


` dx# will hold the horizontal thrust, dy# holds vertical.
` grav# will be a constant downward acceleration.
` wind# can be a constant horizontal accel, either way.

 dim L(801)
 dim pad(801)
 
 global dx# as float
 global dy# as float
 
 global gs# as float
 global t1
 
 global grav# as float
 global wind# as float
 
 global x# as float
 global y# as float
 
 GLOBAL FUEL
 GLOBAL SCORE
 
 GLOBAL NP  
 GLOBAL SHIPS
 
 GLOBAL LANDINGS
 
cls
dot 0,0
get image 2,0,0,1,1,1


cls
for t=1 to 9
 read x,y
 box x*2,y*2,x*2+2,y*2+2 
next t
 get image 1,1,1,12,10,1
data 3,1 , 2,2 , 4,2 , 2,3 , 3,3 , 4,3
data 1,4 , 3,4 , 5,4


`jag=0

DO

SCORE=0
`highscore=0
SHIPS=10
LANDINGS=0

DO


for t=1 to 100
 pa(t).L#=-11.1
next t



at=500
goal=0

for t=0 to 800

 pad(t)=0
 if sprite exist(t+1)
  delete sprite t+1
 endif
 
if goal=0 or abs(at-goal)<3
 goal=rnd(60)-30+at
 if goal<300 then goal=400-rnd(50)
 if goal>580 then goal=520+rnd(50)
endif

if at>goal
 dec at,rnd(2)
else
 inc at,rnd(2)
endif

L(t)=at

next t



for t=7 to 11
 `y=450+rnd(100)
 
 ` find an x location that is not already a pad
repeat
 x=rnd(500)+50
 yes=1
  for z=x-3 to x+t*2+3
   if pad(z)>0 then yes=0
  next z
until yes=1

 y=L(x)+rnd(2)
 
  for z=x to x+t*2
   L(z)=y
   pad(z)=t
  next z
  
  
  
next t
 

cls

for t=1 to 100
 dot rnd(800),rnd(600)
next t

for t=0 to 800

  if pad(t)>0
   ink rgb(0,0,255),0
  else
   ink rgb(255,255,255),0
  endif
 dot t,L(t)

 
for u=l(t)+2 to 600 
 q=rnd(40)+70
 ink rgb(q,q,q),0
 dot t,u
next u
 
 
 if pad(t)=0
  sprite t+1,t,l(t),2
  size sprite t+1,1,600
  hide sprite t+1
 endif
 
next t

get image 99,0,0,800,600,1


x#=300+rnd(200)
y#=10

dx#=0
dy#=0

grav#=0.33
wind#=((rnd(34)-17)/51.17)*rnd(2)

FUEL=5000

`grav#=0
`wind#=0

t1=timer()
do
cls
gs#=(timer()-t1)*0.025
t1=timer()

paste image 99,0,0

w$=" >>>"
if wind#<0
 w$=" <<<"
endif

if abs(wind#)<0.01 then w$=""

text 0,250,"SPEED: "+str$(dy#*10,1)
text 0,150,"FUEL: "+str$(FUEL/50,1)
Center text 400,0,"SCORE : "+str$(SCORE)
text 0,200,"WIND: "+str$(wind#*100,1)+w$
text 0,100,"SHIPS: "+str$(ships)


dx=(rightkey()-leftkey())
dy=-upkey()

if fuel<1
 dx=0
 dy=0
endif

dx#=dx#+(wind#+dx)*0.0025
dy#=dy#+(grav#+(dy)*0.60)*0.02

IF dx or dy THEN DEC FUEL

x#=x#+dx#*gs#
y#=y#+dy#*gs#

if x#<5 then x#=5
if x#>795 then x#=795
if y#<5 then y#=5

sprite 999,x#,y#,1

`x#=mousex()
`y#=mousey()

`text 0,0,str$(sprite collision(999,0))

if sprite collision(999,0)>0

 CRASH()
 EXIT
else
  z=int(x#)
 if y#+9>L(z)
 
  yes=1
   for t=int(x#) to int(x#+11)
    if L(t)<>L(z)
     yes=0
    endif
   next t
   
    ` if you land too fast, you crash
   if dy#>3.1 then yes=0
   
  if yes=1
  `center text 400,330,"you have landed safely!"
     You_Win()
     EXIT
  else
  `center text 400,360,"CRASH LANDING!"
     CRASH()
     EXIT
  endif
   
  
 endif
endif

IF RND(2)=0

    if dy
     inc NP
      if NP>100 then NP=1
      
       pa(np).x=x#+5
       pa(np).y=y#+5
       pa(np).dx=(rnd(30)-15)*0.05
       pa(np).dy=(rnd(5)+9)*0.49
       pa(np).l#=31.1
    
    endif
    
    if dx : ` or dy
     inc NP
      if NP>100 then NP=1
      
       pa(np).x=x#+5
       pa(np).y=y#+5
       pa(np).dx=(-dx) * (rnd(5)+9)*0.39
       pa(np).dy=(rnd(30)-15)*0.05
       pa(np).l#=31.1
    
    endif

ENDIF
   


Particle_Control()

sync

` if returnkey() then exit

loop

if ships<1
 Game_Over()
 EXIT
endif

LOOP

 
LOOP
 

end



` particle trails and explosions.

Function Particle_Control()
INK RGB(255,0,0),0
 for t=1 to 100
  if pa(t).L#>0
   dec pa(t).L#,gs#
   pa(t).x=pa(t).x+pa(t).dx*gs#
   pa(t).y=pa(t).y+pa(t).dy*gs#
   dot pa(t).x,pa(t).y   
  endif
 next t
INK RGB(255,255,255),0
Endfunction 

Function CRASH()

 SCORE=(SCORE*2)/3
 DEC SHIPS

 for t=1 to 100
       
       pa(t).x=x#+5
       pa(t).y=y#+5
       pa(t).dx=(rnd(18)-9)*0.39
       pa(t).dy=(rnd(18)-9)*0.39
       pa(t).l#=33.1

 next t
 
 tim#=0.0
 DO
 CLS
  gs#=(timer()-t1)*0.025
  t1=timer()
  paste image 99,0,0
  hide sprite 999
  
  Particle_Control()
 
  center text 400,200,"YOU HAVE CRASHED!"
  if ships>0 then center text 400,280,"...Get Ready To Try Again..."
  
 inc tim#,gs#
 
 SYNC
 if returnkey() then exit
if tim#>50.0 then exit
 LOOP
        

 show sprite 999

Endfunction

Function You_Win()

z=int(x#)
padbon=(12-pad(z))
padbon=padbon*padbon

 INC SCORE,(50*padbon)+(ABS(SCORE))
 DEC SHIPS
 INC LANDINGS
 
` DO
 
  CLS
  PASTE IMAGE 99,0,0
  
  center text 400,200,"SAFE LANDING!"
  
  center text 400,240,"Landing Pad Multiplier : x"+str$(padbon)
`  center text 400,240," Bonus : "+str$(spdbon)
`  center text 400,260," Bonus : "+str$(winbon)
  
  if ships>0 then center text 400,280,"...Get Ready..."
 SYNC
wait 2500
 

Endfunction 



Function Game_Over()

for t=1 to 999
if sprite exist(t)
 delete sprite t
endif
next t

cls
center text 400,200,"GAME OVER"
center text 400,240,"You Landed "+str$(landings)+" Ships out of 10"
center text 400,280,"Your Final Score Is"
center text 400,320,str$(score)
center text 400,500,"Press Any Key To Try Again"
center text 400,540,"Or Escape To Quit"

sync
wait 1000
wait key

Endfunction


` 35882 my score.

for u=l(t)+2 to 600 
 q=rnd(40)+70
 ink rgb(q,q,q),0
 dot t,u
next u

REM ===============================================
REM Title: Looney Lander Challenge
REM Author: Phaelax
REM Date: March 31, 2011
REM ===============================================

set display mode 1024, 768, 32

randomize timer()

Global GRAV# = 0.01
Global FUEL = 1000
#CONSTANT EPSILON = 0.01
#CONSTANT WHITE = rgb(255,255,255)
#CONSTANT BROWN = rgb(72,43,2)
REM ==== start variables for terrain ========================
Global DEPTH = 5
numOfPts = 2^DEPTH + 1
Global PT_COUNT = numOfPts
Global LANDING_POINT = 0
Global LANDING_WIDTH = 0
dim points(numOfPts,2)
REM ==== end terrain variables ==============================

dim stars(100, 2)
for i = 1 to 100
	stars(i, 1) = rnd(screen width())
	stars(i, 2) = rnd(screen height())
next i



dim msg$(5)
msg$(1) = "Perfect!"  : ` < 0.3
msg$(2) = "Rough Landing" : ` 0.4 > 0.7
msg$(3) = "You got lucky!" : ` 0.7 > 1.0
msg$(4) = "Too hard!" : ` > 1.0
msg$(5) = "Kamikaze!" : ` >= 1.5


Type ShipObject
	x as float
	y as float
	vx as float
	vy as float
	thrust as float
EndType

ship as ShipObject
ship.thrust = 0.04
ship.x = 200 : ship.y = 133

drawShip(32, 40)
get image 1, 0, 0, 64, 57, 1
sprite 1, 0, 0, 1 : hide sprite 1
offset sprite 1, 32, 40


rem build a random lunar map
buildRandomMap(1)

rem build starting platform
drawPlatform()
get image 3, 0, 0, 100, 70, 1
	


hide mouse
sync on
sync rate 60

do
	cls
	
	rem background sky
	box 0, 0, 1024, 768, rgb(0,41,63),rgb(0,23,35),rgb(0,41,63),rgb(0,23,35)
	
	rem player controls
	thrust = 0
	if hasLanded# = 0
		if upkey() and FUEL > 0
			dec FUEL
			thrust = 1
			dec ship.vy, ship.thrust
			if ship.vy < -1.5 then ship.vy = -1.5
		endif
		
		if ship.vy <> 0
			if rightkey()
				inc ship.vx, ship.thrust
			endif
			if leftkey()
				dec ship.vx, ship.thrust
			endif
		endif
	endif
	
	rem add gravity to ship's vertical velocity
	inc ship.vy, GRAV#
	
	if scancode() = 59 and flag = 0 then buildRandomMap(1) : flag = 1 : hasLanded# = 0
	if scancode() = 60 and flag = 0 then buildRandomMap(2) : flag = 1 : hasLanded# = 0
	if scancode() = 61 and flag = 0 then buildRandomMap(3) : flag = 1 : hasLanded# = 0
	if scancode() = 62 and flag = 0 then buildRandomMap(4) : flag = 1 : hasLanded# = 0
	if scancode() = 0 then flag = 0
	
	
	
	rem cheap form of wind resistance, pushes
	rem horizontal movement back to 0 velocity
	if ship.vx > 0 then dec ship.vx, 0.01
	if ship.vx < 0 then inc ship.vx, 0.01
	if abs(ship.vx) < EPSILON then ship.vx = 0
		

	rem check landing
	if ship.y+16 >= points(LANDING_POINT, 2)-1
		if ship.x-28 >= points(LANDING_POINT, 1) and ship.x+28 <= points(LANDING_POINT+2, 1)
			ship.y = points(LANDING_POINT, 2)-17
			if hasLanded# = 0 then hasLanded# = abs(ship.vy)+abs(ship.vx)
			if thrust = 0 then ship.vy = 0
		endif
	endif
	
	rem add velocity forces to ship's current position
	inc ship.x, ship.vx
	inc ship.y, ship.vy
	
	rem rotate ship
	t# = ship.vx/1.5
	if t# > 1 then t# = 1
	if t# < -1 then t# = -1
	a# = 20*t#
	rotate sprite 1, a#
	
	rem calculate positions of landing feet
	x1 = ship.x + sin(118+a#)*32.249
	y1 = ship.y - cos(118+a#)*32.249
	
	x2 = ship.x - sin(62+a#)*32.249
	y2 = ship.y + cos(62+a#)*32.249
	

	rem screen boundaries
	if ship.x > screen width()+21 then ship.x = -20
	if ship.x < -20 then ship.x = screen width()+20
	
	

	rem check collision
	for t = 1 to PT_COUNT-1		
		rem check if ship's left leg is within this terrain segment's region
		if x2 >= points(t, 1) and x2 <= points(t+1, 1)
			y# = getHeight#(x2)
			rem if ship hit ground
			if y2 >= y#
				ship.vy = 0
				ship.y = y#-16
			endif
		endif
		rem check if ship's right leg is within this terrain segment's region
		if x1 >= points(t, 1) and x1 <= points(t+1, 1)
			y# = getHeight#(x1)
			rem if ship hit ground
			if y1 >= y#
				ship.vy = 0
				ship.y = y#-16
			endif
		endif
	next t
	
	rem platform
	if x1 >= 150 and x2 <= 250
		if (y1 >= 149 or y2 >= 149) and (y1 < 200 and y2 < 200) 
			ship.y = 133
			ship.vy = 0
		endif
	endif
	
	
	rem draw stars
	ink rgb(255,255,255),0
	for i = 1 to 100
		box stars(i, 1), stars(i, 2), stars(i, 1)+1, stars(i, 2)+1
		stars(i, 2) = stars(i, 2) - 1
		if stars(i, 2) < 0 then stars(i, 2) = screen height() : stars(i, 1) = rnd(screen width())
	next i
	
	
	paste image 3, 150, 150, 1
	
	rem draw the ship
	paste sprite 1, ship.x, ship.y
	
	
	
	if hasLanded# > 0
		set sprite diffuse 1, rnd(255), rnd(255), rnd(255)
	endif
	
	
	
	if thrust = 1
		hasLanded# = 0
		t = rnd(10)+10
		ink rgb(255,128,0),0
		line ship.x-10, ship.y, ship.x, ship.y+t
		line ship.x+10, ship.y, ship.x, ship.y+t
		ink rgb(255,255,0),0
		line ship.x-7, ship.y, ship.x, ship.y+t-5
		line ship.x+7, ship.y, ship.x, ship.y+t-5
	endif
	
	
	rem draw the mountains image
	paste image 2, 0, screen height()-500, 1




	rem draw landing pad
	ink 0, 0
	box points(LANDING_POINT,1),points(LANDING_POINT,2), points(LANDING_POINT+2,1),points(LANDING_POINT+2,2)+3
	inc r#, 0.5
	if r# > LANDING_WIDTH-3 then r# = 0
	ink rgb(255,255,0),0
	box points(LANDING_POINT, 1)+LANDING_WIDTH-r#, points(LANDING_POINT, 2), points(LANDING_POINT, 1)+LANDING_WIDTH-r#+3, points(LANDING_POINT, 2)+3
	box points(LANDING_POINT, 1)+LANDING_WIDTH+r#, points(LANDING_POINT, 2), points(LANDING_POINT, 1)+LANDING_WIDTH+r#+3, points(LANDING_POINT, 2)+3
	
	
	
	rem Fuel meter
	healthBar(412, 10, 200, 30, FUEL/1000.0)
	ink 0, 0
	center text 513, 19, "Fuel"
	ink WHITE, 0
	center text 512, 18, "Fuel"
	

	

	if hasLanded# > 0 then center text screen width()/2, 40, getLandingMessage$(hasLanded#)
	
	
	set cursor 0,0
	print screen fps()
	print "Landed: ", hasLanded#
	print "VX: ", ship.vx
	print "VY: ", ship.vy
	print FUEL
	
	sync
loop

function E2DC_Dot(x as integer, y as integer, color as dword )
   if x > 0 and x < screen width() and y > 0 and y < screen height()
      offset = get pixels pointer()
      pitch = get pixels pitch()
      bitsPerPixel = bitmap depth(0)/8
      pointer = offset + y*pitch + x*bitsPerPixel
      *pointer = color
   endif
endfunction

function getLandingMessage$(landingValue#)
	t$ = "Out of range"
	if landingValue# <= 0.3 then t$ = msg$(1)
	if landingValue# > 0.3 and landingValue# <= 0.7 then t$ = msg$(2)
	if landingValue# > 0.7 and landingValue# <= 1.0 then t$ = msg$(3)
	if landingValue# > 1.0 and landingValue# < 1.5 then t$ = msg$(4)
	if landingValue# >= 1.5 then t$ = msg$(5)
endfunction t$


REM ===============================================
REM Draws the lunar lander
REM ===============================================
function drawShip(x, y)
	ink rgb(255,255,255),0
	rem top
	DrawPolyCircle(x, y-20, 20, 6, 90)
	rem base
	box x-20, y-10, x+20, y
	rem left leg
	line x-20, y-5,  x-28, y+8
	line x-16, y,    x-28, y+8
	line x-28, y+8,  x-28, y+16
	line x-32, y+16, x-24, y+16
	rem right leg
	line x+20, y-5,  x+28, y+8
	line x+16, y,    x+28, y+8
	line x+28, y+8,  x+28, y+16
	line x+32, y+16, x+24, y+16
endfunction




REM ===============================================
REM Draw polygon with center at [x,y] and
REM a radius of 'r' with 'segs' number of
REM segments and rotated at 'Rot#' angle
REM ===============================================
function DrawPolyCircle(x,y,r,segs,Rot#)
	AngStep# = 360.0 / segs
	Ang# = Rot#
	For s = 1 To segs
		OldAng# = Ang#
		Ang# = Ang# + AngStep#
		x1 = x + (r * Sin(Ang#))
		y1 = y + (r * Cos(Ang#))
		x2 = x + (r * Sin(OldAng#))
		y2 = y + (r * Cos(OldAng#))
		line x1,y1,x2,y2
	Next s
endfunction



REM ===============================================
REM 
REM ===============================================
function buildRandomMap(difficulty)
	rem set begin and end points
	points(1,2) = screen height()-50
	points(PT_COUNT,2) = screen height()-50
	
	segLength = screen width() / (PT_COUNT-1)
	for i = 1 to PT_COUNT
		points(i, 1) = (i-1)*segLength
	next i

	
	rem call the midpoint displacement function
	midpoint(points(1,1),points(1,2),points(PT_COUNT,1),points(PT_COUNT,2),screen height()-50,500,0.6,DEPTH,1,PT_COUNT)
	rem smooth the terrain
	smooth()
	rem set landing point
	LANDING_POINT = rnd(PT_COUNT-4)+1
	points(LANDING_POINT+1, 2) = points(LANDING_POINT, 2)
	points(LANDING_POINT+2, 2) = points(LANDING_POINT, 2)
	
	rem easy
	if difficulty = 1
		points(LANDING_POINT-1, 2) = points(LANDING_POINT, 2) + (rnd(40)+40)
		points(LANDING_POINT+3, 2) = points(LANDING_POINT+2, 2) + (rnd(40)+40)
		GRAV# = 0.01
	endif
	rem medium
	if difficulty = 2
		GRAV# = 0.01
	endif
	rem hard
	if difficulty = 3
		points(LANDING_POINT-1, 2) = points(LANDING_POINT, 2) - (rnd(40)+40)
		points(LANDING_POINT+3, 2) = points(LANDING_POINT+2, 2) - (rnd(40)+40)
		GRAV# = 0.02
	endif
	rem expert
	if difficulty = 4
		points(LANDING_POINT-1, 2) = points(LANDING_POINT, 2) - (rnd(50)+100)
		points(LANDING_POINT+3, 2) = points(LANDING_POINT+2, 2) - (rnd(50)+100)
		GRAV# = 0.03
	endif
	
	FUEL = 1000
	LANDING_WIDTH = (points(LANDING_POINT+2, 1)-points(LANDING_POINT, 1)) / 2
	ship.x = 200 : ship.y = 133
	
	cls
	drawPlatform()
	if image exist(3) then delete image 3
	get image 3, 0, 0, 100, 70, 1
	
	
	
	cls
	drawTerrain()
	if image exist(2) then delete image 2
	get image 2, 0, screen height()-500, screen width(), screen height(), 1

endfunction



REM ===============================================
REM 
REM ===============================================
function drawTerrain()

	segLength# = screen width() / (PT_COUNT-1)
	
	for t = 1 to PT_COUNT-1
		rem fill the terrain
		ink BROWN,0
		
		y2 = max(points(t, 2), points(t+1, 2))
		for x = points(t,1) to points(t+1,1)
			t# = (x - points(t, 1)) / segLength#
			y = points(t, 2) + (points(t+1, 2)-points(t, 2))*t#
			box x, y, x+1, y2
		next x
		box points(t,1),y2, points(t+1,1),screen height()
	next t
	
	rem show landing score
	ink WHITE, 0
	center text points(LANDING_POINT+1, 1), points(LANDING_POINT+1, 2)+4, "10"
endfunction



REM ===============================================
REM 
REM ===============================================
function drawPlatform()
	tx = 0 : ty = 0
	for i = 0 to 5
		ax = 10+i*18
		ay = 50+(rnd(40)-20)
		if i = 5 then ax = 99 : ay = 3
		
		ink BROWN, 0
		for j = tx to ax
			l# = ax-tx
			t# = (j-tx)/l#
			k = ty + (ay-ty)*t#
			box j, 0, j+1, k
		next j
		tx = ax : ty = ay
	next i
endfunction



REM ===============================================
REM recursive method using midpoint displacement
REM (x1,y1)    - starting point of line
REM (x2,y2)    - ending point of line
REM baseline   - the base or ground of where the points start
REM height#    - places midpoint Y-coord randomly between 0 and height#
REM h#         - 0 < h# <= 1 : higher makes a very ridged line, lower makes smoother
REM depth      - how many times should the line be split
REM arr1       - used for storing values in array
REM arr2       - used for storing values in array
REM ===============================================
function midpoint(x1,y1,x2,y2,baseline,height#,h#,depth, arr1,arr2)
   y = baseline - rnd(height#)
   arrIndex = arr1 + (arr2-arr1)/2

   points(arrIndex,2) = y

   dec depth, 1

   if depth > 0
      midpoint(x1,y1,x,y,baseline,height#*h#,h#,depth,arr1,arrIndex)
      midpoint(x,y,x2,y2,baseline,height#*h#,h#,depth,arrIndex,arr2)
   endif
endfunction



REM ===============================================
REM Smooths out terrain
REM ===============================================
function smooth()
   rem define an array to temporarily store the points.
   local dim temp(PT_COUNT)
   
   for i = 2 to PT_COUNT - 1
      y = points(i,2)
      y1 = points(i-1,2)
      y2 = points(i+1,2)
      temp(i) = (y+y1+y2)/3
   next i

   for i = 2 to PT_COUNT - 1
      points(i,2) = temp(i)
   next i
endfunction



REM ===============================================
REM Returns the height on the terrain at point X
REM ===============================================
function getHeight#(x as float)
	mapWidth# = points(PT_COUNT, 1) - points(1, 1)
	segLength# = mapWidth# / (PT_COUNT-1)
	p1 = ceil(x / segLength#)
	if p1 = 0 then p1 = 1
	p2 = p1+1
	
	t# = (x - points(p1, 1)) / segLength#
	h# = points(p1, 2) + (points(p2, 2)-points(p1, 2))*t#
endfunction h#





REM ===============================================
REM x,y is the upper left corner of meter
REM P# ranges from 0 to 1
REM ===============================================
function healthBar(x, y, width, height, P#)
   rem gradient bar
   seg = width / 3
   box x, y, x+seg, y+height, rgb(255,0,0),rgb(255,0,0),rgb(255,128,0),rgb(255,128,0)
   box x+seg, y, x+seg+seg, y+height, rgb(255,128,0),rgb(255,128,0), rgb(255,255,0),rgb(255,255,0)
   box x+seg+seg, y, x+width, y+height, rgb(255,255,0),rgb(255,255,0), rgb(0,255,0),rgb(0,255,0)
   
   rem empty bit
   ink rgb(0,24,35),0
   box x+width*P#, y, x+width, y+height
   
   rem highlight
   c1 = 0xCCFFFFFF
   c2 = 0x33FFFFFF   
   box x, y, x+width, y+height*0.5, c2,c1,c2,c1
endfunction



REM ******************************************************************************************
REM 
REM	                                    ENHANCED 2D COMMANDS
REM
REM ******************************************************************************************



REM **************************************************
REM Xiaolin Wu's line algorithm.
REM **************************************************
function E2DC_Line_AA_ALPHA(x1, y1, x2, y2, color as dword)
	local dx as float
	local dy as float
	local xend as float
	local yend as float
	local xgap as float
	local ygap as float
	local xpxl1 as float
	local ypxl1 as float
	local xpxl2 as float
	local ypxl2 as float
	local intery as float
	local interx as float
        
	red   = rgbr(color)
	green = rgbg(color)
	blue  = rgbb(color)
	
	dx = x2-x1
	dy = y2-y1
        
	if abs(dx) > abs(dy)
		rem handle horizontal lines
		if x2 < x1
			ax = x1                 
			x1 = x2
			x2 = ax
			ay = y1
			y1 = y2
			y2 = ay
		endif
		gradient# = dy / dx
                
		rem handle first endpoint
		xend = ceil(x1)
		yend = y1 + gradient# * (xend-x1)
		xgap = 1.0 - fract#(x1 + 0.5)
		xpxl1 = xend : `used in main loop
		ypxl1 = int(yend)
		f# = 1-fract#(yend)*xgap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl1, ypxl1, xpxl1+1, ypxl1+1, c, c, c, c
		rem brightness: fract#(yend)*xgap
		f# = fract#(yend)*xgap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl1, ypxl1+1, xpxl1+1, ypxl1+2, c, c, c, c
		intery = yend + gradient# : `first y-intersection for main loop

		rem handle second endpoint
		xend = ceil(x2)
		yend = y2 + gradient# * (xend-x2)
		xgap = 1.0 - fract#(x2 + 0.5)
		xpxl2 = xend : `used in main loop
		ypxl2 = int(yend)
		f# = 1-fract#(yend)*xgap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl2, ypxl2, xpxl2+1, ypxl2+1, c, c, c, c
		f# = fract#(yend)*xgap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl2, ypxl2+1, xpxl2+1, ypxl2+2, c, c, c, c

		rem main loop
		a = xpxl1+1
		b = xpxl2-1
		for x = a to b
			f# = 1-fract#(intery) : `brightness
			alpha = 255*f#
			c = E2DC_ARGB(alpha, red, green, blue)
			box x, intery, x+1, intery+1, c, c, c, c
			f# = fract#(intery) : `brightness
			alpha = 255*f#
			c = E2DC_ARGB(alpha, red, green, blue)
			box x, intery+1, x+1, intery+2, c, c, c, c
			intery = intery + gradient#
		next x
                
	else
		rem handle vertical lines
		if y2 < y1
			ax = x1
			x1 = x2
			x2 = ax
			ay = y1
			y1 = y2
			y2 = ay
		endif
        
        gradient# = dx / dy

		rem handle first endpoint
		yend = ceil(y1)
		xend = x1 + gradient# * (yend-y1)
		ygap = 1.0 - fract#(y1 + 0.5)
		xpxl1 = int(xend)
		ypxl1 = yend            
		f# = 1-fract#(xend)*ygap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl1, ypxl1,  xpxl1+1, ypxl1+1, c, c, c, c
		intery = intery + gradient#
		f# = fract#(xend)*ygap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl1, ypxl1+1, xpxl1+1, ypxl1+2, c, c, c, c
		
		interx = xend + gradient# : `first y-intersection for main loop
		
		rem handle second endpoint
		yend = ceil(y2)
		xend = x2 + gradient# * (yend-y2)
		ygap = fract#(y2 + 0.5)
		xpxl2 = int(xend)
		ypxl2 = yend
		f# = 1-fract#(xend)*ygap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl2, ypxl2, xpxl2+1, ypxl2+1, c, c, c, c
		f# = fract#(xend)*ygap : `brightness
		alpha = 255*f#
		c = E2DC_ARGB(alpha, red, green, blue)
		box xpxl2, ypxl2+1, xpxl2+1, ypxl2+2, c, c, c, c
        
		rem main loop
		a = ypxl1+1
		b = ypxl2-1
		for y = a to b                  
			f# = 1-fract#(interx) : `brightness
			alpha = 255*f#
			c = E2DC_ARGB(alpha, red, green, blue)
			box interx, y, interx+1, y+1, c, c, c, c
			f# = fract#(interx) : `brightness
			alpha = 255*f#
			c = E2DC_ARGB(alpha, red, green, blue)
			box interx+1, y, interx+2, y+1, c, c, c, c
			interx = interx + gradient#
		next y
	endif
endfunction


REM **************************************************
REM Just a little helper function
REM **************************************************
function fract#(x as float)
        a# = x - int(x)
endfunction a#

REM **************************************************
REM Returns a color with an alpha value
REM **************************************************
function E2DC_ARGB(a,r,g,b)
	local c as dword
	c = (a*16777216)+(r*65536)+(g*256)+b
endfunction c

Rem Project: Lunandner
Rem Created: Wednesday, June 01, 2011

Rem ***** Main Source File *****


// If you're getting less than 60 FPS, try changing debugMode to 0
// If you're still getting less than 60, then may God have mercy on your soul. And may I also opt0mize moar bett0r
Global debugMode = 1

Setup(60, 800, 600, 32, 1)

Gosub _InitGame

LoadLevel()

Do
    Text 5, 5, Str$(Screen FPS())
    ControlLander()
    
    CheckLineIntersects(landy.pos.x, landy.pos.y, RayX(landy.pos.x, rayDist, landy.ang+235.0), RayY(landy.pos.y, rayDist, landy.ang+235.0))
    CheckLineIntersects(landy.pos.x, landy.pos.y, RayX(landy.pos.x, rayDist, landy.ang+180.0), RayY(landy.pos.y, rayDist, landy.ang+180.0))
    CheckLineIntersects(landy.pos.x, landy.pos.y, RayX(landy.pos.x, rayDist, landy.ang+125.0), RayY(landy.pos.y, rayDist, landy.ang+125.0))
    
    Rotate Sprite landy.spr, landy.ang
    Paste Sprite landy.spr, landy.pos.x, landy.pos.y
    
    Sync
Loop

_InitGame:
    Type Vec2D
        x As Float
        y As Float
    EndType
    
    Type Lander
        spr As Integer
        vel As Vec2D
        pos As Vec2D
        ang As Float
        angVel As Float
        rotSpeed As Float
        boostSpeed As Float
        stableVel As Float
        stableSpeed As Float
    EndType
    
    Type CollisionLine
        p1 As Vec2D
        p2 As Vec2D
        landerPad As Integer
    EndType
    
    Global landy As Lander
    landy.pos.x = 75
    landy.pos.y = 75
    landy.rotSpeed = 0.005
    landy.boostSpeed = -0.004
    landy.stableSpeed = -0.005
    
    Global grav As Float
    grav = 0.002
    
    Global rayDist As Float
    rayDist = 500.0
    
    Global intersectPoint As Vec2D
    
    Global MAX_POLYS = 10
    Global MAX_VERTICES = 255
    
    // Hit up the subroutine for the type defs and globals
    Gosub _InitYimPoly

    landy.spr = MakeLander()
    
    yimPolyKillItAll()
Return

Function ControlLander()
    leftState = KeyState(30)
    rightState = KeyState(32)
    midState = KeyState(31)
    
    stableLeftState = KeyState(16)
    stableRightState = KeyState(18)
    
    Inc landy.angVel, (leftState - rightState)*landy.rotSpeed
    Inc landy.ang, landy.angVel
    
    upVel# = (rightState + leftState)*(landy.boostSpeed*0.5) + midState*landy.boostSpeed
    stableVel# = (stableLeftState - stableRightState)*landy.stableSpeed
    
    Inc landy.vel.x, (Sin(landy.ang-180.0)*upVel#)+(Sin(landy.ang-90.0)*stableVel#)
    Inc landy.vel.y, (Cos(landy.ang)*upVel#)+(Cos(landy.ang+90.0)*stableVel#)
    
    Inc landy.vel.y, grav
    
    Inc landy.pos.x, landy.vel.x
    Inc landy.pos.y, landy.vel.y
EndFunction

Function RayX(x#, dist#, ang#)
    rx# = x# + Sin(ang#)*dist#
EndFunction rx#

Function RayY(y#, dist#, ang#)
    ry# = y# + Cos(ang#-180.0)*dist#
EndFunction ry#

Function CheckLineIntersects(ax1#, ay1#, ax2#, ay2#)
    ac = Array Count(collLines())
    closestIntersect# = 1000.0
    
    For i = 0 To ac
        bx1# = collLines(i).p1.x
        by1# = collLines(i).p1.y
        bx2# = collLines(i).p2.x
        by2# = collLines(i).p2.y        
        LineFunction(bx1#, by1#, bx2#, by2#, RGB(255,255,255), RGB(255,255,255))
        
        If LinesIntersect(ax1#, ay1#, ax2#, ay2#, bx1#, by1#, bx2#, by2#)
            ax2# = intersectPoint.x
            ay2# = intersectPoint.y
            dist# = Distance2D(ax1#, ay1#, ax2#, ay2#)
            If debugMode Then Center Text ax2#, ay2#, Str$(dist#)
            If dist# < closestIntersect# Then closestIntersect# = dist#
        EndIf
    Next i
    If closestIntersect# <= 50.0
       ` End
    EndIf
    If debugMode Then LineFunction(ax1#, ay1#, ax2#, ay2#, RGB(155,155,255), RGB(255,255,255))
EndFunction

Function LinesIntersect(x0#, y0#, x1#, y1#, x2#, y2#, x3#, y3#)
    seg1X# = x1# - x0#
    seg1Y# = y1# - y0#
    seg2X# = x3# - x2#
    seg2Y# = y3# - y2#

    div# = (-seg2X# * seg1Y# + seg1X# * seg2Y#)
    
    If div# = 0.0 Then ExitFunction 0
    
    s# = (-seg1Y# * (x0# - x2#) + seg1X# * (y0# - y2#)) / div#
    t# = (seg2X# * (y0# - y2#) - seg2Y# * (x0# - x2#)) / div#

    If s# >= 0.0 And s# <= 1.0 And t# >= 0.0 And t# <= 1.0
        intersectPoint.x = x0# + (t# * seg1X#)
        intersectPoint.y = y0# + (t# * seg1Y#)
        ExitFunction 1
    EndIf
EndFunction 0

Function Distance2D(x1#, y1#, x2#, y2#)
    dx# = x2#-x1#
    dz# = y2#-y1#
    res# = Sqrt(dx#*dx# + dz#*dz#)
EndFunction res#

Function LoadLevel()
    Dim collLines() As CollisionLine
    AddCollLine(0, 450, 300, 350, 0)
    AddCollLine(300, 350, 400, 350, 1)
    AddCollLine(400, 350, 600, 500, 0)
    AddCollLine(600, 500, 800, 500, 0)
EndFunction

Function AddCollLine(x1, y1, x2, y2, landerPad)
    Array Insert At Bottom collLines()
    ac = Array Count(collLines())
    collLines(ac).p1.x = x1
    collLines(ac).p1.y = y1
    collLines(ac).p2.x = x2
    collLines(ac).p2.y = y2
    collLines(ac).landerPad = landerPad
EndFunction

Function UnloadLevel()
    Undim collLines()
EndFunction

Function MakeLander()
    poly1 = yimPolyNew(RGB(255, 255, 255), RGB(123, 123, 123))
    poly2 = yimPolyNew(RGB(255,255,255), RGB(123,123,0))

    yimPolyAddVert(poly1, 10, 0)
    yimPolyAddVert(poly1, 40, 0)
    yimPolyAddVert(poly1, 50, 10)
    yimPolyAddVert(poly1, 50, 30)
    yimPolyAddVert(poly1, 40, 40)
    yimPolyAddVert(poly1, 10, 40)
    yimPolyAddVert(poly1, 0, 30)
    yimPolyAddVert(poly1, 0, 10)
    
    yimPolyAddVert(poly2, -2, 25)
    yimPolyAddVert(poly2, 18, 45)
    yimPolyAddVert(poly2, 32, 45)
    yimPolyAddVert(poly2, 52, 25)
    yimPolyAddVert(poly2, 52, 50)
    yimPolyAddVert(poly2, 67, 65)
    yimPolyAddVert(poly2, 75, 65)
    yimPolyAddVert(poly2, 75, 68)
    yimPolyAddVert(poly2, 57, 68)
    yimPolyAddVert(poly2, 57, 65)
    yimPolyAddVert(poly2, 64, 65)
    yimPolyAddVert(poly2, 51, 52)
    yimPolyAddVert(poly2, 27, 52)
    yimPolyAddVert(poly2, 27, 69)
    yimPolyAddVert(poly2, 35, 69)
    yimPolyAddVert(poly2, 35, 72)
    yimPolyAddVert(poly2, 16, 72)
    yimPolyAddVert(poly2, 16, 69)
    yimPolyAddVert(poly2, 24, 69)
    yimPolyAddVert(poly2, 24, 52)
    yimPolyAddVert(poly2, -1, 52)
    yimPolyAddVert(poly2, -14, 65)
    yimPolyAddVert(poly2, -7, 65)
    yimPolyAddVert(poly2, -7, 68)
    yimPolyAddVert(poly2, -25, 68)
    yimPolyAddVert(poly2, -25, 65)
    yimPolyAddVert(poly2, -17, 65)
    yimPolyAddVert(poly2, -2, 50)
    
    
    spr = FreeImage()
    Create Bitmap 1, 101, 101
    Set Current Bitmap 1
    yimPolyDraw(poly1, 25, 14, 1)
    yimPolyDraw(poly2, 25, 14, 1)
    Get Image spr, 0, 0, 101, 101, 1
    Set Current Bitmap 0
    Delete Bitmap 1
    
    Sprite spr, 0, 0, spr
    Hide Sprite spr
    Offset Sprite spr, 50, 50
EndFunction spr

Function Setup(rate, width, height, depth, windowed)
    Sync On : Sync Rate rate
    Set Display Mode width, height, depth
    If windowed Then Set Window On
    Backdrop On
    Color Backdrop 0
EndFunction

Function FreeImage()
    For i = 1 To 65535
        If Image Exist(i) = 0 Then ExitFunction i
    Next
EndFunction -1

Function TriangleFunction(x1, y1, x2, y2, x3, y3, color As Dword, filled)
    // Creates a triangle using preferred line function
    yimTriangle(x1, y1, x2, y2, x3, y3, color, filled)
    
    // Advanced2D Filled Triangle (FASTER)
    `If filled : a2FillTriangle x1, y1, x2, y2, x3, y3, color : Else : a2Triangle x1, y1, x2, y2, x3, y3, color : EndIf
    
EndFunction

Function LineFunction(x1, y1, x2, y2, lineColor1 As Dword, lineColor2 As Dword)
    //** Line using DBP Dots (TIME TO GET YOURSElf A PLUGIN)
    yimLine(x1, y1, x2, y2, lineColor1)
    
    //** Advanced2D Line (FASTER)
    `a2Line x1, y1, x2, y2, lineColor1, lineColor2
    
    //** D3D_Func Line (FASTEST)
    `D3D_Line x1, y1, x2, y2, lineColor1, lineColor2
  
EndFunction

_InitYimPoly:
    Type yimPolyVert
        x As Integer
        y As Integer
        color As Dword
    EndType
    
    Type yimPolyTri
        p1 As yimPolyVert
        p2 As yimPolyVert
        p3 As yimPolyVert
    EndType
    
    Type yimPoly
        numVerts As Integer
        numTris As Integer
        changed As Integer
        lineColor As Dword
        fillColor As Dword
    EndType
    
    Global numPolys = -1
    
    Dim yimPolys(MAX_POLYS) As yimPoly
    
    Dim yimPolyVertsGhost(MAX_POLYS, MAX_VERTICES) As yimPolyVert
    
    Dim yimPolyTriArray(MAX_POLYS, MAX_VERTICES) As yimPolyTri

Return

Function yimPolyKillItAll()
    Undim yimPolys()
    Undim yimPolyVertsGhost()
    Undim yimPolyTriArray()
EndFunction

Function yimPolyNew(lineColor As Dword, fillColor As Dword)
    Inc numPolys
    yimPolys(numPolys).numVerts = -1
    yimPolys(numPolys).lineColor = lineColor
    yimPolys(numPolys).fillColor = fillColor
EndFunction numPolys

Function yimPolyAddVert(poly As Integer, x As Integer, y As Integer)
    Inc yimPolys(poly).numVerts
    ac = yimPolys(poly).numVerts
    yimPolyVertsGhost(poly, ac).x = x
    yimPolyVertsGhost(poly, ac).y = y
    yimPolyVertsGhost(poly, ac).color = yimPolys(poly).lineColor
    yimPolys(poly).changed = 1
EndFunction ac

Function yimPolySetVertPosition(poly As Integer, vert As Integer, x As Integer, y As Integer)
    ac = yimPolys(poly).numVerts
    If x <> yimPolyVertsGhost(ac).x Or y <> yimPolyVertsGhost(ac).y Then yimPolys(poly).changed = 1
    yimPolyVertsGhost(poly, ac).x = x
    yimPolyVertsGhost(poly, ac).y = y
EndFunction

Function yimPolySetVertColor(poly As Integer, vert As Integer, color As Dword)
    ac = yimPolys(poly).numVerts
    yimPolyVertsGhost(poly, ac).color = color
EndFunction

Function yimPolyDraw(poly As Integer, x As Integer, y As Integer, filled As Integer)
    If filled
        If yimPolys(poly).changed
            yimPolyTriangulate(poly)
            yimPolys(poly).changed = 0
        EndIf
        
        
        ac = yimPolys(poly).numTris
        For i = 0 To ac
            x1 = x+yimPolyTriArray(poly, i).p1.x
            y1 = y+yimPolyTriArray(poly, i).p1.y
            x2 = x+yimPolyTriArray(poly, i).p2.x
            y2 = y+yimPolyTriArray(poly, i).p2.y
            x3 = x+yimPolyTriArray(poly, i).p3.x
            y3 = y+yimPolyTriArray(poly, i).p3.y            
            TriangleFunction(x1, y1, x2, y2, x3, y3, yimPolys(poly).fillColor, 1)
        Next i
    EndIf
    
    ac = yimPolys(poly).numVerts
    
    For i = 0 To ac
        lineColor1 = yimPolyVertsGhost(poly, i).color
        lineColor2 = yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).color
        x1 = x+yimPolyVertsGhost(poly, i).x
        y1 = y+yimPolyVertsGhost(poly, i).y
        x2 = x+yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).x
        y2 = y+yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).y
        LineFunction(x1, y1, x2, y2, lineColor1, lineColor2)
    Next i
EndFunction

Function yimLine(x1, y1, x2, y2, color As Dword) // ******* Conversion from: http://www.blitzbasic.com/codearcs/codearcs.php?code=1465
    Lock Pixels
    Steep = (Abs(Y2-Y1) > Abs(X2-X1))
    If Steep
        Temp=X1
        X1=Y1
        Y1=Temp        
        Temp=X2
        X2=Y2
        Y2=Temp
    EndIf
    DeltaX = Abs(X2-X1)
    DeltaY = Abs(Y2-Y1)
    Error = 0
    DeltaError = DeltaY
    X = X1
    Y = Y1
    XStep = -1
    If X1<X2 Then XStep = 1
    YStep = -1
    If Y1<Y2 Then YStep = 1
    
    If Steep
        Dot Y, X, color
    Else
        Dot X, Y, color
    EndIf
    
    While X<>X2
        Inc X, XStep
        Inc Error, DeltaError
        If (Error << 1)>DeltaX
            Inc Y, YStep
            Error=Error-DeltaX
        EndIf
        If Steep
            Dot Y, X, color
        Else
            Dot X, Y, color
        EndIf
    EndWhile
    Unlock Pixels
EndFunction

Function yimTriangle(x1, y1, x2, y2, x3, y3, color As Dword, filled) // ******* Conversion from Axel Wheeler's post on: http://www.blitzbasic.com/Community/posts.php?topic=93985
    If filled
        Local Xa As Float
        Local Xb As Float
        Local Xc As Float
        Local Ya As Float
        Local Yb As Float
        Local Yc As Float
        
        Xa = x1
        Ya = y1
        Xb = x2
        Yb = y2
        Xc = x3
        Yc = y3
        
        If Yb<Ya
            Xtemp#=Xa
            Ytemp#=Ya
            Xa=Xb
            Ya=Yb
            Xb=Xtemp#
            Yb=Ytemp#
        EndIf
        
        If Yc<Ya 
            Xtemp#=Xa
            Ytemp#=Ya
            Xa=Xc
            Ya=Yc
            Xc=Xtemp#
            Yc=Ytemp#
        EndIf
        
        If Yc<Yb
            Xtemp#=Xb
            Ytemp#=Yb
            Xb=Xc
            Yb=Yc
            Xc=Xtemp#
            Yc=Ytemp#
        EndIf
        
        For y#=Ya To Yc
            If Yc=Ya Then Yc=Yc+.00001
            proportionA#=(y#-Ya)/(Yc-Ya)
            Xlong#=Xa+(Xc-Xa)*proportionA#
            
            If y#<Yb
                If Yb = Ya Then Yb = Yb + .00001
                ProportionB#=(y#-Ya)/(Yb-Ya)
                Xshort#=Xa+(Xb-Xa)*ProportionB#
            Else
                If Yc = Yb Then Yc = Yc+.00001
                ProportionB#=(y#-Yb)/(Yc-Yb)
                Xshort#=Xb+(Xc-Xb)*ProportionB#
            EndIf
            
            LineFunction(Xlong#, y#, Xshort#, y#, color, color)
        Next y#
    Else
        LineFunction(x1, y1, x2, y2, color, color)
        LineFunction(x2, y2, x3, y3, color, color)
        LineFunction(x3, y3, x1, y1, color, color)
    EndIf
EndFunction

Function yimPolyTriangulate(poly)  // ******* Conversion from Warpy's post on: http://www.blitzbasic.com/Community/posts.php?topic=78165    
    
    yimPolys(poly).numTris = -1

    c = yimPolys(poly).numVerts
    
    Dim yimPolyVertsCopy(c) As yimPolyVert

    For i = 0 To c
        yimPolyVertsCopy(i).x = yimPolyVertsGhost(poly, i).x
        yimPolyVertsCopy(i).y = yimPolyVertsGhost(poly, i).y
    Next i
    
    Inc c
    
    If c < 3
        UnDim yimPolyVertsCopy()
        ExitFunction
    EndIf
    
    While c > 3
        i = 0
        go = 0
        While go = 0
            Local p1 As yimPolyVert
            Local p2 As yimPolyVert
            Local p3 As yimPolyVert
            
            p1 = yimPolyVertsCopy(i)
            p2 = yimPolyVertsCopy((i+1) Mod c)
            p3 = yimPolyVertsCopy((i+2) Mod c)
            
            Inc lastArrayPtr
            
            midx# = (p1.x + p2.x + p3.x) / 3.0
            midy# = (p1.y + p2.y + p3.y) / 3.0
                        
            hits=0
            For ii = 0 To c-1
                x1# = yimPolyVertsCopy(ii).x
                y1# = yimPolyVertsCopy(ii).y
                x2# = yimPolyVertsCopy((ii+1) Mod c).x
                y2# = yimPolyVertsCopy((ii+1) Mod c).y
                If (y1#-midy#) * (y2#-midy#) < 0.0
                    ix# = x1# + (x2#-x1#)*(midy#-y1#)/(y2#-y1#)
                    If ix# < midx# Then Inc hits
                EndIf
            Next ii

            If (hits Mod 2) = 1
                x1#=p1.x
                y1#=p1.y
                x2#=p3.x
                y2#=p3.y
                dx1#=x2#-x1#
                dy1#=y2#-y1#

                go = 1
                n = (i+3) Mod c
                While n<>i
                    x3#=yimPolyVertsCopy(n).x
                    y3#=yimPolyVertsCopy(n).y
                    dx2#=x3#-x2#
                    dy2#=y3#-y2#
                    
                    If dx1#<>dx2# Or x1#<>x2# Or dy1#<>dy2# Or y1#<>y2#
                        lambda#=(y2#-y1#+dy2#*(x1#-x2#)/dx2#)/(dy1#-dx1#*dy2#/dx2#)
                        mu#=(x1#-x2#+lambda#*dx1#)/dx2#
                        If lambda#>0 And lambda#<1
                            If mu#>=0 And mu#<=1
                                go=0
                            EndIf
                        EndIf
                    EndIf
                    x2#=x3#
                    y2#=y3#
                    n = (n+1) Mod c
                EndWhile
            EndIf
            
            If go = 0
                i = (i+1) Mod c
                If i = 0
                    UnDim yimPolyVertsCopy()
                    ExitFunction
                EndIf
            EndIf
        EndWhile
        
        yimPolyAddTri(poly, p1.x, p1.y, p2.x, p2.y, p3.x, p3.y)

        Array Delete Element yimPolyVertsCopy(), (i+1) Mod c
        
        Dec c
    EndWhile
    
    yimPolyAddTri(poly, yimPolyVertsCopy(0).x, yimPolyVertsCopy(0).y, yimPolyVertsCopy(1).x, yimPolyVertsCopy(1).y, yimPolyVertsCopy(2).x, yimPolyVertsCopy(2).y)
    
    UnDim yimPolyVertsCopy()
EndFunction

Function yimPolyAddTri(poly, x1, y1, x2, y2, x3, y3)
    Inc yimPolys(poly).numTris
    tTri As yimPolyTri
    tTri.p1.x = x1
    tTri.p1.y = y1
    tTri.p2.x = x2
    tTri.p2.y = y2
    tTri.p3.x = x3
    tTri.p3.y = y3
    yimPolyTriArray(poly, yimPolys(poly).numTris) = tTri
EndFunction

function max(a#, b#)
	if a# > b# then exitfunction a#
endfunction b#