Qbasicnews.com
October 17, 2018, 07:39:09 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: I present to you, Gem Hunt  (Read 6286 times)
speedlemon
I hold this place together
*****
Posts: 874



« on: June 26, 2006, 05:20:40 PM »

Warning: This game barely has any food in it.

GemHunt

How to play:
Click where you want to move.  Collect as many gems as you can.  But don't forget, you can only move 6 times!

I hope you enjoy playing this game.
Logged
Deleter
Na_th_an
*****
Posts: 1292



WWW
« Reply #1 on: June 26, 2006, 05:47:40 PM »

hmm...couldnt get the cheat code to work
i tried to set the clicks so i
pressed the combination
typed in the thing to set the number of clicks
pressed enter
typed in the number of clicks i wanted...but it didnt work

what am i doing wrong?

btw, fun game. Smiley
Logged

speedlemon
I hold this place together
*****
Posts: 874



« Reply #2 on: June 26, 2006, 05:51:01 PM »

dont read the following unless you want to spoil the food
first you press ctrl+c
then you type in
setclix
then you type in the number you want


i think i might've made a mistake in there. it should be setclix not setclicks.


Ok, I fixed the exe to now show the code correctly.

Thanks deleter for reviewing this game... and discovering the bug!
Logged
TheAdventMaster
Ancient Guru
****
Posts: 671


« Reply #3 on: June 26, 2006, 10:43:09 PM »

Wow interesting game.  Is this a test for a say, more advanced game?  I like the concept.
Logged
speedlemon
I hold this place together
*****
Posts: 874



« Reply #4 on: June 26, 2006, 11:12:41 PM »

Quote from: "TheAdventMaster"
Wow interesting game.  Is this a test for a say, more advanced game?  I like the concept.


I have no plans of making a more advanced version of this game right now.  Instead, I consider it a way for me to get back into FB since I've been gone for a while.
Anyways, I'm glad you enjoyed your time playing it.
Logged
Anonymous
Guest
« Reply #5 on: June 27, 2006, 12:59:07 AM »

Hi, Speedy, long time no see Smiley

....in the future you'd BETTER release source though, distributing binaries in a programmer community is just... meh.


btw, Really neat concept, and a cool game ^^
Logged
Ryan
Wandering Guru
***
Posts: 338



WWW
« Reply #6 on: June 27, 2006, 02:31:56 AM »

hah, neat game. Cool  Got 75% my first try... will keep at it.  Thanks!

(Ok.. MUST turn in for work... but I got 90% after a little more playtime.  Pretty addicting... wish there was replay instead of reloading every time. Wink And the first color change makes my head hurt. If it's random, it's the pink on mauve combination.  ugh)
Logged
speedlemon
I hold this place together
*****
Posts: 874



« Reply #7 on: June 27, 2006, 04:13:42 AM »

Here's the code Ruben:
Code:
restart:
#include "fbgfx.bi"
#define True 1
#define False 0
type XY
    X as single
    Y as single
end type
type tPlayer
    Position as XY
    Rotation as integer
    Radius as integer
    AimerRadius as integer
end type
type tGem
    position as xy
    radius as integer
    alive as integer
end type
dim shared as integer FPS,FramesDrawn,LastCheck
sub UpdateFPS()
    if int(timer)-LastCheck>=1 then
        FPS=FramesDrawn
        FramesDrawn=0
        LastCheck=int(timer)
    end if
    FramesDrawn+=1
end sub
function GetDistance(byval X1 as single,byval Y1 as single,byval X2 as single,byval Y2 as single) as single
    return sqr((X1-X2)^2+(Y1-Y2)^2)
end function
function CCC(byval X1 as integer,byval Y1 as integer,byval R1 as integer,byval X2 as integer,byval Y2 as integer,byval R2 as integer) as integer
    if GetDistance(X1,Y1,X2,Y2)>R1+R2 then
        return false
    else
        return true
    end if
end function
function Face(byval Rotation as integer,byval X as integer,byval Y as integer,byval XTarget as integer,byval YTarget as integer) as integer
    dim as single faceradians,facedegrees
    faceradians=atan2(YTarget-Y,XTarget-X)
    facedegrees=faceradians*180/3.1415926535897932384626433832795
    return facedegrees+90
end function
function MoveForward(byval X as integer,byval Y as integer,byval Rotation as integer,byval Amount as integer) as XY
    dim newxy as xy
    newxy.x=x
    newxy.y=y
    newxy.x-=sin(rotation*(3.1415926535897932384626433832795/180))*Amount*-1
    newxy.y-=cos(rotation*(3.1415926535897932384626433832795/180))*Amount
    return newxy
end function
randomize timer
dim shared Work_Page as integer
Work_Page = 0
windowtitle "The Hunt"
screenres 800,600,32,2,1
setmouse ,,0
LastCheck=int(timer)
dim ctarget as xy
ctarget.x=400
ctarget.y=300
dim canclick as integer
canclick=false
dim ClicksLeft as integer
dim Score as integer
dim MouseX as integer
dim MouseY
dim Buttons as integer
dim Player as tPlayer
Player.Position.X=400
Player.Position.Y=300
Player.AimerRadius=10
Player.Radius=30
ClicksLeft=6
Score=0
dim Gem(1 to 50) as tgem
for makegems=1 to ubound(Gem)
    gem(makegems).position.x=int(rnd(1)*800)+1
    gem(makegems).position.y=int(rnd(1)*600)+1
    gem(makegems).radius=int(rnd(1)*20)+10
    gem(makegems).alive=true
next
color rgb(0,0,0),rgb(255,255,255)
do
    getmouse MouseX,MouseY,,Buttons
    UpdateFPS
    player.rotation=face(player.rotation,player.position.x,player.position.y,ctarget.x,ctarget.y)
    player.position=moveforward(player.position.x,player.position.y,player.rotation,getdistance(player.position.x,player.position.y,ctarget.x,ctarget.y)/10)
    if buttons and 1 then
        if canclick=true then
            canclick=false
            ctarget.x=mousex
            ctarget.y=mousey
            clicksleft-=1
        end if
    else
        canclick=true
    end if
    for drawgems=1 to ubound(gem)
        if gem(drawgems).alive=true then
            circle(gem(drawgems).position.x,gem(drawgems).position.y),gem(drawgems).radius
        end if
    next
    for cc=1 to ubound(gem)
        if gem(cc).alive=true then
            if ccc(player.position.x,player.position.y,player.radius,gem(cc).position.x,gem(cc).position.y,gem(cc).radius)=true then
                gem(cc).alive=false
                score+=gem(cc).radius
            end if
        end if
    next
    circle(Player.Position.X,Player.Position.Y),Player.Radius
    circle(MouseX,MouseY),Player.AimerRadius
    line(mousex,mousey)-(player.position.x,player.position.y)
    if clicksleft<=-1 then
        mostpossible=0
        for countup=1 to ubound(gem)
            mostpossible+=gem(countup).radius
        next
        percent=(score/mostpossible)*100
        do
            locate 20,10
            print "Your final score was: ";score
            locate 23,10
            print "Most possible was: ";mostpossible
            locate 26,10
            print "You got ";percent;"%"
            locate 29,10
            if percent<75 then
                print "Get 75% or higher to unlock the cheat codes."
            else
                print "codes: to enter codes press ctrl+c during game"
                locate 30,10:print "after entering the code, you may need to enter the value"
                locate 31,10:print "cc  =  changes look of the game"
                locate 32,10:print "setclix  =  after doing this, type in new amount of clicks"
                locate 33,10:print "setscore  =  after doing this, type in new score"
            end if
            locate 37,10
            print "Press the space key to close or r to restart"
            if multikey(sc_r) then goto restart
            screenset Work_Page, Work_Page xor 1
            screensync
            cls
            Work_Page = Work_Page xor 1
        loop while not multikey(sc_space)
        end
    end if
    locate 2,2:print "FPS: ";FPS
    locate 5,2:print "Score: ";Score
    locate 7,2:print "Clicks Left: ";clicksleft
    if multikey(sc_c) and multikey(sc_control) then
        input code$
        if code$="setclix" then input clicksleft
        if code$="setscore" then input score
        if code$="cc" then color rgb(int(rnd(1)*255)+1,int(rnd(1)*255)+1,int(rnd(1)*255)+1),rgb(int(rnd(1)*255)+1,int(rnd(1)*255)+1,int(rnd(1)*255)+1)
    end if
    screenset Work_Page, Work_Page xor 1
    screensync
    cls
    Work_Page = Work_Page xor 1
loop while not multikey(SC_Escape)
end


Ryan, replay has been added in the source above (i couldn't upload the updated exe. it seems fileanchor is not working at the moment.). :wink:  Thanks for the advice.
By the way, very nice score Ryan. I think the most I've gotten is around 85%
Logged
Anonymous
Guest
« Reply #8 on: June 27, 2006, 04:41:07 AM »

It's pretty nice, man. You encapsulated into subroutines pretty well Smiley Very easy to understand exactly what's going on.

btw, type XY is actually what you call a 'vector' =) maybe you know that...
Logged
relsoft
*/-\*
*****
Posts: 3927



WWW
« Reply #9 on: June 27, 2006, 10:51:51 AM »

cool!!!
Logged

y smiley is 24 bit.


Genso's Junkyard:
http://rel.betterwebber.com/
Dr_Davenstein
Na_th_an
*****
Posts: 2052


« Reply #10 on: June 28, 2006, 01:53:12 AM »

Heh... Pretty cool. Nice, original idea!  Tongue
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!