Cubeeater [GAME]

User projects written in or related to FreeBASIC.
mrminecrafttnt
Posts: 76
Joined: Feb 11, 2013 12:23

Cubeeater [GAME]

Postby mrminecrafttnt » Oct 21, 2018 12:04

Here is my first game :)
You playing a red cube. User the mouse to eat other cubes. Have fun :)

Code: Select all

const level_incraser = .75
const beginnlevel = 1


type cube_2d
    x as double
    y as double
    c as integer
    size as double
    declare sub draw
    declare function is_hit(cube as cube_2d) as integer
end type


'draws our cube
sub cube_2d.draw
    line(x,y)-(x+size,y+size),c,bf
end sub

'checks if cube colodies with another cube
function cube_2d.is_hit(cube as cube_2d) as integer
    if x+size >= cube.x and x <= cube.x+cube.size and y+size >= cube.y and y <= cube.y+cube.size then
        return 1
    else
        return 0
    end if
end function


'example

sub add_cube(cubetable() as cube_2d,create as integer = 1)
    if create = 1 then
        redim preserve cubetable(ubound(cubetable)+1)
    end if
    with cubetable(ubound(cubetable))
        .x= int(rnd*640)+1
        .y= int(rnd*480)+1
        .c= int(rnd*15)+1
        .size = int(rnd*64)
    end with
end sub

sub game(level as integer)
   
    dim as double ki_speed = level * level_incraser
'setup screen

sleep
print "INIT"
'setup cubes
dim as cube_2d cubes(any),user
'setup for mouseparameter
dim as integer mx,my
setmouse 320,240,0

'setup for screenpage parameter
dim as integer scr0 = 0,scr1 = 1

'setup for cubes
'user cube
user.size = 16
user.c = 4

'create testcube
    for i as integer = 0 to 20
        add_cube(cubes())
    next
static as integer drawn   
dim as integer cubes_to_kill = ubound(cubes) + 1, killed_cubes
dim as integer oldkilledcubes
do
    getmouse mx,my
    'out of map detectection
    with user
        if .x + .size > 640 then setmouse mx-.size,my
        if .y + .size > 480 then setmouse mx,my-.size
        .x = mx - (user.size / 2)
        .y = my - (user.size / 2)   
    end with
   
    'draws the user(red)
   
   
    'simple object handling with colision detection
   
    Print "Cubekiller 0.1"
    Print "Kill all Cubes -  Level : ";Level; "(";killed_cubes;"/";cubes_to_kill;"Cubes killed) "
    if killed_cubes = cubes_to_kill then
        PRINT "YOU WON"
        exit do
    end if
           
    killed_cubes = 0
    for i as integer = lbound(cubes) to ubound(cubes)
       
        if cubes(i).size > 0 then
           
            'superb ki
            if user.x+user.size >= cubes(i).x and user.x < cubes(i).x+cubes(i).size then
                cubes(i).x-=ki_speed
            else
                if user.x+user.size <= cubes(i).x and user.x > cubes(i).x+cubes(i).size then
                    cubes(i).x+=ki_speed
                else
                    cubes(i).x-=ki_speed
                end if
               
            end if
            if user.y+user.size <= cubes(i).y and user.y > cubes(i).x+cubes(i).size then
                cubes(i).y+=ki_speed
            else
                if user.y+user.size >= cubes(i).y and user.y < cubes(i).x+cubes(i).size then
                    cubes(i).y-=ki_speed
                else
                    cubes(i).y+=ki_speed
                    end if
               
            end if
           
           
           
            if cubes(i).x+cubes(i).size > 640 then cubes(i).x= 1
            if cubes(i).y+cubes(i).size > 480 then cubes(i).y= 1
            if cubes(i).y <= 1 then cubes(i).y = 480-cubes(i).size
            if cubes(i).x <= 1 then cubes(i).x = 640-cubes(i).size
            cubes(i).draw
            if cubes(i).is_hit(user) = 1 then
                cubes(i).size-=1
                user.size+=.25
            end if
        else
            killed_cubes+=1
        end if
    next
    user.draw
   
    screensync
    drawn = 0
    cls
loop until inkey = chr(27)
end sub

screenres 640,480
game beginnlevel
dim as integer level
level = beginnlevel
do
    if level = 0 then
        level = beginnlevel
    else
        level +=  1
    end if
    game level
loop
grindstone
Posts: 595
Joined: May 05, 2015 5:35
Location: Germany

Re: Cubeeater [GAME]

Postby grindstone » Oct 21, 2018 18:23

When my cube touches the bottom line it jumps to a lower y-position (upward). Is this a bug or a feature?
BasicCoder2
Posts: 3321
Joined: Jan 01, 2009 7:03

Re: Cubeeater [GAME]

Postby BasicCoder2 » Oct 21, 2018 23:07

grindstone wrote:When my cube touches the bottom line it jumps to a lower y-position (upward). Is this a bug or a feature?

Maybe check for out of window bounds?

Code: Select all

do
    getmouse mx,my
 
    if mx<>-1 and my<>-1 then
        'out of map detectection
        with user
         '   if .x + .size > 640 then setmouse mx-.size,my
         '   if .y + .size > 480 then setmouse mx,my-.size
            .x = mx
            .y = my   
        end with
    end if
   ....
   
grindstone
Posts: 595
Joined: May 05, 2015 5:35
Location: Germany

Re: Cubeeater [GAME]

Postby grindstone » Oct 22, 2018 7:09

The cube is still jumping (sorry, can't figure out why at the moment due to lack of time).
mrminecrafttnt
Posts: 76
Joined: Feb 11, 2013 12:23

Re: Cubeeater [GAME]

Postby mrminecrafttnt » Oct 22, 2018 9:03

Simple disable the border detection with

Code: Select all

 
 .
 .
 .
    with user
       ' if .x + .size > 640 then setmouse mx-.size,my
        'if .y + .size > 480 then setmouse mx,my-.size
  .
  .
  .
end with
BasicCoder2
Posts: 3321
Joined: Jan 01, 2009 7:03

Re: Cubeeater [GAME]

Postby BasicCoder2 » Oct 22, 2018 19:36

I would suggest border detection is important?
Here is my take on your idea.

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls

type RECTANGLE
    as integer x
    as integer y
    as integer w
    as integer dx
    as integer dy
    as integer h
    as ulong   c
    as integer a
end type

function testCollision(s1 as RECTANGLE,s2 as RECTANGLE) as boolean
    return ((s1.y+s1.h) >( s2.y)) and ((s1.y) < (s2.y+s2.h)) and ((s1.x) < (s2.x+s2.w)) and ((s1.x + s1.w) > (s2.x))
end function

const recTotal = 25  'total number or rectangles

'create list of rectangle
dim shared as RECTANGLE rec(0 to recTotal)

'intialize rectangles
for i as integer = 0 to recTotal
    rec(i).x = int(rnd(1)*640)
    rec(i).y = int(rnd(1)*480)
    rec(i).w = int(rnd(1)*20)+10
    rec(i).h = int(rnd(1)*20)+10
    rec(i).c = rgb(int(rnd(1)*256), int(rnd(1)*256), int(rnd(1)*256))
    rec(i).a = 1   'alive
    rec(i).dx = int(rnd(1)*3)-1
    rec(i).dy = int(rnd(1)*3)-1
    while rec(i).dx = 0 and rec(i).dy = 0  'not moving
        rec(i).dx = int(rnd(1)*3)-1
        rec(i).dy = int(rnd(1)*3)-1
    wend
next i

sub moveRectangles()
    for i as integer = 1 to recTotal
        rec(i).x = rec(i).x + rec(i).dx
        rec(i).y = rec(i).y + rec(i).dy
        'test for collision with borders
        if rec(i).x < 0 or rec(i).x+rec(i).w > 639 or rec(i).y < 0 or rec(i).y+rec(i).h >479 then
            rec(i).x = rec(i).x - rec(i).dx  'undo move
            rec(i).y = rec(i).y - rec(i).dy
            'get new direction
            rec(i).dx = int(rnd(1)*3)-1
            rec(i).dy = int(rnd(1)*3)-1
            while rec(i).dx = 0 and rec(i).dy = 0  'not moving
                rec(i).dx = int(rnd(1)*3)-1
                rec(i).dy = int(rnd(1)*3)-1
            wend
        end if
    next i
end sub

sub moveRectangle0()
    dim as integer mx,my,mb
    getmouse mx,my,,mb
    if mb<>-1 then
        rec(0).x = mx
        rec(0).y = my
        'test it didn't expand beyond borders
        if rec(0).x < 0 then rec(0).x = 0
        if rec(0).y < 0 then rec(0).y = 0
        if rec(0).x+rec(0).w > 639 then rec(0).x = 639-rec(0).w
        if rec(0).y+rec(0).h > 479 then rec(0).y = 479-rec(0).h       
    end if
end sub

sub testCollisionWithEater()
    for i as integer = 1 to recTotal  'for each of the other rectangles
        if rec(i).a = 1 then  'does it exist
            if testCollision(rec(0),rec(i)) then
                rec(i).a = 0   'remove
                rec(0).w = rec(0).w + rec(i).w\2
                rec(0).h = rec(0).h + rec(i).h\2
                'test it didn't expand beyond borders
                if rec(0).x < 0 then rec(0).x = 0
                if rec(0).y < 0 then rec(0).y = 0
                if rec(0).x+rec(0).w > 639 then rec(0).x = 639-rec(0).w
                if rec(0).y+rec(0).h > 479 then rec(0).y = 479-rec(0).h
            end if
        end if
    next i
end sub

sub displayRectangles()
    screenlock
    cls
    for i as integer = 0 to recTotal
        if rec(i).a = 1 then   'is it alive?
            line (rec(i).x,rec(i).y)-(rec(i).x+rec(i).w,rec(i).y+rec(i).h),rec(i).c,bf  'color
            line (rec(i).x,rec(i).y)-(rec(i).x+rec(i).w,rec(i).y+rec(i).h),rgb(0,0,0),b 'black border
            draw string (rec(i).x,rec(i).y),str(i),rgb(0,0,0)
        end if
    next i
    screenunlock
end sub

do
    displayRectangles()
    moveRectangles()
    moveRectangle0()
    testCollisionWithEater()
    sleep 2
loop until multikey(&H01)
grindstone
Posts: 595
Joined: May 05, 2015 5:35
Location: Germany

Re: Cubeeater [GAME]

Postby grindstone » Oct 22, 2018 19:51

Jumping issue solved now. :-)

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests