FreeBasic

Хороший пример реализации игры лабиринт.
Платформы: Windows , Linux.
Автор: Destructosoft 2011 - Оф. сайт

/'Perspective Maze Demo
2011 Destructosoft
Open Source!
v1.000
20110606

Demonstrates a 3/4 perspective maze As drawn properly, To wit:
Floor tiles are 32x24; walls are 32x32 With a ceiling of 24x32; objects stand in the middle of the floor tile.
One problem With the 3/4 perspective Is that walls could be taller but would obscure more of the game. Making wider corridors would alleviate This slightly but would Not prevent object obstruction.
px,py Is player location; x,y Is Draw location For floor tiles; x0,y0 Is map location.
Shadows are done As follows:
a 3

[]2  With shadow #4 On the wall itself.
[]1  a= no shadow needed since the wall's hiding the floor!
Doors are Not implemented but the graphics are. To Add doors, we would need To Add rectangular rooms And have the entrances be doors. Then we would need To detect them so As To Not walk through them without opening them first. (Easy enough To implement.)
'/
Enum

floor=1,wall,door,player,object

shadow1,shadow2,shadow3,shadow4
tilemax
End Enum

Const alfa =RGBA(0,0,0,0)
Const shadow=RGBA(0,0,0,127)
Const brown =RGB(127, 63, 31)
Const green =RGB( 0,255, 0)
Const grey =RGB(127,127,127)
Const lgrey =RGB(191,191,191)
Const orange=RGB(255,127, 0)
Const purple=RGB(255, 0,255)
Const white =RGB(255,255,255)
Const yellow=RGB(255,255, 0)
Const mapsize=255

Dim As Any Ptr g(tilemax)
Dim As Byte dx(3)=>{0,1,0,-1}
Dim As Byte dy(3)=>{-1,0,1,0}
Dim As Byte b,m(mapsize,mapsize)
Dim As Short obj,px,py,t,u,x,x0,y,y0
Dim As Integer room
Dim As String a
Screenres 512,512,32

Randomize

x=32'create and draw graphics
For t=0 To tilemax
    Select Case t
        Case floor,shadow1,shadow2,shadow3
            y=24

        Case wall,door
            y=56

        Case player,object,shadow4
            y=32

        Case Else

            y=1

    End Select

    g(t)=ImageCreate(x,y)
Next

Line g(floor),(0,0)-(31,31),0,b
Line g(floor),(1,1)-(30,30),grey,bf
Line g(wall),(0,0)-(31,55),0,bf
Line g(wall),(1,1)-(30,23),orange,bf
Line g(wall),(1,25)-(30,54),brown,bf
Line g(door),(0,0)-(31,55),0,bf
Line g(door),(1,1)-(30,23),white,bf
Line g(door),(1,25)-(30,54),lgrey,bf
Line g(player),(0,0)-(31,31),alfa,bf
Circle g(player),(16,16),15,yellow
Circle g(player),(16,16),14,yellow
Line g(object),(0,0)-(31,31),alfa,bf
Line g(object),(0,0)-(31,31),green
Line g(object),(0,31)-(31,0),green
Line g(shadow1),(0,0)-(31,23),alfa,bf
Line g(shadow1),(0,23)-(15,12),shadow
Line g(shadow1),(15,12)-(15,0),shadow
Paint g(shadow1),(0,0),shadow,shadow
Line g(shadow2),(16,0)-(31,23),alfa,bf
Line g(shadow2),(0,0)-(15,23),shadow,bf
Line g(shadow3),(0,0)-(31,23),alfa,bf
Line g(shadow3),(0,12)-(15,23),shadow,bf
Line g(shadow4),(0,0)-(31,31),alfa,bf
Line g(shadow4),(0,0)-(15,31),shadow
Paint g(shadow4),(0,31),shadow,shadow
For x=0 To mapsize'initialize map
    For y=0 To mapsize
        m(x,y)=wall
    Next

Next

room=Int(Rnd*16000)+16000'# floor squares on map
x=Int(Rnd*(mapsize-2))+1'starting position
y=Int(Rnd*(mapsize-2))+1

m(x,y)=floor
Do

    Do

        b=Int(Rnd*4)'move to random adjacent location
        x0=x+dx(b)*2

        y0=y+dy(b)*2

    Loop Until x0>0 And x0<255 And y0>0 And y0<255

    If m(x0,y0)=wall Then'dig tunnel to here
        m(x0,y0)=floor
        m(x+dx(b),y+dy(b))=floor
        room-=2

    End If

    x=x0:y=y0
Loop Until room<1

For t=0 To 100'put 1 O and 100 Xs
    Do

        x=Int(Rnd*mapsize)
        y=Int(Rnd*mapsize)
    Loop Until m(x,y)=floor
    If t=0 Then

        m(x,y)=player
        px=x:py=y
    Else

        m(x,y)=object

    End If

Next

Locate 2,22

Print"You are the letter O."
Locate 4

Print"Your mission is to track down the 100 rebel letter Xs in their"
Print"hiding places in the Rebel Hideout Maze. Catch them so they can"
Print"be forced to play football on chalkboards."
Locate 8,27

Print"Good luck!"
Sleep

iter:
Screenlock

Cls

y0=py-10

For y=0 To 528 Step 24

    x0=px-7

    For x=0 To 480 Step 32

        If x0>-1 And x0<256 And y0>-1 And y0<256 Then

            Put(x,y),g(floor),Pset

            If x0>0 And y0>0 And y0<255 Then

                If m(x0-1,y0+1)=wall Then

                    If m(x0-1,y0)=wall Then Put(x,y),g(shadow2),Alpha Else Put(x,y),g(shadow3),Alpha

                Else

                    If m(x0-1,y0)=wall Then Put(x,y),g(shadow1),Alpha

                End If

            End If

            Select Case m(x0,y0)
                Case floor
                Case wall,door
                    Put(x,y-32),g(m(x0,y0)),Pset

                    If x0>0 And y0<255 Then

                        If m(x0-1,y0+1)=wall Then Put(x,y-8),g(shadow4),Alpha

                    End If

                Case player,object

                    Put(x,y-20),g(m(x0,y0)),Alpha

                Case Else

                    Line(x,y)-(x+31,y+23),purple,bf'error tile
            End Select

        End If

        x0+=1

    Next

    y0+=1

Next

If obj>0 Then Locate 64,1:Print obj;" caught ";
Screenunlock

Do'simple enough keypress routine and input interpretation
a=InKey

Loop Until a<>""
x=px:y=py
Select Case a[0]
    Case 27'esc=quit
        End

    Case 49'1
        x-=1:y+=1

    Case 50'2
        y+=1

    Case 51'3
        x+=1:y+=1

    Case 52'4
        x-=1

    Case 54'6
        x+=1

    Case 55'7
        x-=1:y-=1

    Case 56'8
        y-=1

    Case 57'9
        x+=1:y-=1

    Case 255

        Select Case a[1]
            Case 72'^
                y-=1

            Case 75'<
                x-=1

            Case 77'>
                x+=1

            Case 80'v
                y+=1

        End Select

End Select

If x<0 Then x=0

If x>255 Then x=255

If y<0 Then y=0

If y>255 Then y=255

If m(x,y)=wall Then x=px:y=py'blocked
m(px,py)=floor
px=x:py=y
If m(x,y)=object Then obj+=1

If obj=100 Then

    Cls

    Locate 31

    Print"Congratulations! You captured all 100 rebels!"
    Sleep 5000,1

    End

End If

m(px,py)=player'erases whatever was already here
Goto iter