mouse and maze

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

mouse and maze

Post by BasicCoder2 »

Just a mouse moving around in a simple maze.

Code: Select all


const MU = 1  'Mouse Up
const MR = 2  'Mouse Right
const MD = 3  'Mouse Down
const ML = 4  'Mouse Left
    
    
Dim As Long fps
Dim As Byte speed = 128

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,_lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      _lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

const MAZEW = 10
const MAZEH = 9
const TILEW = 64
const TILEH = 64
const SCRW = (MAZEW+1)*TILEW
const SCRH = (MAZEH+1)*TILEH

dim shared as integer maze(0 to MAZEW,0 to MAZEH)
'read maze
for j as integer = 0 to MAZEH
    for i as integer = 0 to MAZEW
        read maze(i,j)
    next i
next j


type MICRO_MOUSE
    as integer x    'x position in pixels
    as integer y    'y position in pixels
    as integer w    'width of image
    as integer h    'height of image
    as integer xd   'change in x direction
    as integer yd   'change in y direction
    as integer d    'direction
    as ulong   c    'color
end type

dim shared as MICRO_MOUSE mm

'STARTING VALUES
mm.x = 1*TILEW  'pixel resolution on tile center
mm.y = 1*TILEH
mm.w = TILEW
mm.h = TILEH
mm.d = MR  'mouse looking right
mm.xd = 1
mm.yd = 0
mm.c  = rgb(255,0,0)

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls  'black pen, white paper

'create four pointers
dim shared as any ptr mouseDown,mouseUp,mouseLeft,mouseRight
'create four bitmaps pointed to by each pointer
mouseDown = imagecreate(64,64)
mouseUp   = imagecreate(64,64)
mouseLeft = imagecreate(64,64)
mouseRight= imagecreate(64,64)

'read mouse image date
dim as string datum
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset mouseDown,(i,j),rgb(0,0,0)
            pset mouseUp,(i,63-j),rgb(0,0,0)
            pset mouseRight,(j,i),rgb(0,0,0)
            pset MouseLeft,(63-j,i),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset mouseDown,(i,j),rgb(200,100,0)
            pset mouseUp,(i,63-j),rgb(200,100,0)
            pset mouseRight,(j,i),rgb(200,100,0)
            pset mouseLeft,(63-j,i),rgb(200,100,0)
        end if
        if mid(datum,i+1,1)="." then
            pset mouseDown,(i,j),rgb(255,0,255)
            pset mouseUp,(i,63-j),rgb(255,0,255)
            pset mouseRight,(j,i),rgb(255,0,255)
            pset mouseLeft,(63-j,i),rgb(255,0,255)
        end if
    next i
next j

dim shared as any ptr cheese
cheese = imagecreate(64,64)

'read cheese image data
for j as integer = 0 to 63
    read datum
    for i as integer = 0 to 63
        if mid(datum,i+1,1)="#" then
            pset cheese,(i,j),rgb(0,0,0)
        end if
        if mid(datum,i+1,1)="*" then
            pset cheese,(i,j),rgb(255,201,14)
        end if
        if mid(datum,i+1,1)="." then
            pset cheese,(i,j),rgb(255,242,0)
        end if
        if mid(datum,i+1,1)="@" then
            pset cheese,(i,j),rgb(255,127,39)
        end if
        if mid(datum,i+1,1)=" " then
            pset cheese,(i,j),rgb(255,0,255)
        end if
    next i
next j


sub display()
'    dim as Vector2 v2
    screenlock
    cls

    'draw maze
    for j as integer = 0 to 9
        for i as integer = 0 to 10
            if maze(i,j) = 1 then
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(150,150,150),bf
            else
                line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(255,255,255),b
            end if
            line (i*TILEW,j*TILEH)-(i*TILEW+TILEW-1,j*TILEH+TILEH-1),rgb(0,0,0),b
            
        next i
    next j

    'draw mouse
    'line (mm.x,mm.y)-(mm.x+mm.w,mm.y+mm.h),mm.c,bf
    if mm.d = MU then
        put (mm.x,mm.y),mouseUp,trans
    end if
    if mm.d = MR then
        put (mm.x,mm.y),mouseRight,trans
    end if
    if mm.d = MD then
        put (mm.x,mm.y),mouseDown,trans
    end if
    if mm.d = ML then
        put (mm.x,mm.y),mouseLeft,trans
    end if
    
    
    put (5*64,4*64),cheese,trans

    locate 3,2
    if mm.d = MU then print "UP"
    if mm.d = MR then print "RIGHT"
    if mm.d = MD then print "DOWN"
    if mm.d = ML then print "LEFT"
        
    screenunlock
end sub

function onTile(m as MICRO_MOUSE) as boolean
    if m.x = int(m.x\TILEW)*TILEW and m.y = int(m.y\TILEH)*TILEH then
        return TRUE
    else
        return FALSE
    end if
end function

sub makeMove(m as MICRO_MOUSE)
    m.x = m.x + m.xd
    m.y = m.y + m.yd
end sub


sub setVelocity(m as MICRO_MOUSE)
    if m.d = MU then m.xd=  0  :m.yd= -2   'up
    if m.d = MR then m.xd=  2  :m.yd=  0   'right
    if m.d = MD then m.xd=  0  :m.yd=  2   'dowm
    if m.d = ML then m.xd= -2  :m.yd=  0   'left
end sub


do

    display()
    'update mouse position
    makeMove(mm)

    dim as integer dd(1 to 4) 'free direction to move if =0
    dim as integer cc   'how many free sides?
    dim as integer rd   'reverse direction

    
    if onTile(mm) then
        locate 1,1
        'zero directions assume all directions free
        dd(1)=0  'up
        dd(2)=0  'right
        dd(3)=0  'down
        dd(4)=0  'left
        cc = 0  'count sides blocked
        
        'set side values
        if maze( mm.x\TILEW  , mm.y\TILEH-1) = 1 then  'UP
            dd(1)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW+1, mm.y\TILEH)   = 1 then  'RIGHT
            dd(2)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW  , mm.y\TILEH+1)   = 1 then  'DOWN
            dd(3)=1
            cc = cc + 1
        end if
        if maze( mm.x\TILEW-1, mm.y\TILEH)     = 1 then  'LEFT
            dd(4)=1
            cc = cc + 1
        end if
        
        'compute reverse direction
        rd = mm.d + 2
        if rd > 4 then rd = rd - 4
        
        if cc = 3 then 'then select reverse
            mm.d = rd
        else
            mm.d = int(rnd(1)*4)+1
            while dd(mm.d)=1 or mm.d = rd
                mm.d = int(rnd(1)*4)+1
            wend
        end if

        setVelocity(mm)
      
    end if
    
    sleep regulate(speed,fps),1
    
loop until multikey(&H01)

'MAZE
data 1,1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,0,1,0,0,0,1
data 1,1,1,1,1,0,0,0,1,1,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,1,0,0,0,1,0,1,0,1
data 1,0,1,0,1,1,1,0,1,0,1
data 1,0,0,0,0,0,0,0,0,0,1
data 1,0,1,1,1,1,1,1,1,0,1
data 1,0,1,0,0,0,0,0,0,0,1
data 1,1,1,1,1,1,1,1,1,1,1

'image mouse data
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "................................##.............................."
DATA "..............................######............................"
DATA "............................##******##.........................."
DATA "...........................#**********#........................."
DATA "..........................#************#........................"
DATA ".........................#**************#......................."
DATA ".........................#**************#......................."
DATA "........................#****************#......................"
DATA ".......................#******************#....................."
DATA ".......................#******************#....................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA "......................#********************#...................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA ".....................#**********************#..................."
DATA "....................###********************###.................."
DATA "...................####******************######................."
DATA "..................#******#**************#******#................"
DATA ".................#********#************#********#..............."
DATA ".................#********#************#********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#**********#********#**********#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA ".................#******************************#..............."
DATA "..................#****************************#................"
DATA "...................#**************************#................."
DATA "....................###********************###.................."
DATA ".......................#****##******##****#....................."
DATA ".......................#***####****####***#....................."
DATA "........................#***##******##***#......................"
DATA "........................#****************#......................"
DATA ".........................#**************#......................."
DATA "..........................#************#........................"
DATA ".....................#...####**####**####...#..................."
DATA "......................###..#*#*####*#*#..###...................."
DATA "..........................###***##***###........................"
DATA ".........................#...##****##...#......................."
DATA ".......................##...#..####..#...##....................."
DATA "...........................#..........#........................."

'cheese data
DATA "                                                                "
DATA "                                     #####                      "
DATA "                                   ##.....######                "
DATA "                                 ##.............####            "
DATA "                               ##...................###         "
DATA "                              #........................##       "
DATA "                            ##.............####..........#      "
DATA "                           #..............#@@@@#..........#     "
DATA "                            #............#@@@@@@#..........#    "
DATA "                            #.............#@@@@##...........#   "
DATA "                            #..............####..............#  "
DATA "                   ###    ##..................................# "
DATA "                 ##...####.................................#### "
DATA "                #....................................######***# "
DATA "              ##..............................#######*********# "
DATA "            ##.........................#######****************# "
DATA "          ##.........#####.......######***********************# "
DATA "         #..........#@@@@@#######*****************************# "
DATA "       ##..........#@@@@@@@#**********************************# "
DATA "     ##......#######@@@@@@@#**********************************# "
DATA "   ##.#######*******#@@@@@#***********************************# "
DATA "  ####***************#####************************************# "
DATA " #*****************************************####***************# "
DATA " #****************************************#@@@@#**************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #***************************************#@@@@@@#*************# "
DATA " #****************************************#@@@@#**************# "
DATA " #*****************************************####***************# "
DATA " ##***********************************************************# "
DATA "   #****************************###***************************# "
DATA "    #*****####*****************#@@@#**************************# "
DATA "    #****#@@@@#***************#@@@@@#*************************# "
DATA "    #***#@@@@@@#**************#@@@@@#*************************# "
DATA "   #****#@@@@@@#**************#@@@@@#*******************###***# "
DATA "  #*****#@@@@@@#***************#@@@#*******************#@@#***# "
DATA " #*******#@@@@#*****************###********************#@@@#**# "
DATA " #********####*****************************************#@@@#**# "
DATA " #*****************************************************#@@@#**# "
DATA " #******************************************************###***# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " #************************************************************# "
DATA " ############################################################## "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
DATA "                                                                "
Top
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: mouse and maze

Post by UEZ »

Nice - I like it.
Top
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: mouse and maze

Post by dodicat »

Very neat basiccoder2.
Top
neil
Posts: 586
Joined: Mar 17, 2022 23:26

Re: mouse and maze

Post by neil »

Nice graphics.
Top
neil
Posts: 586
Joined: Mar 17, 2022 23:26

Re: mouse and maze

Post by neil »

Here's a maze maker.

Code: Select all

Screenres 1280,800,32
Dim As Integer c,x,y,xx,yy,size
Randomize
size = 10

For y=0 To 50
   For x=0 To 63
      c = Int(Rnd*2) : xx = x*size*2 : yy = y*size*2
      If c = 0 Then Line (xx,yy)-(xx+size*2,yy),rgb(0,255,0)
      If c = 1 Then Line (xx,yy)-(xx,yy+size*2),rgb(0,255,0)
   Next x
Next y
Sleep
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”