Perspective Maze Demo

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Destructosoft
Posts: 88
Joined: Apr 03, 2011 3:44
Location: Inside the bomb
Contact:

Perspective Maze Demo

Post by Destructosoft »

A little something I whipped up this morning.

Demonstrates a 3/4 perspective maze with different size tiles to represent walls, floors and objects. Makes use of wall shadows.

Also includes a simple game. Feel free to make your own and use better graphics.

Code: Select all

/'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
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Post by rdc »

Very cool. Nice job on this.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

Also includes a simple game. Feel free to make your own and use better graphics.
O3O I remember an old Coco 2 game just like this, from back in the day at a junk store, too many dollar bills to afford for someone of my age, I WILL remake this into something epic!



:M

Thanks!!!

[edit] Can you explain how the maze was generated? I'm lost on how such a complex maze, without impossible rooms, was created.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Post by D.J.Peters »

Hello Destructosoft,
good job so far

"Object" is an reserved word in current SVN version of FreeBASIC
and the keyboard doo:loop needs an sleep command
my CPU will use 100% and the cooler begins to make noise

Joshy

Code: Select all

/'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

do
  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
    sleep 10,1
  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
  elseIf x>255 Then
    x=255
  end if

  If y<0 Then
    y=0
  elseIf y>255 Then
    y=255
  end if

  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
loop

Destructosoft
Posts: 88
Joined: Apr 03, 2011 3:44
Location: Inside the bomb
Contact:

Post by Destructosoft »

D.J.Peters wrote: "Object" is an reserved word in current SVN version of FreeBASIC
and the keyboard do:loop needs an sleep command
my CPU will use 100% and the cooler begins to make noise
Thanks for the input and corrections.
kiyotewolf wrote: Can you explain how the maze was generated? I'm lost on how such a complex maze, without impossible rooms, was created.
1. Fill the array with walls
2. Select a random square not near the edges and make it floor
3. Check locations at random two squares away (exemplified with the dx() and dy() arrays)
4. If a wall, move there, change it to floor and also change the square inbetween them to floor.
5. If not a wall, move there anyway but don't change anything.
6. Go to 3 until you've changed a random number of map squares (from 1/4 to 1/2 of their total).

Maze generation gets more complex if you want to add rooms and long corridors like in roguelikes; basically you need check routines to determine if random areas of the map can be used for a room, and path routines to connect them to existing connected areas.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Post by sir_mud »

Here's my slightly tweaked version:
* player and Xs have shadows
* now responds to clicking close
* final score screen at the end
* frees memory at the end
* the colors duke, the colors!

Code: Select all

/'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 timer

'loading
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),(18,22),14,shadow,,,.5 
paint g(player),(17,18),shadow,shadow 
circle g(player),(16,16),15,yellow,,,.999
circle g(player),(16,16),14,yellow,,,.999


line g(_object),(0,0)-(31,31),alfa,bf
circle g(_object),(16,26),14,shadow,,,.5
paint g(_object),(16,28),shadow,shadow
line g(_object),(2,2)-(29,29),green
line g(_object),(2,29)-(29,2),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

'introduction
color green
locate 2,22
print"You are the letter O."
locate 4
color grey
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
color purple
print"Good luck!"
locate 15,20
color orange
print "Press any key to begin!"
color white
sleep
var first_run = 1

'main loop start
do
        screenlock 'redraw screen
        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 using "### caught"; obj;

        screenunlock
        do 'simple enough keypress routine and input interpretation
                a=inkey
                sleep 10,1
        loop until a<>""
        if first_run <> 0 then
                a = " "
                first_run = 0
        end if


        x=px:y=py
        select case a[0]
                case 27'esc=quit don't end though so we can be nice and destroy our sprites
                        exit do
                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
                                case 107'x to close
                                        exit do
                        end select
        end select

        if x<0 then
                x=0
        elseif x>255 then
                x=255
        end if

        if y<0 then
                y=0
        elseif y>255 then
                y=255
        end if

        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
loop

cls
color green
print "Thanks for playing!"
?:print using "Final Score: ### Xs found."; obj
? : ? : ?
color purple
print "This window will automatically close..."


'cleanup memory
for l as integer = lbound(g) to ubound(g)
        imagedestroy g(l)
next
sleep 2000
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Post by kiyotewolf »

@sir_mud

Additional tweaks I added to SirMud's version.

Single Step Mode
Step Mode
Run mode

Code: Select all

/'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.)

Modified 6_8_2011 by SirMud
Here's my slightly tweaked version:
 player and Xs have shadows
 now responds to clicking close
 final score screen at the end
 frees memory at the end
 the colors duke, the colors

Modified 6_9_2011 by Kiyotewolf with miniature state machine to enable multiple forms of keyboard input
as stepping and running
'/

DECLARE function Keyb() As Long

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
dim KeybValue as longint
dim LetGo as integer

const KeybDelay=10 'Speed at which you fly 
const KeybRelease=40 'Timer to countdown when you're releasing the key

screenres 512,512,32
randomize timer

'loading
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),(18,22),14,shadow,,,.5
paint g(player),(17,18),shadow,shadow
circle g(player),(16,16),15,yellow,,,.999
circle g(player),(16,16),14,yellow,,,.999


line g(_object),(0,0)-(31,31),alfa,bf
circle g(_object),(16,26),14,shadow,,,.5
paint g(_object),(16,28),shadow,shadow
line g(_object),(2,2)-(29,29),green
line g(_object),(2,29)-(29,2),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

'introduction
color green
locate 2,22
print"You are the letter O."
locate 4
color grey
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."
print
locate 8,27
color purple
print"Good luck!"
locate 15,20
color orange
print "Press any key to begin!"
color white
print
color grey
print "HOLD CTRL and arrow keys to step around one box at a time."
Print "Step normally by tapping arrow keys.  Press and hold to run."

sleep
var first_run = 1

'main loop start
do
        screenlock 'redraw screen
        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 using "### caught"; obj;

        screenunlock
        KeybValue = Keyb

        'do 'simple enough keypress routine and input interpretation
        '        a=inkey
        '        sleep 10,1
        'loop until a<>"" or KeybValue
        if first_run <> 0 then
                a = " "
                first_run = 0
        end if


        x=px:y=py
        
        if KeybValue and 1 then 'up
          do  
            LetGo+=1
if LetGo < KeybRelease then sleep 1,1 else sleep KeybDelay, 1'give user time to release key
          loop until (LetGo > KeybRelease) or ((Keyb and (((255 shl 8) or 255) xor (32 shl 8))) = 0)

          y-=1
          
          if KeybValue and (32 shl 8) then
            do
            loop while Keyb and (((255 shl 8) or 255) xor (32 shl 8))
          end if
        end if
        if KeybValue and 2 then 'down
          do  
            LetGo+=1
if LetGo < KeybRelease then sleep 1,1 else sleep KeybDelay, 1 'give user time to release key
          loop until (LetGo > KeybRelease) or ((Keyb and (((255 shl 8) or 255) xor (32 shl 8))) = 0)

          y+=1

          if KeybValue and (32 shl 8) then
            do
            loop while Keyb and (((255 shl 8) or 255) xor (32 shl 8))
          end if

        end if
        if KeybValue and 4 then 'left
          do  
            LetGo+=1
if LetGo < KeybRelease then sleep 1,1 else sleep KeybDelay, 1 'give user time to release key
          loop until (LetGo > KeybRelease) or ((Keyb and (((255 shl 8) or 255) xor (32 shl 8))) = 0)

          x-=1

          if KeybValue and (32 shl 8) then
            do
            loop while Keyb and (((255 shl 8) or 255) xor (32 shl 8))
          end if

        end if
        if KeybValue and 8 then 'right
          do  
            LetGo+=1
if LetGo < KeybRelease then sleep 1,1 else sleep KeybDelay, 1 'give user time to release key
          loop until (LetGo > KeybRelease) or ((Keyb and (((255 shl 8) or 255) xor (32 shl 8))) = 0)

          x+=1

          if KeybValue and (32 shl 8) then
            do
            loop while Keyb and (((255 shl 8) or 255) xor (32 shl 8))
          end if

        end if
        if KeybValue = 0 then LetGo = 0
        if Multikey(1) then exit do
        while 0
        select case a[0]
                case 27'esc=quit don't end though so we can be nice and destroy our sprites
                        exit do
                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
                                case 107'x to close
                                        exit do
                        end select
        end select
        wend

        if x<0 then
                x=0
        elseif x>255 then
                x=255
        end if

        if y<0 then
                y=0
        elseif y>255 then
                y=255
        end if

        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
loop

cls
color green
print "Thanks for playing!"
?:print using "Final Score: ### Xs found."; obj
? : ? : ?
color purple
print "This window will automatically close..."


'cleanup memory
for l as integer = lbound(g) to ubound(g)
        imagedestroy g(l)
next
sleep 2000
 
 
 
 
function Keyb() As Long
Dim KeyFlags As Long


KeyFlags = 0
KeyFlags = KeyFlags Or (MultiKey(&h48) And 1) 'up
KeyFlags = KeyFlags Or (MultiKey(&h50) And 2) 'down
KeyFlags = KeyFlags Or (MultiKey(&h4b) And 4) 'left
KeyFlags = KeyFlags Or (MultiKey(&h4d) And 8) 'right
KeyFlags = KeyFlags Or (MultiKey(&h1c) And 16) 'enter
KeyFlags = KeyFlags Or (MultiKey(&h01) And 32) 'esc
KeyFlags = KeyFlags Or (MultiKey(&h49) And 64) 'pgup
KeyFlags = KeyFlags Or (MultiKey(&h51) And 128) 'pgdn
KeyFlags = KeyFlags Or (MultiKey(&h39) And (1 Shl 8)) 'spacebar
KeyFlags = KeyFlags Or (MultiKey(&h29) And (2 Shl 8)) '~ key
KeyFlags = KeyFlags Or (MultiKey(&h3b) And (4 Shl 8)) 'F1
KeyFlags = KeyFlags Or (MultiKey(&h3c) And (8 Shl 8)) 'F2
KeyFlags = KeyFlags or (MultiKey(&h1d) and (32 shl 8)) 'CTRL key

Keyb = KeyFlags

End Function
Also got rid of any dependencies again, and got rid of the Async key dependency, it should be cross Linux compilable without any problems again.



:M

[edit] Dropped numeric key control support for now, stuck with simply the arrow keys, it's just a matter of mapping the proper Multikey numers into the Keyb() function, something I'll do properly later.

[edit 4,5 & 6] Added proper liner-notes illustrating mine & sir_mud's additions to the demo.
Destructosoft
Posts: 88
Joined: Apr 03, 2011 3:44
Location: Inside the bomb
Contact:

Post by Destructosoft »

sir_mud wrote:* frees memory at the end
Ack! I forgot about ImageDestroy. Sorry about that. (I promise to not release quickies again. :)
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Post by sir_mud »

Don't do that, the best thing about Open Source is release early, release often!
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

Give a try to my mazes ? (perpective too)

Post by Mihail_B »

-removed by mihail_b-
Mihail_B
Posts: 273
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

Perspective Maze Demo included as a plug-in into pacman2

Post by Mihail_B »

I have created a plug-in from your random generator - for my game pacman2family.

You can see that at here : Main Menu -> Load Map -> Random Generated Maze

I preserved your copyright notice, so when ever someone whats to
play a random maze will understand that the script is made by DestructSoft.

Game is available at : http://sourceforge.net/projects/pacman2 ... p/download (~13MB)

If you are happy :) or sad :( or none o'it :| ... say it to me. ...
best regards
Post Reply