Frogger revisited

User projects written in or related to FreeBASIC.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Frogger revisited

Post by BasicCoder2 »

Couldn't help getting a rough demo version of the frogger program working when trying to answer some of Affinity4Code420's questions and thought I might as well post it in case it might be useful for someone.

Up cursor key moves frog, space bar resets game and esc key exits game.

Code: Select all

#include "fbgfx.bi"
using fb

screenres 640,480,32

type sprite
    x  as integer
    y  as integer
    dx as integer
    dy as integer
    w  as integer
    h  as integer
    speed as integer
end type

function scollision(s1 as sprite, s2 as sprite) as integer
        
    dim as integer hit
    hit = 0

    if s1.x >= s2.x and s1.x <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 1
        end if
        if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
            hit = 2
        end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then 'overlap
            hit = 3
        end if
    end if

    if s1.x + s1.w >= s2.x and s1.x + s1.w <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 4
        end if
        if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
            hit = 5
        end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then  'overlap
            hit = 6
        end if   
    end if

    return hit

end function


dim shared frog as sprite

dim shared car(1 to 4) as sprite

dim shared croc(1 to 4) as sprite


dim as string text  'to read data statements

cls
dim as FB.Image ptr iFrog = imagecreate(21,23,0)
for j as integer = 0 to 22
    read text
    for i as integer = 0 to 20
        if mid(text,i+1,1)="P" then
            pset(i,j),&HFFFF00FF
        end if
        if mid(text,i+1,1)="B" then
            pset(i,j),&HFF000000
        end if
        if mid(text,i+1,1)="G" then
            pset(i,j),&HFF00FF00
        end if
        if mid(text,i+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
    next i
next j
get (0,0)-(20,22), iFrog

dim as FB.Image ptr deadFrog = imagecreate(21,23,0)
for j as integer = 0 to 22
    for i as integer = 0 to 20
        if point(i,j) = &HFF00FF00 then
            pset(i,j),&HFFFF0000
        end if
        if point(i,j)=&HFFFFC90E then
            pset(i,j),&HFF0000FF 
        end if
    next i
next j
get (0,0)-(20,22), deadFrog


'create a car
cls
dim as FB.Image ptr icar1 = imagecreate(40,20,0)
for j as integer = 0 to 19
    read text
    for i as integer = 0 to 39
        if mid(text,i+1,1)="P" then
            pset(i,j),&HFFFF00FF
        end if
        if mid(text,i+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,i+1,1)="W" then
            pset (i,j),&HFFFFFFFF
        end if
        if mid(text,i+1,1)="R" then
            pset (i,j),&HFFED1C24
        end if
    next i
next j
get (0,0)-(39,19), icar1

dim as FB.Image ptr iCar2 = imagecreate(40,20,0)
'flip car image horizontally
dim as integer k,v
for j as integer = 0 to 19
    for i as integer = 0 to 19
        v=point(i,j)
        pset(i,j),point(39-i,j)
        pset(39-i,j),v
    next i
next j
get (0,0)-(39,19), iCar2


'create a crocs
cls
dim as FB.Image ptr icroc1 = imagecreate(80,20,0)
for i as integer = 0 to 79
    read text
    for j as integer = 0 to 19
        if mid(text,j+1,1)="P" then
            pset (i,j),&HFFFF00FF
        end if
        if mid(text,j+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,j+1,1)="G" then
            pset(i,j),&HFF22B14C
        end if
        if mid(text,j+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
        if mid(text,j+1,1)="X" then
            pset(i,j),&HFF3F48CC
        end if
    next j
next i
get (0,0)-(79,19), icroc1

dim as FB.Image ptr icroc2 = imagecreate(80,20,0)
'flip croc image horizontally
for j as integer = 0 to 19
    for i as integer = 0 to 39
        v=point(i,j)
        pset(i,j),point(79-i,j)
        pset(79-i,j),v
    next i
next j
get (0,0)-(79,19), icroc2

'create a crocs
cls
dim as FB.Image ptr icrocA1 = imagecreate(80,20,0)
for i as integer = 0 to 79
    read text
    for j as integer = 0 to 19
        if mid(text,j+1,1)="P" then
            pset (i,j),&HFFFF00FF
        end if
        if mid(text,j+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,j+1,1)="G" then
            pset(i,j),&HFF22B14C
        end if
        if mid(text,j+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
        if mid(text,j+1,1)="X" then
            pset(i,j),&HFF3F48CC
        end if
    next j
next i
get (0,0)-(79,19), icrocA1

dim as FB.Image ptr icrocA2 = imagecreate(80,20,0)
'flip croc image horizontally
for j as integer = 0 to 19
    for i as integer = 0 to 39
        v=point(i,j)
        pset(i,j),point(79-i,j)
        pset(79-i,j),v
    next i
next j
get (0,0)-(79,19), icrocA2

bload "C:\FreeBasic\bitmaps\sprites\backGround.bmp"
'draw background
line (0,0)-(372,31),rgb(255,128,0),bf      'orange display area
line (0,32)-(372,62),rgb(0,128,0),bf       'green home
line (0,63)-(372,191),rgb(128,255,255),bf  'blue river
line (0,192)-(372,223),rgb(0,128,0),bf     'green safe spot
line (0,224)-(372,351),rgb(192,192,192),bf 'gray road
line (0,352)-(372,383),rgb(0,128,0),bf     'green start
line (0,384)-(372,415),rgb(255,128,0),bf   'orange display area
for i as integer = 0 to 5
    circle (i*62+31,47),12,rgb(128,0,0),,,,f 'frog holes
next i
'lines on road
line (0,256)-(372,256),rgb(255,255,0)  'yellow lines
line (0,288)-(372,288),rgb(255,255,0)
line (0,320)-(372,320),rgb(255,255,0)


'display text
locate 2,1
color rgb(0,0,0),rgb(255,128,0)  'black on orange
print "   FROGGER GAME   "

dim as FB.Image ptr backGround = imagecreate(372,416,0)
get (0,0)-(371,415),backGround

dim as string reply

do
    reply = ""  'signal to keep going while reply <> "y" or "x"
    frog.x=170
    frog.y=357
    frog.w=21
    frog.h=23
    frog.speed=32

    car(1).x = 0
    car(1).y = 230
    car(1).dx = 1
    car(1).dy = 0
    car(1).w = 40
    car(1).h = 20

    car(2).x = 300
    car(2).y = 262
    car(2).dx = 1
    car(2).dy = 0
    car(2).w = 40
    car(2).h = 20

    car(3).x = 150
    car(3).y = 294
    car(3).dx = 1
    car(3).dy = 0
    car(3).w = 40
    car(3).h = 20

    car(4).x = 30
    car(4).y = 326
    car(4).dx = 1
    car(4).dy = 0
    car(4).w = 40
    car(4).h = 20

    croc(1).x = 0
    croc(1).y = 72
    croc(1).dx = 1
    croc(1).dy = 0
    croc(1).w = 80
    croc(1).h = 20

    croc(2).x = 300
    croc(2).y = 104
    croc(2).dx = 1
    croc(2).dy = 0
    croc(2).w = 80
    croc(2).h = 20

    croc(3).x = 150
    croc(3).y = 136
    croc(3).dx = 1
    croc(3).dy = 0
    croc(3).w = 80
    croc(3).h = 20

    croc(4).x = 30
    croc(4).y = 168
    croc(4).dx = 1
    croc(4).dy = 0
    croc(4).w = 80
    croc(4).h = 20

    dim as integer chosenLog
    chosenLog = 0

    dim as double now
    now = 0

    do
        screenlock()

        cls
        'draw background
        put (0,0),backGround,pset

        'draw croc under frog
        
        for i as integer = 1 to 4
            if croc(i).dx < 0 then
                if chosenLog = i then
                    put (croc(i).x,croc(i).y),icrocA2,trans
                else
                    put (croc(i).x,croc(i).y),icroc2,trans
                end if
            else
                if chosenLog = i then
                    put (croc(i).x,croc(i).y),icrocA1,trans
                else
                    put (croc(i).x,croc(i).y),icroc1,trans
                end if
            end if
        next i

        'draw dead frog if speed = 0 else draw live frog
        if frog.speed = 0 then
            put (frog.x,frog.y),deadFrog,trans  'change to a dead frog sprite later
        else
            put (frog.x,frog.y),iFrog, trans
        end if

        'draw cars on top of frog
        for i as integer = 1 to 4
            if car(i).dx < 0 then
                put(car(i).x,car(i).y),iCar2,trans  'moving left
            else
               put (car(i).x, car(i).y ), iCar1, trans 'moving right
           end if
        next i

        locate 50,1
        if frog.speed = 0 then
            print "  ****  FROG DEAD  ****"
        end if
        if frog.y < 64 then
            print "  ****  FROG HOME  ****"
        end if

        print " HIT SPACE KEY to start again OR ESC key to END program"

        screenunlock()

        'update car positions
        for i as integer = 1 to 4
            car(i).x = car(i).x + car(i).dx
        next i

        'update log positions
        for i as integer = 1 to 4 
            croc(i).x = croc(i).x + croc(i).dx
           'update frog.x position if on log
            if chosenLog = i then
                frog.x = frog.x + croc(i).dx
            end if
        next i

        'reverse car directions if out of bounds
        for i as integer = 1 to 4
            if car(i).x < 0 or car(i).x > 332 then car(i).dx=-car(i).dx
        next i

        'reverse croc directions if out of bounds
        for i as integer = 1 to 4
            if croc(i).x < 0 or croc(i).x > 312 then croc(i).dx=-croc(i).dx
        next i

        'user input accepted only every 0.25 seconds - feels like the real thing
        if timer > (now + 0.25) then

            if multikey(SC_SPACE) then reply = "y"
            if multikey(SC_ESCAPE) then reply = "x"

            if frog.y > 63 then  'test frog hasn't reached home
                if multikey(SC_DOWN) andalso frog.y <352 then
                    frog.y = frog.y+frog.speed
                    now = timer
                    chosenLog=0
                end if

                if multikey(sc_up)  then
                    frog.y = frog.y-frog.speed
                    now = timer   'reset timer
                    chosenLog = 0 'if log remove log ID
                end if

                if multikey(SC_right) andalso frog.x < 302 then
                    frog.x = frog.x+frog.speed
                    now = timer
                    chosenLog=0
                end if

                if multikey(sc_left) andalso  frog.x > 10  then
                    frog.x = frog.x-frog.speed
                    now = timer   
                    chosenLog = 0 
                end if
            end if

        end if

        dim as integer hit

        if frog.y < 352 and frog.y > 224 then
            'test for collision with car
            hit = 0
            for i as integer = 1 to 4
                if hit = 0 then
                    hit = scollision(frog,car(i))
                end if
            next i

            if hit <> 0 then
                frog.speed = 0  'flag frog dead
            end if

        end if

        if frog.y < 192 and frog.y > 64 then
            'test collision with a log
             hit = 0
            for i as integer = 1 to 4

                hit = scollision(frog,croc(i))

                if hit <> 0 and chosenLog = 0  then
                    chosenLog = i
                end if

            next i

            if  chosenLog=0 then
                locate 1,1
                print "MISSED LOG"
                frog.speed = 0
                sleep
            end if

        end if


        sleep 10, 1

    loop while reply <> "y" and reply <> "x"

loop while reply = "y"

end

'frog image 21 x 23
DATA "PPPPPPPPPBBBPPPPPPPPP"
DATA "PPPPPBBBBGGGBBBBPPPPP"
DATA "PPPPBYBBYBGBYBBYBPPPP"
DATA "PPPPBYBBYBGBYBBYBPPPP"
DATA "PBBPBYYYYBGBYYYYBPBBP"
DATA "BGGBPBBBBGGGBBBBPBGGB"
DATA "PBGGBBGGGGGGGGGBBGGBP"
DATA "BGGGGBBGGGBGGGBBGGGGB"
DATA "PBGGGBBBBGBGBBBBGGGBP"
DATA "BGGGGGBGGGBGGGBGGGGGB"
DATA "PBBBGBGGGGGGGGGBGBBBP"
DATA "PPPPBBGGGGBGGGGBBPPPP"
DATA "PPPPBGGGGGBGGGGGBPPPP"
DATA "PPPPBGGGGGBGGGGGBPPPP"
DATA "PBBBBGGGGGBGGGGGBBBBP"
DATA "PBGGGBGGGGBGGGGBGGGBP"
DATA "PBGGGGBGGGBGGGBGGGGBP"
DATA "PBBGGGBGGGBGGGBGGGBBP"
DATA "PPBGBGGBGGBGGBGGBGBPP"
DATA "PBBBGGGBGGGGGBGGGBBBP"
DATA "PBGGGBBGBGGGBGBBGGGBP"
DATA "PBBBGGBBBGGGBBBGGBBBP"
DATA "PPPPBBBPPBBBPPBBBPPPP"


'car3D data
DATA "PPPPPBBBBBBBBBBBBBBBBBBBBBPPPPPPPPPPPPPP"
DATA "PPPPBRRRRRRRRRRRRRRRRRRRBWBPPPPPPPPPPPPP"
DATA "PPPBBRRRRRRRRRRRRRRRRRRRBWWBBPPPPPPPPPPP"
DATA "PPBWBRRRRRRRRRRRRRRRRRRRBWWWWBPPPPPPPPPP"
DATA "PBBWBRRRRRRRRRRRRRRRRRRRBWWWWWBBBBBBBBBB"
DATA "BRBWBRRRRRRRRRRRRRRRRRRRBWWWWWWBRRRRRRRB"
DATA "BRBWBRRRRRRRRRRRRRRRRRRRBWWWWWWBRRRRRRRB"
DATA "BRBWBBBBBBBBBBBBBBBBBBBBBBWWWWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBBWWWWWBRRRRRBRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWBWWWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWBBWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWWWBWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWWWWBBRRRRRRRB"
DATA "BRBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
DATA "BRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRB"
DATA "BRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRB"
DATA "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
DATA "PBBBBBBBBPPPPPPPPPPPPPPPPPPPPPPBBBBBBBBB"
DATA "PPBBBBBBPPPPPPPPPPPPPPPPPPPPPPPPBBBBBBBP"
DATA "PPPBBBBPPPPPPPPPPPPPPPPPPPPPPPPPPBBBBBPP"

'croc data
DATA "PPPPPPPPPPPPPPBBXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPPBGGXBP"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPPBGXGPP"
DATA "PPPPPPPPPPPPPBBGXXPX"
DATA "PPPPPPPPPPPPBBGGXXGX"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPPBGXXXX"
DATA "PPPPPPPPPPPPBBBGGXXP"
DATA "PPPPPPPPPPPPBGGGGXBP"
DATA "PPPPPPPPPPPPBBGGGXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPBGGGXBP"
DATA "PPPPPPPPPPPPBBGGGGXP"
DATA "PPPPPPPPPPPPBBGGBGXB"
DATA "PPPPPPPPPPPPPBGBBGXX"
DATA "PPPPPPPPPPPPBBGBGGBX"
DATA "PPPPPPPPPPPPBGGGGGBX"
DATA "PPPPPPPPPPPPBGGBGGPX"
DATA "PPPPPPPPPPPBBGGBGGGX"
DATA "PPPPPPPPPPBBGGGGGGGX"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGBGXGP"
DATA "PPPPPPPPPBBGGGGBGXGP"
DATA "PPPPPPPPBBGGGGGBGXGP"
DATA "PPPPPPPPBGGGGGBBGXGP"
DATA "PPPPPPPPBGGGGGBGGXGX"
DATA "PPPPPPPBBGGGGGBGGGGX"
DATA "PPPPPPBBGGGBGGBBGGGX"
DATA "PPPPPPBGGGBBGGGBGGGP"
DATA "PPPPPPBBGGGBGGGBGGGP"
DATA "PPPPPPPBGGBBGGGBGBGP"
DATA "PPPPPPBBGGBBGGGBGBGP"
DATA "PPPPPBBGGGGBGGBGBBGX"
DATA "PPPPPBGGGGGGGGBGBGGX"
DATA "PPPPPBBGGGGGGGBGBGGX"
DATA "PPPPPPBGGGGGGGBBGGBX"
DATA "PPPPPBBGGGBGGGBBGGBX"
DATA "PPPPPBGGGGGGGGBGGGBX"
DATA "PPPPBBGGGGGGGBBGGGXP"
DATA "PPPPBBGGGGGGGBGGGGXP"
DATA "PPPPPBGGGGGGBBGGGGXP"
DATA "PPPPPBGGGBGGBGGGGGXP"
DATA "PPPPPBBGGGGGBGGGGGXP"
DATA "PPPPPPBGGGGGGGBGGGPP"
DATA "PPPPPBBGGGGGGBBGGGPX"
DATA "PPPPBBGGGBGGGGBGGGPX"
DATA "PPPPBBGGBBGGGGBGBGXX"
DATA "PPPPPBGGBGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBGGGBXX"
DATA "PPPPBBGGGBGBGBGGGBXX"
DATA "PPPPBGGGGBGBGBGGGXXX"
DATA "PPBBBGGGGGGGGBBGGXXX"
DATA "PBGGGGBBGGGGGBBGGXPX"
DATA "BGYYYYYBGGGGGGBGGXPX"
DATA "BGYBBYYBGGGGGGBGGGPX"
DATA "BGYBBYYBGGGGGGBGGGXX"
DATA "PBGGGBBGGGGGGGBBGGXX"
DATA "PPBBBBBBGGGGGGBBBGXX"
DATA "PPPPPPPBGGGGGBGBBGXX"
DATA "PPPPPPPPBGGGGBBBBGXX"
DATA "PPPPPPPPBGGGGBBBGGXX"
DATA "PPPPPPPPPBGGGGBBGGPP"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGGXX"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGXXP"
DATA "PPPPPPPPPPBGGGBBGXXP"
DATA "PPPPPPPPPBBGGGBBXXXP"
DATA "PPPPPPPPBGGGGGBBXXPX"
DATA "PPPPPPPBGBBGGGBBXXPX"
DATA "PPPPPPPBGBBBGGBBXXPX"
DATA "PPPPPPPPBGGGGBBBXXPX"
DATA "PPPPPPPPPBBBBBBXXPPX"

'crocA
DATA "PPPPPPPPPPPPPPBBXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPPBGGXBP"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPPBGXGPP"
DATA "PPPPPPPPPPPPPBBGXXPX"
DATA "PPPPPPPPPPPPBBGGXXGX"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPPBGXXXX"
DATA "PPPPPPPPPPPPBBBGGXXP"
DATA "PPPPPPPPPPPPBGGGGXBP"
DATA "PPPPPPPPPPPPBBGGGXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPBGGGXBP"
DATA "PPPPPPPPPPPPBBGGGGXP"
DATA "PPPPPPPPPPPPBBGGBGXB"
DATA "PPPPPPPPPPPPPBGBBGXX"
DATA "PPPPPPPPPPPPBBGBGGBX"
DATA "PPPPPPPPPPPPBGGGGGBX"
DATA "PPPPPPPPPPPPBGGBGGPX"
DATA "PPPPPPPPPPPBBGGBGGGX"
DATA "PPPPPPPPPPBBGGGGGGGX"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGBGXGP"
DATA "PPPPPPPPPBBGGGGBGXGP"
DATA "PPPPPPPPBBGGGGGBGXGP"
DATA "PPPPPPPPBGGGGGBBGXGP"
DATA "PPPPPPPPBGGGGGBGGXGX"
DATA "PPPPPPPBBGGGGGBGGGGX"
DATA "PPPPPPBBGGGBGGBBGGGX"
DATA "PPPPPPBGGGBBGGGBGGGP"
DATA "PPPPPPBBGGGBGGGBGGGP"
DATA "PPPPPPPBGGBBGGGBGBGP"
DATA "PPPPPPBBGGBBGGGBGBGP"
DATA "PPPPPBBGGGGBGGBGBBGX"
DATA "PPPPPBGGGGGGGGBGBGGX"
DATA "PPPPPBBGGGGGGGBGBGGX"
DATA "PPPPPPBGGGGGGGBBGGBX"
DATA "PPPPPBBGGGBGGGBBGGBX"
DATA "PPPPPBGGGGGGGGBGGGBX"
DATA "PPPPBBGGGGGGGBBGGGXP"
DATA "PPPPBBGGGGGGGBGGGGXP"
DATA "PPPPPBGGGGGGBBGGGGXP"
DATA "PPPPPBGGGBGGBGGGGGXP"
DATA "PPPPPBBGGGGGBGGGGGXP"
DATA "PPPPPPBGGGGGGGBGGGPP"
DATA "PPPPPBBGGGGGGBBGGGPX"
DATA "PPPPBBGGGBGGGGBGGGPX"
DATA "PPPPBBGGBBGGGGBGBGXX"
DATA "PPPPPBGGBGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBGGGBXX"
DATA "PPPPBBGGGBGBGBGGGBXX"
DATA "PPPPBGGGGBGBGBGGGXXX"
DATA "PPBBBGGGGGGGGBBGGXXX"
DATA "PBGGGGBBGGGGGBBGGXPX"
DATA "BGYYYYYBGGGGGGBGGXPX"
DATA "BGYBBYYBGGGGGGBGGGPX"
DATA "BGYBBYYBGGGGGGBGGGXX"
DATA "PBGGGBBGGGGGGGBBGGXX"
DATA "PPBBBBBBGGGGGGBBBGXX"
DATA "PPPPPPBGGGGGGGGBBGXX"
DATA "PPPPPPBGBGBBBGGBBGXX"
DATA "PPPPPBGGBBBPBBBBGGXX"
DATA "PPPPPBGBBBPPPPBBGGPP"
DATA "PPPPPBGBWWBPPPBBGGXP"
DATA "PPPPPBGBBBPPPBBBGGXP"
DATA "PPPPBGGBPPPPBWWBGGXX"
DATA "PPPPBGGBBBPPPBBBGGXP"
DATA "PPPPBGGBWWBPPPPBGXXP"
DATA "PPPPBGGBBBPPPBBBGXXP"
DATA "PPPBGGGBPPPPBWWBXXXP"
DATA "PPBBGGGBBBPPPBBBXXPX"
DATA "PBGGGGGBWWBPPPPBXXPX"
DATA "BGBBGGGBBBPPPBBBXXPX"
DATA "BGBBBGGBPPPPBWWBXXPX"
DATA "PBGGGGBBPPPPPBBXXPPX"
Last edited by BasicCoder2 on Mar 07, 2012 7:58, edited 6 times in total.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Post by sir_mud »

Quick addition of the other directions and tweaked time between keypresses to feel more like the real thing.

Code: Select all

#include "fbgfx.bi"
using fb

screenres 640,480,32

type sprite
        x  as integer
        y  as integer
        dx as integer
        dy as integer
        w  as integer
        h  as integer
        speed as integer
end type

function scollision(s1 as sprite, s2 as sprite) as integer
        dim as integer hit
        hit = 0

        if s1.x >= s2.x and s1.x <= s2.x+s2.w then
                if s1.y >= s2.y and s1.y <= s2.y + s2.h then
                        hit = 1
                end if
                if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
                        hit = 2
                end if
                if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then 'overlap
                        hit = 3
                end if
        end if

        if s1.x + s1.w >= s2.x and s1.x + s1.w <= s2.x+s2.w then
                if s1.y >= s2.y and s1.y <= s2.y + s2.h then
                        hit = 4
                end if
                if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
                        hit = 5
                end if
                if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then  'overlap
                        hit = 6
                end if
        end if

        return hit

end function


dim shared frog as sprite

dim shared car(1 to 4) as sprite

dim shared logs(1 to 4) as sprite

cls
dim as FB.Image ptr iFrog = imagecreate(21,23,0)
get (0,0)-(20,22), iFrog

'create a car/truck whatever
dim as FB.Image ptr iCar = imagecreate(40,20,0)
line (0,0)-(39,19),rgb(255,100,0),bf
get (0,0)-(39,19), iCar

'create a log
dim as FB.Image ptr iLogs = imagecreate(60,20,0)
line (0,0)-(59,19),rgb(128,0,0),bf
get (0,0)-(59,19),iLogs

bload "C:\FreeBasic\bitmaps\sprites\backGround.bmp"
'draw background
line (0,0)-(372,31),rgb(255,128,0),bf      'orange display area
line (0,32)-(372,62),rgb(0,128,0),bf       'green home
line (0,63)-(372,191),rgb(128,255,255),bf  'blue river
line (0,192)-(372,223),rgb(0,128,0),bf     'green safe spot
line (0,224)-(372,351),rgb(192,192,192),bf 'gray road
line (0,352)-(372,383),rgb(0,128,0),bf     'green start
line (0,384)-(372,415),rgb(255,128,0),bf   'orange display area
for i as integer = 0 to 5
        circle (i*62+31,47),12,rgb(128,0,0),,,,f 'frog holes
next i
'lines on road
line (0,256)-(372,256),rgb(255,255,0)  'yellow lines
line (0,288)-(372,288),rgb(255,255,0)
line (0,320)-(372,320),rgb(255,255,0)


'display text
locate 2,1
color rgb(0,0,0),rgb(255,128,0)  'black on orange
print "   FROGGER GAME   "

dim as FB.Image ptr backGround = imagecreate(372,416,0)
get (0,0)-(371,415),backGround

dim as string reply

do
        reply = ""  'signal to keep going while reply <> "y" or "x"
        frog.x=170
        frog.y=357
        frog.w=21
        frog.h=23
        frog.speed=32

        car(1).x = 0
        car(1).y = 230
        car(1).dx = 1
        car(1).dy = 0
        car(1).w = 40
        car(1).h = 20

        car(2).x = 300
        car(2).y = 262
        car(2).dx = 1
        car(2).dy = 0
        car(2).w = 40
        car(2).h = 20

        car(3).x = 150
        car(3).y = 294
        car(3).dx = 1
        car(3).dy = 0
        car(3).w = 40
        car(3).h = 20

        car(4).x = 30
        car(4).y = 326
        car(4).dx = 1
        car(4).dy = 0
        car(4).w = 40
        car(4).h = 20

        logs(1).x = 0
        logs(1).y = 72
        logs(1).dx = 1
        logs(1).dy = 0
        logs(1).w = 60
        logs(1).h = 20

        logs(2).x = 300
        logs(2).y = 104
        logs(2).dx = 1
        logs(2).dy = 0
        logs(2).w = 60
        logs(2).h = 20

        logs(3).x = 150
        logs(3).y = 136
        logs(3).dx = 1
        logs(3).dy = 0
        logs(3).w = 60
        logs(3).h = 20

        logs(4).x = 30
        logs(4).y = 168
        logs(4).dx = 1
        logs(4).dy = 0
        logs(4).w = 60
        logs(4).h = 20

        dim as integer chosenLog
        chosenLog = 0

        dim as double now
        now = 0


        do

                screenlock()

                cls
                'draw background
                put (0,0),backGround,pset

                'draw logs under frog
                for i as integer = 1 to 4
                        put (logs(i).x, logs(i).y ), iLogs, trans
                next i

                'draw dead frog if speed = 0 else draw live frog
                if frog.speed = 0 then
                        put (frog.x,frog.y),iFrog,trans  'change to a dead frog sprite later
                else
                        put (frog.x,frog.y),iFrog, trans
                end if

                'draw cars on top of frog
                for i as integer = 1 to 4
                        put (car(i).x, car(i).y ), iCar, trans
                next i

                locate 50,1
                if frog.speed = 0 then
                        print "  ****  FROG DEAD  ****"
                end if
                if frog.y < 64 then
                        print "  ****  FROG HOME  ****"
                end if

                print " HIT SPACE KEY to start again OR ESC key to END program"

                screenunlock()

                'update car positions
                for i as integer = 1 to 4
                        car(i).x = car(i).x + car(i).dx
                next i

                'update log positions
                for i as integer = 1 to 4
                        logs(i).x = logs(i).x + logs(i).dx
                        'update frog.x position if on log
                        if chosenLog = i then
                                frog.x = frog.x + logs(i).dx
                        end if
                next i

                'reverse car directions if out of bounds
                for i as integer = 1 to 4
                        if car(i).x < 0 or car(i).x > 332 then car(i).dx=-car(i).dx
                next i

                'reverse logs directions if out of bounds
                for i as integer = 1 to 4
                        if logs(i).x < 0 or logs(i).x > 312 then logs(i).dx=-logs(i).dx
                next i

                'user input accepted only every 0.25 seconds - feels like the real thing
                if timer > (now + 0.25) then

                        if multikey(SC_SPACE) then reply = "y"
                        if multikey(SC_ESCAPE) then reply = "x"

                        if frog.y > 63 then  'test frog hasn't reached home
                                if multikey(SC_DOWN) andalso frog.y <352 then
                                        frog.y = frog.y+frog.speed
                                        now = timer
                                        chosenLog=0
                                end if

                                if multikey(sc_up)  then
                                        frog.y = frog.y-frog.speed
                                        now = timer   'reset timer
                                        chosenLog = 0 'if log remove log ID
                                end if

                                if multikey(SC_right) andalso frog.x < 302 then
                                        frog.x = frog.x+frog.speed
                                        now = timer
                                        chosenLog=0
                                end if

                                if multikey(sc_left) andalso  frog.x > 10  then
                                        frog.x = frog.x-frog.speed
                                        now = timer   
                                        chosenLog = 0 
                                end if
                        end if

                end if

                dim as integer hit

                if frog.y < 352 and frog.y > 224 then
                        'test for collision with car
                        hit = 0
                        for i as integer = 1 to 4
                                if hit = 0 then
                                        hit = scollision(frog,car(i))
                                end if
                        next i

                        if hit <> 0 then
                                frog.speed = 0  'flag frog dead
                        end if

                end if

                if frog.y < 192 and frog.y > 64 then
                        'test collision with a log
                        hit = 0
                        for i as integer = 1 to 4

                                hit = scollision(frog,logs(i))

                                if hit <> 0 and chosenLog = 0  then
                                        chosenLog = i
                                end if

                        next i

                        if  chosenLog=0 then
                                locate 1,1
                                print "MISSED LOG"
                                frog.speed = 0
                                sleep
                        end if

                end if


                sleep 10, 1

        loop while reply <> "y" and reply <> "x"

loop while reply = "y"

end

AGS
Posts: 1284
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Post by AGS »

Frogger was one of the (if not the) first games I ever played. I played it on the C64 when I was... younger (must've been the 1980s).

Anyway, it's fun to play this freebasic version of frogger on my PC. Very 'playable'. Nice one!


PS
What are the runtime dependencies (apart from msvcrt.dll) of this freebasic program? Will it 'just run' or does it need some specific version of directx/some other graphics library?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Post by BasicCoder2 »

AGS wrote:Frogger was one of the (if not the) first games I ever played. I played it on the C64 when I was... younger (must've been the 1980s).

Anyway, it's fun to play this freebasic version of frogger on my PC. Very 'playable'. Nice one!

Really? No graphics, no sound, no scores? I can do the graphics but not the sound.
There are some free playable frogger games on the internet although I stopped looking when a pop up window took control and I couldn't make it go away without turning off the computer so I never got to get a real feel for the whole game.
PS
What are the runtime dependencies (apart from msvcrt.dll) of this freebasic program? Will it 'just run' or does it need some specific version of directx/some other graphics library?
I just compile and run everything from FBIDE on a Windows7 machine. I don't know what directx dependencies FreeBasic requires.

I have edited the first post and added the frog graphic I made for my other post to sir_mud's improved version. If I get time I can add log, car and squashed frog graphics, scores, variable difficulty and so on, but who can do the sound?
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Post by Dr_D »

Cool... I used to love this game. I hope you don't mind, but I added a bit of animation. :)

EDIT: fixed a small glitch in the rotation code.

Code: Select all


#include "fbgfx.bi"
using fb

screenres 640,480,32

const as double pi = 3.1415926, pi_180 = pi / 180

type sprite
    x  as integer
    y  as integer
    dx as integer
    dy as integer
    w  as integer
    h  as integer
    speed as integer
    angle   as single
    target_angle as integer
    jump as single
end type


sub rotozoom( byref dst as FB.IMAGE ptr = 0, byref src as const FB.IMAGE ptr, byval positx as integer, byval posity as integer, byref angle as integer, byref zoomx as single, byref zoomy as single = 0, byval transcol as uinteger  = &hffff00ff, byval offsetx as integer = 0, byref offsety as integer = 0 )
    
    'Rotozoom for 32-bit FB.Image by Dr_D(Dave Stanley) and yetifoot(Simon Nash)
    'No warranty implied... use at your own risk ;) 
    
    static as integer mx, my, col, nx, ny
    static as single nxtc, nxts, nytc, nyts
    static as single tcdzx, tcdzy, tsdzx, tsdzy
    static as integer sw2, sh2, dw, dh
    static as single tc, ts, _mx, _my
    static as uinteger ptr dstptr, srcptr, odstptr
    static as integer xput, yput, startx, endx, starty, endy
    static as integer x(3), y(3), xa, xb, ya, yb, lx, ly
    static as ubyte ptr srcbyteptr, dstbyteptr
    static as integer dstpitch, srcpitch, srcbpp, dstbpp, srcwidth, srcheight
    
    if zoomx = 0 then exit sub
    if zoomy = 0 then zoomy = zoomx
    if src = 0 then exit sub

    if dst = 0 then
        dstptr = screenptr
        odstptr = dstptr
        screeninfo dw,dh,,,dstpitch
    else
        dstptr = cast( uinteger ptr, dst + 1 )
        odstptr = cast( uinteger ptr, dst + 1 )
        dw = dst->width
        dh = dst->height
        dstbpp = dst->bpp
        dstpitch = dst->pitch
    end if
    
    srcptr = cast( uinteger ptr, src + 1 )
    srcbyteptr = cast( ubyte ptr, srcptr )
    dstbyteptr = cast( ubyte ptr, dstptr )
    
    sw2 = src->width\2
    sh2 = src->height\2
    srcbpp = src->bpp
    srcpitch = src->pitch
    srcwidth = src->width
    srcheight = src->height
    
    tc = cos( angle * pi_180 )
    ts = sin( angle * pi_180 )
    tcdzx = tc/zoomx
    tcdzy = tc/zoomy
    tsdzx = ts/zoomx
    tsdzy = ts/zoomy
    
    xa = sw2 * tc * zoomx + sh2  * ts * zoomx
    ya = sh2 * tc * zoomy - sw2  * ts * zoomy
    
    xb = sh2 * ts * zoomx - sw2  * tc * zoomx
    yb = sw2 * ts * zoomy + sh2  * tc * zoomy

    dim as integer centerx = -(offsetx*(tc*zoomx) + offsety*(ts*zoomx)) + offsetx
    dim as integer centery = -(offsety*(tc*zoomy) - offsetx*(ts*zoomy)) + offsety

    x(0) = sw2-xa
    x(1) = sw2+xa
    x(2) = sw2-xb
    x(3) = sw2+xb
    y(0) = sh2-ya
    y(1) = sh2+ya
    y(2) = sh2-yb
    y(3) = sh2+yb
    
    for i as integer = 0 to 3
        for j as integer = i to 3
            if x(i)>=x(j) then
                swap x(i), x(j)
            end if
        next
    next
    startx = x(0)
    endx = x(3)
    
    for i as integer = 0 to 3
        for j as integer = i to 3
            if y(i)>=y(j) then
                swap y(i), y(j)
            end if
        next
    next
    starty = y(0)
    endy = y(3)
    
    positx-=sw2
    posity-=sh2
    positx+=centerx
    posity+=centery
    if posity+starty<0 then starty = -posity
    if positx+startx<0 then startx = -positx
    if posity+endy<0 then endy = -posity
    if positx+endx<0 then endx = -positx
    
    if positx+startx>(dw-1) then startx = (dw-1)-positx
    if posity+starty>(dh-1) then starty = (dh-1)-posity
    if positx+endx>(dw-1) then endx = (dw-1)-positx
    if posity+endy>(dh-1) then endy = (dh-1)-posity
    if startx = endx or starty = endy then exit sub
    
    
    xput = (startx + positx) * 4
    yput = starty + posity
    ny = starty - sh2
    nx = startx - sw2
    nxtc = (nx * tcdzx)
    nxts = (nx * tsdzx)
    nytc = (ny * tcdzy)
    nyts = (ny * tsdzy)
    dstptr += dstpitch * yput \ 4
    
	dim as integer y_draw_len = (endy - starty) + 1
	dim as integer x_draw_len = (endx - startx) + 1
    
    
    'and we're off!
    asm
        mov edx, dword ptr [y_draw_len]
        
        test edx, edx ' 0?
        jz y_end      ' nothing to do here
        
        fld dword ptr[tcdzy]
        fld dword ptr[tsdzy]
        fld dword ptr [tcdzx]
        fld dword ptr [tsdzx]
        
        y_inner:
        
        fld dword ptr[nxtc]     'st(0) = nxtc, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fsub dword ptr[nyts]    'nxtc-nyts
        fiadd dword ptr[sw2]    'nxtc-nyts+sw2
        
        fld dword ptr[nxts]     'st(0) = nxts, st(1) = tsdzx, st(2) = tcdzx, st(3) = tsdzy, st(4) = tcdzy
        fadd dword ptr[nytc]    'nytc+nxts
        fiadd dword ptr[sh2]    'nxts+nytc+sh2
        'fpu stack returns to: st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy 
        
        mov ebx, [xput]
        add ebx, [dstptr]
        
        mov ecx, dword ptr [x_draw_len]
        
        test ecx, ecx ' 0?
        jz x_end      ' nothing to do here
        
        x_inner:
        
        fist dword ptr [my] ' my = _my
        
        fld st(1)           ' mx = _mx
        fistp dword ptr [mx]
        
        mov esi, dword ptr [mx]         ' esi = mx
        mov edi, dword ptr [my]         ' edi = my
        
        ' bounds checking
        test esi, esi       'mx<0?
        js no_draw          
        'mov esi, 0
        
        test edi, edi
        'mov edi, 0
        js no_draw          'my<0?

        cmp esi, dword ptr [srcwidth]   ' mx >= width?
        jge no_draw
        cmp edi, dword ptr [srcheight]  ' my >= height?
        jge no_draw
        
        ' calculate position in src buffer
        mov eax, dword ptr [srcbyteptr] ' eax = srcbyteptr
        imul edi, dword ptr [srcpitch]  ' edi = my * srcpitch
        add eax, edi
        shl esi, 2
        ' eax becomes src pixel color
        mov eax, dword ptr [eax+esi]
        cmp eax, [transcol]
        je no_draw
        
        ' draw pixel
        mov dword ptr [ebx], eax
        no_draw:
        
        fld st(3)
        faddp st(2), st(0) ' _mx += tcdzx
        fadd st(0), st(2) ' _my += tsdzx
        
        ' increment the output pointer
        add ebx, 4
        
        ' increment the x loop
        dec ecx
        jnz x_inner
        
        x_end:
        
        fstp dword ptr [_my]
        fstp dword ptr [_mx]
        
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nytc += tcdzy
        fld dword ptr[nytc]
        fadd st(0), st(4)
        fstp dword ptr[nytc]
        
        'st(0) = tsdzx, st(1) = tcdzx, st(2) = tsdzy, st(3) = tcdzy
        'nyts+=tsdzy
        fld dword ptr[nyts]
        fadd st(0), st(3) 
        fstp dword ptr[nyts]
        
        'dstptr += dst->pitch
        mov eax, dword ptr [dstpitch]
        add dword ptr [dstptr], eax
        
        dec edx
        jnz y_inner
        
        y_end:
        
        finit
    end asm
    
end sub


function scollision(s1 as sprite, s2 as sprite) as integer
       
    dim as integer hit
    hit = 0

    if s1.x >= s2.x and s1.x <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 1
        end if
        if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
            hit = 2
        end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then 'overlap
            hit = 3
        end if
    end if

    if s1.x + s1.w >= s2.x and s1.x + s1.w <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 4
        end if
    if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
        hit = 5
    end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then  'overlap
            hit = 6
        end if   
    end if

    return hit

end function


dim shared frog as sprite

dim shared car(1 to 4) as sprite

dim shared logs(1 to 4) as sprite

cls
'create a frog image
dim as uinteger v
for j as integer = 0 to 22
    for i as integer = 0 to 20
        read v
        pset (i,j),v
    next i
next j
dim as FB.Image ptr iFrog = imagecreate(21,23,0)
get (0,0)-(20,22), iFrog

'create a car/truck whatever
dim as FB.Image ptr iCar = imagecreate(40,20,0)
line (0,0)-(39,19),rgb(255,100,0),bf
get (0,0)-(39,19), iCar

'create a log
dim as FB.Image ptr iLogs = imagecreate(60,20,0)
line (0,0)-(59,19),rgb(128,0,0),bf
get (0,0)-(59,19),iLogs

bload "C:\FreeBasic\bitmaps\sprites\backGround.bmp"
'draw background
line (0,0)-(372,31),rgb(255,128,0),bf      'orange display area
line (0,32)-(372,62),rgb(0,128,0),bf       'green home
line (0,63)-(372,191),rgb(128,255,255),bf  'blue river
line (0,192)-(372,223),rgb(0,128,0),bf     'green safe spot
line (0,224)-(372,351),rgb(192,192,192),bf 'gray road
line (0,352)-(372,383),rgb(0,128,0),bf     'green start
line (0,384)-(372,415),rgb(255,128,0),bf   'orange display area
for i as integer = 0 to 5
        circle (i*62+31,47),12,rgb(128,0,0),,,,f 'frog holes
next i
'lines on road
line (0,256)-(372,256),rgb(255,255,0)  'yellow lines
line (0,288)-(372,288),rgb(255,255,0)
line (0,320)-(372,320),rgb(255,255,0)


'display text
locate 2,1
color rgb(0,0,0),rgb(255,128,0)  'black on orange
print "   FROGGER GAME   "

dim as FB.Image ptr backGround = imagecreate(372,416,0)
get (0,0)-(371,415),backGround

dim as string reply

do
    reply = ""  'signal to keep going while reply <> "y" or "x"
    frog.x=170
    frog.y=357
    frog.w=21
    frog.h=23
    frog.speed=32

    car(1).x = 0
    car(1).y = 230
    car(1).dx = 1
    car(1).dy = 0
    car(1).w = 40
    car(1).h = 20

    car(2).x = 300
    car(2).y = 262
    car(2).dx = 1
    car(2).dy = 0
    car(2).w = 40
    car(2).h = 20

    car(3).x = 150
    car(3).y = 294
    car(3).dx = 1
    car(3).dy = 0
    car(3).w = 40
    car(3).h = 20

    car(4).x = 30
    car(4).y = 326
    car(4).dx = 1
    car(4).dy = 0
    car(4).w = 40
    car(4).h = 20

    logs(1).x = 0
    logs(1).y = 72
    logs(1).dx = 1
    logs(1).dy = 0
    logs(1).w = 60
    logs(1).h = 20

    logs(2).x = 300
    logs(2).y = 104
    logs(2).dx = 1
    logs(2).dy = 0
    logs(2).w = 60
    logs(2).h = 20

    logs(3).x = 150
    logs(3).y = 136
    logs(3).dx = 1
    logs(3).dy = 0
    logs(3).w = 60
    logs(3).h = 20

    logs(4).x = 30
    logs(4).y = 168
    logs(4).dx = 1
    logs(4).dy = 0
    logs(4).w = 60
    logs(4).h = 20

    dim as integer chosenLog
    chosenLog = 0

    dim as double now
    now = 0

    do
        screenlock()

        cls
        'draw background
        put (0,0),backGround,pset

        'draw logs under frog
        for i as integer = 1 to 4
            put (logs(i).x, logs(i).y ), iLogs, trans
        next i

        'draw dead frog if speed = 0 else draw live frog
        if frog.speed = 0 then
            'put (frog.x,frog.y),iFrog,trans  'change to a dead frog sprite later
            rotozoom( ,iFrog, frog.x+iFrog->Width\2, frog.y+iFrog->Height\2, int(frog.angle), frog.jump, frog.jump)
        else
            'put (frog.x,frog.y),iFrog, trans
            rotozoom( ,iFrog, frog.x+iFrog->Width\2, frog.y+iFrog->Height\2, int(frog.angle), frog.jump, frog.jump)
        end if

        'draw cars on top of frog
        for i as integer = 1 to 4
            put (car(i).x, car(i).y ), iCar, trans
        next i

        locate 50,1
        if frog.speed = 0 then
            print "  ****  FROG DEAD  ****"
        end if
        if frog.y < 64 then
            print "  ****  FROG HOME  ****"
        end if

        print " HIT SPACE KEY to start again OR ESC key to END program"
        
        screenunlock()

        'update car positions
        for i as integer = 1 to 4
            car(i).x = car(i).x + car(i).dx
        next i

        'update log positions
        for i as integer = 1 to 4
            logs(i).x = logs(i).x + logs(i).dx
           'update frog.x position if on log
            if chosenLog = i then
                frog.x = frog.x + logs(i).dx
            end if
        next i

        'reverse car directions if out of bounds
        for i as integer = 1 to 4
            if car(i).x < 0 or car(i).x > 332 then car(i).dx=-car(i).dx
        next i

        'reverse logs directions if out of bounds
        for i as integer = 1 to 4
            if logs(i).x < 0 or logs(i).x > 312 then logs(i).dx=-logs(i).dx
        next i
        
        'for the frog rotation animation
        frog.angle+=(frog.target_angle-frog.angle)/5
        frog.jump-=.1
        if frog.jump<1 then frog.jump = 1

        'user input accepted only every 0.25 seconds - feels like the real thing
        if timer > (now + 0.25) then

            if multikey(SC_SPACE) then reply = "y"
            if multikey(SC_ESCAPE) then reply = "x"

            if frog.y > 63 then  'test frog hasn't reached home
                if multikey(SC_DOWN) andalso frog.y <352 then
                    frog.y = frog.y+frog.speed
                    frog.target_angle = 180
                    frog.jump=1.5
                    now = timer
                    chosenLog=0
                end if

                if multikey(sc_up)  then
                    
                    'this fixes the rotation error when the target angle is 0, but the current angle is 270
                    if frog.target_angle=270 then
                        frog.angle = -90
                    end if

                    frog.y = frog.y-frog.speed
                    frog.target_angle = 0
                    frog.jump=1.5
                    now = timer   'reset timer
                    chosenLog = 0 'if log remove log ID
                end if

                if multikey(SC_right) andalso frog.x < 302 then

                    'this fixes the rotation jump when the target angle is 270, but the current angle = 0
                    if frog.target_angle = 0 then
                        frog.angle = 360
                    end if

                    frog.x = frog.x+frog.speed
                    frog.target_angle = 270
                    frog.jump=1.5
                    now = timer
                    chosenLog=0
                end if

                if multikey(sc_left) andalso  frog.x > 10  then
                    frog.x = frog.x-frog.speed
                    frog.target_angle = 90
                    frog.jump=1.5
                    now = timer   
                    chosenLog = 0
                end if
            end if

        end if

        dim as integer hit

        if frog.y < 352 and frog.y > 224 then
            'test for collision with car
            hit = 0
            for i as integer = 1 to 4
                if hit = 0 then
                    hit = scollision(frog,car(i))
                end if
            next i

            if hit <> 0 then
                frog.speed = 0  'flag frog dead
            end if

        end if

        if frog.y < 192 and frog.y > 64 then
            'test collision with a log
             hit = 0
            for i as integer = 1 to 4

                hit = scollision(frog,logs(i))

                if hit <> 0 and chosenLog = 0  then
                    chosenLog = i
                end if

            next i

            if  chosenLog=0 then
                locate 1,1
                print "MISSED LOG"
                frog.speed = 0
                sleep
            end if

        end if

        sleep 10, 1

    loop while reply <> "y" and reply <> "x"

loop while reply = "y"

end

'frog image 21 x 23
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFFFFC90E,&HFF000000
DATA &HFF000000,&HFFFFC90E,&HFF000000,&HFF22B14C,&HFF000000,&HFFFFC90E,&HFF000000
DATA &HFF000000,&HFFFFC90E,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFFFFC90E,&HFF000000
DATA &HFF000000,&HFFFFC90E,&HFF000000,&HFF22B14C,&HFF000000,&HFFFFC90E,&HFF000000
DATA &HFF000000,&HFFFFC90E,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFFFF00FF,&HFF000000,&HFFFFC90E,&HFFFFC90E
DATA &HFFFFC90E,&HFFFFC90E,&HFF000000,&HFF22B14C,&HFF000000,&HFFFFC90E,&HFFFFC90E
DATA &HFFFFC90E,&HFFFFC90E,&HFF000000,&HFFFF00FF,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFF22B14C,&HFF000000,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF000000,&HFF22B14C,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF000000,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF000000,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C,&HFF000000,&HFFFF00FF,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF22B14C,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF22B14C
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000
DATA &HFF000000,&HFF000000,&HFF22B14C,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000
DATA &HFF000000,&HFF22B14C,&HFF22B14C,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF
DATA &HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF000000,&HFF000000
DATA &HFFFF00FF,&HFFFF00FF,&HFF000000,&HFF000000,&HFF000000,&HFFFF00FF,&HFFFF00FF
DATA &HFF000000,&HFF000000,&HFF000000,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF,&HFFFF00FF
 
Last edited by Dr_D on Jun 13, 2011 1:50, edited 2 times in total.
AGS
Posts: 1284
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Post by AGS »

BasicCoder2 wrote:
AGS wrote:Frogger was one of the (if not the) first games I ever played. I played it on the C64 when I was... younger (must've been the 1980s).

Anyway, it's fun to play this freebasic version of frogger on my PC. Very 'playable'. Nice one!

Really? No graphics, no sound, no scores? I can do the graphics but not the sound.
Once upon a time I played a game called pong on an old game console. I must've been..... just born or something? Pong: two sticks, a 'ball', nothing else (little or no sound). Pong must have been the first game I ever played.

And then along came frogger. If you put the two together (pong and frogger) you get the game you wrote :) (well, almost). I guess your version of frogger remembers me of the olden days :). And those days were good.

BasicCoder2 wrote: There are some free playable frogger games on the internet although I stopped looking when a pop up window took control and I couldn't make it go away without turning off the computer so I never got to get a real feel for the whole game.
After I played your version I looked around on the internet and found a frogger game I could play online. It had music (I think) and a frog that, when hit by a truck, turned into a bloody mess. The game looked good but the blood I did not care for.
AGS
Posts: 1284
Joined: Sep 25, 2007 0:26
Location: the Netherlands

Post by AGS »

Dr_D wrote:Cool... I used to love this game. I hope you don't mind, but I added a bit of animation. :)

EDIT: fixed a small glitch in the rotation code.
I certainly did not mind the animation. Nice looking frog!
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Frogger revisited

Post by Roland Chastain »

Hello BasicCoder2 !

I wanted to say to you that my three-years old boy is crazy about your Frogger !

It's a nice little game and a very good code example. It's a pity that it has no sounds, isn't it ?

What means "missed log" ? I had a look at the code but I didn't understand.
Last edited by Roland Chastain on May 22, 2012 2:32, edited 2 times in total.
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Frogger revisited

Post by dafhi »

top quality animation. I think i might steal that sub
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Frogger revisited

Post by BasicCoder2 »

Roland Chastain wrote:Hello BasicCoder2 !

I wanted to say to you that my three-years old boy is crazy about your Frogger !

It's a nice little game and a very good code example.

It's a pity that it has no sounds, isn't it ?

What means "missed log" ? I had a look at the code but I didn't understand.
The crocodiles started out as logs but I didn't change the code, I only changed the sprite images.

There are frogger games on the internet that probably have sound and better graphics and game play.

I have not experimented with programming sound.

I think games could be a powerful means to teach children language, mathematics, geography, history ....
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Frogger revisited

Post by Roland Chastain »

BasicCoder2 wrote: The crocodiles started out as logs but I didn't change the code, I only changed the sprite images.
Forgive me, but I don't know what a "log" is. Anyway, this message shouldn't appear while I am playing : "MISSED LOG".
BasicCoder2 wrote: I have not experimented with programming sound.
There are many persons here who would be able to do this. Unfortunately, I am not. But if someones write the code, I could make a sound file with a classical melody, something like the Chopin funeral march in Digger.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Frogger revisited

Post by BasicCoder2 »

Roland Chastain wrote:
BasicCoder2 wrote: The crocodiles started out as logs but I didn't change the code, I only changed the sprite images.
Forgive me, but I don't know what a "log" is. Anyway, this message shouldn't appear while I am playing : "MISSED LOG".
an unhewn portion or length of the trunk or a large limb of a felled tree.

une partie non taillée ou la longueur du tronc d'un membre important d'un arbre abattu.

The idea was the frog had to jump log to log as they floated down the river.

Goto Search menu item in FBIDE and select Replace,
Find What: log
Replace with: crocodile

Problem solved.
BasicCoder2 wrote: I have not experimented with programming sound.

There are many persons here who would be able to do this. Unfortunately, I am not. But if someones write the code, I could make a sound file with a classical melody, something like the Chopin funeral march in Digger.
http://www.freebasic.net/forum/viewtopi ... OD#p167200

http://www.freebasic.net/forum/viewtopic.php?p=113005

There must be info somewhere on how to add music and sound effects to FreeBasic games.

Frogger online game

http://www.happyhopper.org/

http://www.thekidzpage.com/freekidsgame ... e-game.htm
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Frogger revisited

Post by Roland Chastain »

BasicCoder2 wrote:but who can do the sound?
Hello, gentlemen ! Here is a Frogger with sounds.

To play sounds, I used this code by Volta.

Sounds were made for this project.

To run the program, you have to gather .wav files in a "Sound" folder, or else you can also change the path at the beginning of the program.

Sound files

Code: Select all

'Sound.bas

'http://www.freebasic-portal.de/code-beispiele/multimedia/mid-wav-mp3-audiodateien-abspielen-31.html

#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/mmsystem.bi"

FUNCTION FB_MCI(BYVAL FB_MCICOMMAND AS STRING, BYVAL f_Alias AS STRING) AS INTEGER
    DIM temp AS STRING *256
    f_Alias = UCASE(f_Alias)
    SELECT CASE LCASE(TRIM(FB_MCICOMMAND))
      CASE "play","on","an"
          mciSendString("play " & f_Alias &" from " & 0, NULL, 0, 0)
      CASE "close","off","aus"
          mciSendString("close " & f_Alias, NULL, 0, 0)
      CASE "stop"
          mciSendString("stop " & f_Alias, NULL, 0, 0)
      CASE "length","len"
          mciSendString("status " & f_Alias & " length", temp, 256,0)
          FB_MCI = VAL(temp)
      CASE "position","pos"
          mciSendString("status " & f_Alias & " position", temp, 256, 0)
          FB_MCI = VAL(temp)
    END SELECT
END FUNCTION

FUNCTION FB_MCI_open(BYVAL FILENAME AS STRING, BYVAL f_Alias AS STRING) AS INTEGER
    f_Alias = UCASE(f_Alias)
    FB_MCI ("close",f_Alias)
    FB_MCI_open = mciSendString("open " & CHR(34) & FILENAME & CHR(34) & " alias " & f_Alias, NULL, 0, 0)
    mciSendString ("set " & f_Alias & " time format milliseconds", NULL, 0, 0)
END FUNCTION

Code: Select all

'Frogger.bas

#include "fbgfx.bi"
using fb

'SOUND
#include "Sound.bas"

screenres 640,480,32

'SOUND
FB_MCI_open "Sound\Start.wav","S1"
FB_MCI_open "Sound\Hop.wav","S2"
FB_MCI_open "Sound\Croak.wav","S3"
FB_MCI_open "Sound\Finish.wav","S4"
dim n1 as integer=0
dim n2 as integer=0
dim n3 as integer=0
dim n4 as integer=0

type sprite
    x  as integer
    y  as integer
    dx as integer
    dy as integer
    w  as integer
    h  as integer
    speed as integer
end type

function scollision(s1 as sprite, s2 as sprite) as integer
    dim as integer hit
    hit = 0
    if s1.x >= s2.x and s1.x <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 1
        end if
        if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
            hit = 2
        end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then 'overlap
            hit = 3
        end if
    end if
    if s1.x + s1.w >= s2.x and s1.x + s1.w <= s2.x+s2.w then
        if s1.y >= s2.y and s1.y <= s2.y + s2.h then
            hit = 4
        end if
        if s1.y + s1.h >= s2.y and s1.y + s1.h <= s2.y+s2.h then
            hit = 5
        end if
        if s1.y <= s2.y and s1.y + s1.h >= s2.y + s2.h then  'overlap
            hit = 6
        end if   
    end if
    return hit
end function

dim shared frog as sprite
dim shared car(1 to 4) as sprite
dim shared croc(1 to 4) as sprite
dim as string text  'to read data statements

dim as FB.Image ptr iFrog = imagecreate(21,23,0)
for j as integer = 0 to 22
    read text
    for i as integer = 0 to 20
        if mid(text,i+1,1)="P" then
            pset(i,j),&HFFFF00FF
        end if
        if mid(text,i+1,1)="B" then
            pset(i,j),&HFF000000
        end if
        if mid(text,i+1,1)="G" then
            pset(i,j),&HFF00FF00
        end if
        if mid(text,i+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
    next i
next j
get (0,0)-(20,22), iFrog

dim as FB.Image ptr deadFrog = imagecreate(21,23,0)
for j as integer = 0 to 22
    for i as integer = 0 to 20
        if point(i,j) = &HFF00FF00 then
            pset(i,j),&HFFFF0000
        end if
        if point(i,j)=&HFFFFC90E then
            pset(i,j),&HFF0000FF 
        end if
    next i
next j
get (0,0)-(20,22), deadFrog

'create a car
dim as FB.Image ptr icar1 = imagecreate(40,20,0)
for j as integer = 0 to 19
    read text
    for i as integer = 0 to 39
        if mid(text,i+1,1)="P" then
            pset(i,j),&HFFFF00FF
        end if
        if mid(text,i+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,i+1,1)="W" then
            pset (i,j),&HFFFFFFFF
        end if
        if mid(text,i+1,1)="R" then
            pset (i,j),&HFFED1C24
        end if
    next i
next j
get (0,0)-(39,19), icar1

dim as FB.Image ptr iCar2 = imagecreate(40,20,0)
'flip car image horizontally
dim as integer k,v
for j as integer = 0 to 19
    for i as integer = 0 to 19
        v=point(i,j)
        pset(i,j),point(39-i,j)
        pset(39-i,j),v
    next i
next j
get (0,0)-(39,19), iCar2

'create a crocs
dim as FB.Image ptr icroc1 = imagecreate(80,20,0)
for i as integer = 0 to 79
    read text
    for j as integer = 0 to 19
        if mid(text,j+1,1)="P" then
            pset (i,j),&HFFFF00FF
        end if
        if mid(text,j+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,j+1,1)="G" then
            pset(i,j),&HFF22B14C
        end if
        if mid(text,j+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
        if mid(text,j+1,1)="X" then
            pset(i,j),&HFF3F48CC
        end if
    next j
next i
get (0,0)-(79,19), icroc1

dim as FB.Image ptr icroc2 = imagecreate(80,20,0)
'flip croc image horizontally
for j as integer = 0 to 19
    for i as integer = 0 to 39
        v=point(i,j)
        pset(i,j),point(79-i,j)
        pset(79-i,j),v
    next i
next j
get (0,0)-(79,19), icroc2

'create a crocs
dim as FB.Image ptr icrocA1 = imagecreate(80,20,0)
for i as integer = 0 to 79
    read text
    for j as integer = 0 to 19
        if mid(text,j+1,1)="P" then
            pset (i,j),&HFFFF00FF
        end if
        if mid(text,j+1,1)="B" then
            pset (i,j),&HFF000000
        end if
        if mid(text,j+1,1)="G" then
            pset(i,j),&HFF22B14C
        end if
        if mid(text,j+1,1)="Y" then
            pset(i,j),&HFFFFC90E
        end if
        if mid(text,j+1,1)="X" then
            pset(i,j),&HFF3F48CC
        end if
    next j
next i
get (0,0)-(79,19), icrocA1

dim as FB.Image ptr icrocA2 = imagecreate(80,20,0)
'flip croc image horizontally
for j as integer = 0 to 19
    for i as integer = 0 to 39
        v=point(i,j)
        pset(i,j),point(79-i,j)
        pset(79-i,j),v
    next i
next j
get (0,0)-(79,19), icrocA2

'bload "C:\FreeBasic\bitmaps\sprites\backGround.bmp"

'draw background
line (0,0)-(372,31),rgb(255,128,0),bf      'orange display area
line (0,32)-(372,62),rgb(0,128,0),bf       'green home
line (0,63)-(372,191),rgb(128,255,255),bf  'blue river
line (0,192)-(372,223),rgb(0,128,0),bf     'green safe spot
line (0,224)-(372,351),rgb(192,192,192),bf 'gray road
line (0,352)-(372,383),rgb(0,128,0),bf     'green start
line (0,384)-(372,415),rgb(255,128,0),bf   'orange display area
for i as integer = 0 to 5
    circle (i*62+31,47),12,rgb(128,0,0),,,,f 'frog holes
next i
'lines on road
line (0,256)-(372,256),rgb(255,255,0)  'yellow lines
line (0,288)-(372,288),rgb(255,255,0)
line (0,320)-(372,320),rgb(255,255,0)

'display text
locate 2,1
color rgb(0,0,0),rgb(255,128,0)  'black on orange
print "   FROGGER GAME   "

dim as FB.Image ptr backGround = imagecreate(372,416,0)
get (0,0)-(371,415),backGround

dim as string reply

do
    reply = ""  'signal to keep going while reply <> "y" or "x"
    frog.x=170
    frog.y=357
    frog.w=21
    frog.h=23
    frog.speed=32

    car(1).x = 0
    car(1).y = 230
    car(1).dx = 1
    car(1).dy = 0
    car(1).w = 40
    car(1).h = 20

    car(2).x = 300
    car(2).y = 262
    car(2).dx = 1
    car(2).dy = 0
    car(2).w = 40
    car(2).h = 20

    car(3).x = 150
    car(3).y = 294
    car(3).dx = 1
    car(3).dy = 0
    car(3).w = 40
    car(3).h = 20

    car(4).x = 30
    car(4).y = 326
    car(4).dx = 1
    car(4).dy = 0
    car(4).w = 40
    car(4).h = 20

    croc(1).x = 0
    croc(1).y = 72
    croc(1).dx = 1
    croc(1).dy = 0
    croc(1).w = 80
    croc(1).h = 20

    croc(2).x = 300
    croc(2).y = 104
    croc(2).dx = 1
    croc(2).dy = 0
    croc(2).w = 80
    croc(2).h = 20

    croc(3).x = 150
    croc(3).y = 136
    croc(3).dx = 1
    croc(3).dy = 0
    croc(3).w = 80
    croc(3).h = 20

    croc(4).x = 30
    croc(4).y = 168
    croc(4).dx = 1
    croc(4).dy = 0
    croc(4).w = 80
    croc(4).h = 20

    dim as integer chosenLog
    chosenLog = 0

    dim as double now
    now = 0
    
    'SOUND
    if n1=0 then
      FB_MCI "play", "S1"
      n1=1
    end if
    
    do
        screenlock()

        cls
        'draw background
        put (0,0),backGround,pset

        'draw croc under frog
        for i as integer = 1 to 4
            if croc(i).dx < 0 then
                if chosenLog = i then
                    put (croc(i).x,croc(i).y),icrocA2,trans
                else
                    put (croc(i).x,croc(i).y),icroc2,trans
                end if
            else
                if chosenLog = i then
                    put (croc(i).x,croc(i).y),icrocA1,trans
                else
                    put (croc(i).x,croc(i).y),icroc1,trans
                end if
            end if
        next i

        'draw dead frog if speed = 0 else draw live frog
        if frog.speed = 0 then
            put (frog.x,frog.y),deadFrog,trans  'change to a dead frog sprite later
        else
            put (frog.x,frog.y),iFrog, trans
        end if

        'draw cars on top of frog
        for i as integer = 1 to 4
            if car(i).dx < 0 then
                put(car(i).x,car(i).y),iCar2,trans  'moving left
            else
               put (car(i).x, car(i).y ), iCar1, trans 'moving right
           end if
        next i

        locate 50,1
        
        if frog.speed = 0 then
            print "  ****  FROG DEAD  ****"
            'SOUND
            if n3=0 then
              FB_MCI "play", "S3"
              n3=1
            end if
        end if
        
        if frog.y < 64 then
            print "  ****  FROG HOME  ****"
            'SOUND
            if n4=0 then
              FB_MCI "play", "S4"
              n4=1
            end if
        end if

        print " HIT SPACE KEY to start again OR ESC key to END program"

        screenunlock()

        'update car positions
        for i as integer = 1 to 4
            car(i).x = car(i).x + car(i).dx
        next i

        'update log positions
        for i as integer = 1 to 4 
            croc(i).x = croc(i).x + croc(i).dx
           'update frog.x position if on log
            if chosenLog = i then
                frog.x = frog.x + croc(i).dx
            end if
        next i

        'reverse car directions if out of bounds
        for i as integer = 1 to 4
            if car(i).x < 0 or car(i).x > 332 then car(i).dx=-car(i).dx
        next i

        'reverse croc directions if out of bounds
        for i as integer = 1 to 4
            if croc(i).x < 0 or croc(i).x > 312 then croc(i).dx=-croc(i).dx
        next i

        'user input accepted only every 0.25 seconds - feels like the real thing
        if timer > (now + 0.25) then

            if multikey(SC_SPACE) then
              reply = "y"
              'SOUND
              n1 = 0
              n2 = 0
              n3 = 0
              n4 = 0
            end if
            
            if multikey(SC_ESCAPE) then reply = "x"

            if frog.y > 63 then  'test frog hasn't reached home
                if multikey(SC_DOWN) andalso frog.y <352 then
                    frog.y = frog.y+frog.speed
                    now = timer
                    chosenLog=0
                    'SOUND
                    n2 += 1
                end if

                if multikey(SC_UP)  then
                    frog.y = frog.y-frog.speed
                    now = timer   'reset timer
                    chosenLog = 0 'if log remove log ID
                    'SOUND
                    n2 += 1
                end if

                if multikey(SC_RIGHT) andalso frog.x < 302 then
                    frog.x = frog.x+frog.speed
                    now = timer
                    chosenLog=0
                    'SOUND
                    n2 += 1
                end if

                if multikey(SC_LEFT) andalso  frog.x > 10  then
                    frog.x = frog.x-frog.speed
                    now = timer   
                    chosenLog = 0
                    'SOUND
                    n2 += 1
                end if
                
                'SOUND
                if n2 = 1 then
                  FB_MCI "play", "S2"
                  n2 = 0
                end if
                
            end if
        end if

        dim as integer hit

        if frog.y < 352 and frog.y > 224 then
            'test for collision with car
            hit = 0
            for i as integer = 1 to 4
                if hit = 0 then
                    hit = scollision(frog,car(i))
                end if
            next i
            if hit <> 0 then
                frog.speed = 0  'flag frog dead
            end if
        end if

        if frog.y < 192 and frog.y > 64 then
            'test collision with a log
             hit = 0
            for i as integer = 1 to 4
                hit = scollision(frog,croc(i))
                if hit <> 0 and chosenLog = 0  then
                    chosenLog = i
                end if
            next i
            if  chosenLog=0 then
                locate 1,1
                print "MISSED LOG"
                frog.speed = 0
            end if
        end if

        sleep 10, 1

    loop while reply <> "y" and reply <> "x"

loop while reply = "y"

'SOUND
FB_MCI "close", "S1"
FB_MCI "close", "S2"
FB_MCI "close", "S3"
FB_MCI "close", "S4"

end

'frog image 21 x 23
DATA "PPPPPPPPPBBBPPPPPPPPP"
DATA "PPPPPBBBBGGGBBBBPPPPP"
DATA "PPPPBYBBYBGBYBBYBPPPP"
DATA "PPPPBYBBYBGBYBBYBPPPP"
DATA "PBBPBYYYYBGBYYYYBPBBP"
DATA "BGGBPBBBBGGGBBBBPBGGB"
DATA "PBGGBBGGGGGGGGGBBGGBP"
DATA "BGGGGBBGGGBGGGBBGGGGB"
DATA "PBGGGBBBBGBGBBBBGGGBP"
DATA "BGGGGGBGGGBGGGBGGGGGB"
DATA "PBBBGBGGGGGGGGGBGBBBP"
DATA "PPPPBBGGGGBGGGGBBPPPP"
DATA "PPPPBGGGGGBGGGGGBPPPP"
DATA "PPPPBGGGGGBGGGGGBPPPP"
DATA "PBBBBGGGGGBGGGGGBBBBP"
DATA "PBGGGBGGGGBGGGGBGGGBP"
DATA "PBGGGGBGGGBGGGBGGGGBP"
DATA "PBBGGGBGGGBGGGBGGGBBP"
DATA "PPBGBGGBGGBGGBGGBGBPP"
DATA "PBBBGGGBGGGGGBGGGBBBP"
DATA "PBGGGBBGBGGGBGBBGGGBP"
DATA "PBBBGGBBBGGGBBBGGBBBP"
DATA "PPPPBBBPPBBBPPBBBPPPP"

'car3D data
DATA "PPPPPBBBBBBBBBBBBBBBBBBBBBPPPPPPPPPPPPPP"
DATA "PPPPBRRRRRRRRRRRRRRRRRRRBWBPPPPPPPPPPPPP"
DATA "PPPBBRRRRRRRRRRRRRRRRRRRBWWBBPPPPPPPPPPP"
DATA "PPBWBRRRRRRRRRRRRRRRRRRRBWWWWBPPPPPPPPPP"
DATA "PBBWBRRRRRRRRRRRRRRRRRRRBWWWWWBBBBBBBBBB"
DATA "BRBWBRRRRRRRRRRRRRRRRRRRBWWWWWWBRRRRRRRB"
DATA "BRBWBRRRRRRRRRRRRRRRRRRRBWWWWWWBRRRRRRRB"
DATA "BRBWBBBBBBBBBBBBBBBBBBBBBBWWWWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBBWWWWWBRRRRRBRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWBWWWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWBBWWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWWWBWBRRRRRRRB"
DATA "BRBWBWWWWWWWWWWBWWWWWWWWBWWWWWBBRRRRRRRB"
DATA "BRBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
DATA "BRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRB"
DATA "BRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRRB"
DATA "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB"
DATA "PBBBBBBBBPPPPPPPPPPPPPPPPPPPPPPBBBBBBBBB"
DATA "PPBBBBBBPPPPPPPPPPPPPPPPPPPPPPPPBBBBBBBP"
DATA "PPPBBBBPPPPPPPPPPPPPPPPPPPPPPPPPPBBBBBPP"

'croc data
DATA "PPPPPPPPPPPPPPBBXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPPBGGXBP"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPPBGXGPP"
DATA "PPPPPPPPPPPPPBBGXXPX"
DATA "PPPPPPPPPPPPBBGGXXGX"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPPBGXXXX"
DATA "PPPPPPPPPPPPBBBGGXXP"
DATA "PPPPPPPPPPPPBGGGGXBP"
DATA "PPPPPPPPPPPPBBGGGXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPBGGGXBP"
DATA "PPPPPPPPPPPPBBGGGGXP"
DATA "PPPPPPPPPPPPBBGGBGXB"
DATA "PPPPPPPPPPPPPBGBBGXX"
DATA "PPPPPPPPPPPPBBGBGGBX"
DATA "PPPPPPPPPPPPBGGGGGBX"
DATA "PPPPPPPPPPPPBGGBGGPX"
DATA "PPPPPPPPPPPBBGGBGGGX"
DATA "PPPPPPPPPPBBGGGGGGGX"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGBGXGP"
DATA "PPPPPPPPPBBGGGGBGXGP"
DATA "PPPPPPPPBBGGGGGBGXGP"
DATA "PPPPPPPPBGGGGGBBGXGP"
DATA "PPPPPPPPBGGGGGBGGXGX"
DATA "PPPPPPPBBGGGGGBGGGGX"
DATA "PPPPPPBBGGGBGGBBGGGX"
DATA "PPPPPPBGGGBBGGGBGGGP"
DATA "PPPPPPBBGGGBGGGBGGGP"
DATA "PPPPPPPBGGBBGGGBGBGP"
DATA "PPPPPPBBGGBBGGGBGBGP"
DATA "PPPPPBBGGGGBGGBGBBGX"
DATA "PPPPPBGGGGGGGGBGBGGX"
DATA "PPPPPBBGGGGGGGBGBGGX"
DATA "PPPPPPBGGGGGGGBBGGBX"
DATA "PPPPPBBGGGBGGGBBGGBX"
DATA "PPPPPBGGGGGGGGBGGGBX"
DATA "PPPPBBGGGGGGGBBGGGXP"
DATA "PPPPBBGGGGGGGBGGGGXP"
DATA "PPPPPBGGGGGGBBGGGGXP"
DATA "PPPPPBGGGBGGBGGGGGXP"
DATA "PPPPPBBGGGGGBGGGGGXP"
DATA "PPPPPPBGGGGGGGBGGGPP"
DATA "PPPPPBBGGGGGGBBGGGPX"
DATA "PPPPBBGGGBGGGGBGGGPX"
DATA "PPPPBBGGBBGGGGBGBGXX"
DATA "PPPPPBGGBGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBGGGBXX"
DATA "PPPPBBGGGBGBGBGGGBXX"
DATA "PPPPBGGGGBGBGBGGGXXX"
DATA "PPBBBGGGGGGGGBBGGXXX"
DATA "PBGGGGBBGGGGGBBGGXPX"
DATA "BGYYYYYBGGGGGGBGGXPX"
DATA "BGYBBYYBGGGGGGBGGGPX"
DATA "BGYBBYYBGGGGGGBGGGXX"
DATA "PBGGGBBGGGGGGGBBGGXX"
DATA "PPBBBBBBGGGGGGBBBGXX"
DATA "PPPPPPPBGGGGGBGBBGXX"
DATA "PPPPPPPPBGGGGBBBBGXX"
DATA "PPPPPPPPBGGGGBBBGGXX"
DATA "PPPPPPPPPBGGGGBBGGPP"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGGXX"
DATA "PPPPPPPPPPBGGGBBGGXP"
DATA "PPPPPPPPPPBGGGBBGXXP"
DATA "PPPPPPPPPPBGGGBBGXXP"
DATA "PPPPPPPPPBBGGGBBXXXP"
DATA "PPPPPPPPBGGGGGBBXXPX"
DATA "PPPPPPPBGBBGGGBBXXPX"
DATA "PPPPPPPBGBBBGGBBXXPX"
DATA "PPPPPPPPBGGGGBBBXXPX"
DATA "PPPPPPPPPBBBBBBXXPPX"

'crocA
DATA "PPPPPPPPPPPPPPBBXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPPBGGXBP"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPBBGXXBP"
DATA "PPPPPPPPPPPPPPBGXGPP"
DATA "PPPPPPPPPPPPPBBGXXPX"
DATA "PPPPPPPPPPPPBBGGXXGX"
DATA "PPPPPPPPPPPPPBBGXXBX"
DATA "PPPPPPPPPPPPPPBGXXXX"
DATA "PPPPPPPPPPPPBBBGGXXP"
DATA "PPPPPPPPPPPPBGGGGXBP"
DATA "PPPPPPPPPPPPBBGGGXBP"
DATA "PPPPPPPPPPPPPBBGGXBP"
DATA "PPPPPPPPPPPPPBGGGXBP"
DATA "PPPPPPPPPPPPBBGGGGXP"
DATA "PPPPPPPPPPPPBBGGBGXB"
DATA "PPPPPPPPPPPPPBGBBGXX"
DATA "PPPPPPPPPPPPBBGBGGBX"
DATA "PPPPPPPPPPPPBGGGGGBX"
DATA "PPPPPPPPPPPPBGGBGGPX"
DATA "PPPPPPPPPPPBBGGBGGGX"
DATA "PPPPPPPPPPBBGGGGGGGX"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGGGXGP"
DATA "PPPPPPPPPPBGGGGBGXGP"
DATA "PPPPPPPPPBBGGGGBGXGP"
DATA "PPPPPPPPBBGGGGGBGXGP"
DATA "PPPPPPPPBGGGGGBBGXGP"
DATA "PPPPPPPPBGGGGGBGGXGX"
DATA "PPPPPPPBBGGGGGBGGGGX"
DATA "PPPPPPBBGGGBGGBBGGGX"
DATA "PPPPPPBGGGBBGGGBGGGP"
DATA "PPPPPPBBGGGBGGGBGGGP"
DATA "PPPPPPPBGGBBGGGBGBGP"
DATA "PPPPPPBBGGBBGGGBGBGP"
DATA "PPPPPBBGGGGBGGBGBBGX"
DATA "PPPPPBGGGGGGGGBGBGGX"
DATA "PPPPPBBGGGGGGGBGBGGX"
DATA "PPPPPPBGGGGGGGBBGGBX"
DATA "PPPPPBBGGGBGGGBBGGBX"
DATA "PPPPPBGGGGGGGGBGGGBX"
DATA "PPPPBBGGGGGGGBBGGGXP"
DATA "PPPPBBGGGGGGGBGGGGXP"
DATA "PPPPPBGGGGGGBBGGGGXP"
DATA "PPPPPBGGGBGGBGGGGGXP"
DATA "PPPPPBBGGGGGBGGGGGXP"
DATA "PPPPPPBGGGGGGGBGGGPP"
DATA "PPPPPBBGGGGGGBBGGGPX"
DATA "PPPPBBGGGBGGGGBGGGPX"
DATA "PPPPBBGGBBGGGGBGBGXX"
DATA "PPPPPBGGBGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBBGGBXX"
DATA "PPPPPBGGGGGGGBGGGBXX"
DATA "PPPPBBGGGBGBGBGGGBXX"
DATA "PPPPBGGGGBGBGBGGGXXX"
DATA "PPBBBGGGGGGGGBBGGXXX"
DATA "PBGGGGBBGGGGGBBGGXPX"
DATA "BGYYYYYBGGGGGGBGGXPX"
DATA "BGYBBYYBGGGGGGBGGGPX"
DATA "BGYBBYYBGGGGGGBGGGXX"
DATA "PBGGGBBGGGGGGGBBGGXX"
DATA "PPBBBBBBGGGGGGBBBGXX"
DATA "PPPPPPBGGGGGGGGBBGXX"
DATA "PPPPPPBGBGBBBGGBBGXX"
DATA "PPPPPBGGBBBPBBBBGGXX"
DATA "PPPPPBGBBBPPPPBBGGPP"
DATA "PPPPPBGBWWBPPPBBGGXP"
DATA "PPPPPBGBBBPPPBBBGGXP"
DATA "PPPPBGGBPPPPBWWBGGXX"
DATA "PPPPBGGBBBPPPBBBGGXP"
DATA "PPPPBGGBWWBPPPPBGXXP"
DATA "PPPPBGGBBBPPPBBBGXXP"
DATA "PPPBGGGBPPPPBWWBXXXP"
DATA "PPBBGGGBBBPPPBBBXXPX"
DATA "PBGGGGGBWWBPPPPBXXPX"
DATA "BGBBGGGBBBPPPBBBXXPX"
DATA "BGBBBGGBPPPPBWWBXXPX"
DATA "PBGGGGBBPPPPPBBXXPPX"
Last edited by Roland Chastain on Jul 30, 2012 11:11, edited 6 times in total.
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Sounds for Frogger

Post by Roland Chastain »

Hello gentlemen !

I've just made an important update of my previous post.
Last edited by Roland Chastain on Jun 21, 2012 16:27, edited 1 time in total.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Frogger revisited

Post by BasicCoder2 »

Very good Roland.

Suggestions:

A continuous background tune not just one at start and end and a score card.

It needs levels of difficulty to be added for different players.

John
Post Reply