Map Explorer

[SierraKen]

@Bplus Here is a special mouse version. It doesn't have the ants so you guys will have to add them if you want them on this version. Or add this code to what you have already. It's not perfect, for example you can't move diagonal, but it's as good as I can get it. I tried many different ways and this is the best I can do. The left mouse button stops the person from moving and again to move.

Code: (Select All)

'Scrolling Map Example by SierraKen - August 9, 2022
'This is just a demonstration scrolling map I made to use with games someday.


Cls
Print "                     Random Large Map Maker"
Print "                          Mouse Version"
Print
Print "                          by SierraKen"
Print: Print
Print
Print "This is just an example to make something with a moving background."
Print "Use the mouse to move and Esc to quit."
Print "The left mouse button stops the person from moving, and again to move."
Print "Currently the map only has randomly placed houses and rocks,"
Print "but feel free to add anything you wish. I placed notes in the QB64 code."
Print: Print
Print "             Click the Screen With Your Mouse To Start."

Do
    While _MouseInput: Wend
    mouseLeftButton = _MouseButton(1)
    If mouseLeftButton Then
        Clear_MB 1
        GoTo begin:
    End If
Loop

begin:
Randomize Timer
Screen _NewImage(800, 600, 32)

Type object
    x As Single
    y As Single
End Type

Dim Shared player As object
Dim Shared camera As object
Dim Shared map As Long
Dim playerSpeed As Single
Dim housex(30)
Dim housey(30)
Dim rx(250)
Dim ry(250)

_Title "Loading....."

start:
player.x = _Width / 2
player.y = _Height / 2

If map <> 0 Then _FreeImage (map)
map = _NewImage(_Width * 5, _Height * 5, 32)

_Dest map

Cls

'--------------------------------------------------------------------------------------
'Graphics Here

For h = 1 To 30
    again:
    housex(h) = Rnd * 3500
    housey(h) = Rnd * 2500
    For check = 0 To h - 1
        If housex(check) > housex(h) - 150 And housex(check) < housex(h) + 150 And housey(check) > housey(h) - 225 And housey(check) < housey(h) + 225 Then GoTo again:
    Next check
    housex2 = (Rnd * 100) + 50
    housey2 = (Rnd * 100) + 50
    Line (housex(h), housey(h))-(housex(h) + housex2, housey(h) + housey2), _RGB32(255, 255, 255), B
    Paint (housex(h) + 5, housey(h) + 5), _RGB32(216, 127, 78), _RGB32(255, 255, 255)

    For sz = .25 To (housex2 / 2) Step .1
        Circle (housex(h) + (housex2 / 2), housey(h)), sz, _RGB32(255, 255, 255), 2 * _Pi, _Pi, 1
    Next sz
    Paint (housex(h) + 2, housey(h) - (housey2 / 2) + 2), _RGB32(216, 127, 78), _RGB32(255, 255, 255)
    Line (housex(h) + (housex2 / 2) - 10, housey(h) + (housey2 - 20))-(housex(h) + (housex2 / 2) + 10, housey(h) + housey2), _RGB32(255, 255, 255), B
Next h

For r = 1 To 250
    again2:
    rx(r) = Rnd * 4000
    ry(r) = Rnd * 4000
    For check = 0 To 30
        If housex(check) > rx(r) - 150 And housex(check) < rx(r) + 150 And housey(check) > ry(r) - 225 And housey(check) < ry(r) + 225 Then GoTo again2:
    Next check
    size = Rnd * 20
    Circle (rx(r), ry(r)), size, _RGB32(255, 255, 255)
Next r

again3:
cavex = Rnd * 3800
cavey = Rnd * 2800
For check = 0 To 30
    If housex(check) > cavex - 150 And housex(check) < cavex + 150 And housey(check) > cavey - 225 And housey(check) < cavey + 225 Then GoTo again3:
Next check

For sz = 50 To 100 Step .25
    Circle (cavex, cavey), sz, _RGB32(255, 255, 255), 2 * _Pi, _Pi, 1
Next sz

Paint (1, 1), _RGB32(127, 172, 127), _RGB32(255, 255, 255)

_Dest 0

_Source map

playerSpeed = 8

Const keyUP = 18432
Const keyDOWN = 20480
Const keyLEFT = 19200
Const keyRIGHT = 19712
Const ESC = 27


_Title "Map Explorer - by SierraKen - Mouse Version"

_Dest 0
_Source map

t = 1
Do
    Cls

    _PutImage (camera.x, camera.y), map

    While _MouseInput: Wend
    oldmousex = mousex
    oldmousey = mousey
    mousex = _MouseX
    mousey = _MouseY
    mouseLeftButton = _MouseButton(1)

    If mouseLeftButton Then
        Clear_MB 1
        st = st + 1
        If st > 1 Then st = 0
    End If
    If mousey < oldmousey - 5 Then dir = 1
    If mousey > oldmousey + 5 Then dir = 2
    If mousex < oldmousex - 5 Then dir = 3
    If mousex > oldmousex + 5 Then dir = 4

    If dir = 1 And st = 0 Then player.y = player.y - (playerSpeed / 2): t = t + 1
    If dir = 2 And st = 0 Then player.y = player.y + (playerSpeed / 2): t = t + 1
    If dir = 3 And st = 0 Then player.x = player.x - (playerSpeed / 2): t = t + 1
    If dir = 4 And st = 0 Then player.x = player.x + (playerSpeed / 2): t = t + 1

    'If _KeyDown(keyUP) Or _KeyDown(119) Then player.y = player.y - playerSpeed: t = t + 1
    'If _KeyDown(keyDOWN) Or _KeyDown(115) Then player.y = player.y + playerSpeed: t = t + 1
    'If _KeyDown(keyLEFT) Or _KeyDown(97) Then player.x = player.x - playerSpeed: t = t + 1
    'If _KeyDown(keyRIGHT) Or _KeyDown(100) Then player.x = player.x + playerSpeed: t = t + 1

    If _KeyDown(ESC) Then End

    If player.x < 0 Then player.x = 0
    If player.x > _Width(map) Then player.x = _Width(map)
    If player.y < 0 Then player.y = 0
    If player.y > _Height(map) Then player.y = _Height(map)

    adjustCamera

    'Draw Head
    For sz = .25 To 10 Step .25
        Circle (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
    Next sz
    'Draw Smile
    Circle (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _Pi, 2 * _Pi, .5
    'Draw Eyes
    Circle (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    Circle (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    'hat
    Line (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
    Line (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
    'Body
    Line (player.x + camera.x - 10, player.y + camera.y + 10)-(player.x + camera.x + 10, player.y + camera.y + 40), _RGB32(155, 0, 0), BF


    If t > 12 Then t = 1
    If t > 0 And t < 6 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 20 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 20 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 10 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 10 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If
    If t > 5 And t < 13 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 30 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 30 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 15 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 15 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If

    _Display
    _Limit 60
Loop

Sub adjustCamera
    If player.x + camera.x > _Width / 2 Or player.x + camera.x < _Width / 2 Then
        camera.x = _Width / 2 - player.x
    End If
    If camera.x > 0 Then camera.x = 0
    If camera.x < -(_Width(map) - _Width) Then camera.x = -(_Width(map) - _Width)

    If player.y + camera.y > _Height / 2 Or player.y + camera.y < _Height / 2 Then
        camera.y = _Height / 2 - player.y
    End If
    If camera.y > 0 Then camera.y = 0
    If camera.y < -(_Height(map) - _Height) Then camera.y = -(_Height(map) - _Height)
End Sub


Sub Clear_MB (var As Integer)
    Do Until Not _MouseButton(var)
        While _MouseInput: Wend
    Loop
End Sub 'Clear_MB

[James D Jarvis]

Neat.

The way I added the ants was a bit weak but that general technique would likely work well for adding weather effects like falling rain, or maybe swirling leaves or snowflakes

[James D Jarvis]

I didn't fine tune it but this will make the player chase the mouse pointer in any direction. (I didn't clean up the rest of the mouse code).  Helpful?

Code: (Select All)

    dy = 0
    dx = 0
    If mousey < player.y + camera.y - 5 Then dy = -1
    If mousey > player.y + camera.y + 5 Then dy = 1
    If mousex < player.x + camera.x - 5 Then dx = -1
    If mousex > player.x + camera.x + 5 Then dx = 1

    If dy = -1 And st = 0 Then player.y = player.y - (playerSpeed / 2): t = t + 1
    If dy = 1 And st = 0 Then player.y = player.y + (playerSpeed / 2): t = t + 1
    If dx = -1 And st = 0 Then player.x = player.x - (playerSpeed / 2): t = t + 1
    If dx = 1 And st = 0 Then player.x = player.x + (playerSpeed / 2): t = t + 1

[bplus]

Luv what you are doing with the mouse, much closer to flying!

[SierraKen]

OK guys, I'm at 100% full inspiration mode now! James, I added your mouse control for movement, thank you! I also removed all of the PAINT commands so now there's no waiting time on the Loading. Or if there is it's not much at all. For the green grass I used a giant LINE filled box in the beginning, then I decided "Why not add texture?" So I added 200,000 1 pixel circles randomly placed on the map as the texture. With that I removed the circle rocks since there was no need. Then I changed the way the cave looks so it looks much more real. Then I changed the color of the roofs and the doors. And lastly, I added windows to the houses. There's more windows on larger houses than smaller houses. Plus I added blue-faded ponds randomly placed.   Here is a picture of part of it, and the code. I've also removed the "Mouse Version" title and am going to use this mouse movement from now on. It's really fun to use. Thanks for the help everyone! I added all of your names to the comment section on top. And nope, this won't be my final version. I have plans ahead but it might take awhile. So have fun with this one for awhile.

Code: (Select All)

'Scrolling Map Example by SierraKen - August 10, 2022
'This is a demonstration scrolling map I made to use with games someday.

'Thank you to Felippe, James D. Jarvis, mdijkens, Petr, and B+ for the help and inspiration!

Cls
Print "                       Random Large Map Maker"
Print
Print "                            by SierraKen"
Print: Print
Print
Print "     This is an example to make something with a moving background."
Print "     Use the mouse to move and Esc to quit."
Print "     Press the left mouse button to stop and start moving again."
Print: Print
Print "               Click the Screen With Your Mouse To Start."

Do
    While _MouseInput: Wend
    mouseLeftButton = _MouseButton(1)
    If mouseLeftButton Then
        Clear_MB 1
        GoTo begin:
    End If
Loop

begin:
Randomize Timer
Screen _NewImage(800, 600, 32)

Type object
    x As Single
    y As Single
End Type

Dim Shared player As object
Dim Shared camera As object
Dim Shared map As Long
Dim playerSpeed As Single
Dim housex(30)
Dim housey(30)
Dim rx(250)
Dim ry(250)
Dim lx(30)
Dim ly(30)

_Title "Loading....."

start:
player.x = _Width / 2
player.y = _Height / 2

If map <> 0 Then _FreeImage (map)
map = _NewImage(_Width * 5, _Height * 5, 32)

_Dest map

Cls

'--------------------------------------------------------------------------------------
'Graphics Here

'Grass
Line (0, 0)-(4000, 3000), _RGB32(127, 255, 127), BF

'Texture
For texture = 1 To 200000
    tx = Rnd * 4000
    ty = Rnd * 3000
    Circle (tx, ty), 1, _RGB32(155, 166, 127)
Next texture

'Houses
For h = 1 To 30
    again:
    housex(h) = Rnd * 3500
    housey(h) = Rnd * 2500
    For check = 0 To h - 1
        If housex(check) > housex(h) - 150 And housex(check) < housex(h) + 150 And housey(check) > housey(h) - 225 And housey(check) < housey(h) + 225 Then GoTo again:
    Next check
    housex2 = (Rnd * 100) + 50
    housey2 = (Rnd * 100) + 50
    'House
    Line (housex(h), housey(h))-(housex(h) + housex2, housey(h) + housey2), _RGB32(216, 127, 78), BF
    'Roof
    For sz = .25 To (housex2 / 2) Step .1
        Circle (housex(h) + (housex2 / 2), housey(h)), sz, _RGB32(150, 75, 50), 2 * _Pi, _Pi, 1
    Next sz
    Line (housex(h) + (housex2 / 2) - 10, housey(h) + (housey2 - 20))-(housex(h) + (housex2 / 2) + 10, housey(h) + housey2), _RGB32(128, 116, 128), BF
    'Windows
    For w = 0 To housey2 - 45 Step 15
        Line (housex(h) + (housex2 / 2) - housex2 / 4, housey(h) + (housey2 - 35 - w))-(housex(h) + (housex2 / 2) - ((housex2 / 4) + 10), housey(h) + housey2 - 25 - w), _RGB32(128, 116, 128), BF
        Line (housex(h) + (housex2 / 2) + housex2 / 4, housey(h) + (housey2 - 35 - w))-(housex(h) + (housex2 / 2) + ((housex2 / 4) + 10), housey(h) + housey2 - 25 - w), _RGB32(128, 116, 128), BF
    Next w
Next h


'Lakes
For rr = 1 To 30
    again2:
    lx(rr) = Rnd * 4000
    ly(rr) = Rnd * 4000
    For check = 0 To 30
        If housex(check) > lx(rr) - 250 And housex(check) < lx(rr) + 250 And housey(check) > ly(rr) - 250 And housey(check) < ly(rr) + 250 Then GoTo again2:
    Next check
    size = Int(Rnd * 150) + 20
    For sz = size To .25 Step -.25
        cl = cl + .25
        Circle (lx(rr), ly(rr)), sz, _RGB32(0, 0, cl + 50)
    Next sz
    cl = 0
Next rr


'Cave
again3:
cavex = Rnd * 3800
cavey = (Rnd * 2200) + 300
For check = 0 To 30
    If housex(check) > cavex - 300 And housex(check) < cavex + 300 And housey(check) > cavey - 300 And housey(check) < cavey + 300 Then GoTo again3:
Next check

For sz = 1 To 100 Step .25
    cl = cl + .25
    Circle (cavex, cavey), sz, _RGB32(220 - cl, 100 - cl, 100 - cl), 2 * _Pi, _Pi, 1
Next sz
cl = 0
For sz = 1 To 20 Step .25
    Circle (cavex, cavey), sz, _RGB32(0, 0, 0), 2 * _Pi, _Pi, 1
Next sz


_Dest 0

_Source map

playerSpeed = 8

Const ESC = 27

_Title "Map Explorer - by SierraKen"

_Dest 0
_Source map

t = 1
Do
    Cls

    _PutImage (camera.x, camera.y), map

    While _MouseInput: Wend
    oldmousex = mousex
    oldmousey = mousey
    mousex = _MouseX
    mousey = _MouseY
    mouseLeftButton = _MouseButton(1)

    If mouseLeftButton Then
        Clear_MB 1
        st = st + 1
        If st > 1 Then st = 0
    End If

    dy = 0
    dx = 0
    If mousey < player.y + camera.y - 5 Then dy = -1
    If mousey > player.y + camera.y + 5 Then dy = 1
    If mousex < player.x + camera.x - 5 Then dx = -1
    If mousex > player.x + camera.x + 5 Then dx = 1

    If dy = -1 And st = 0 Then player.y = player.y - (playerSpeed / 2): t = t + 1
    If dy = 1 And st = 0 Then player.y = player.y + (playerSpeed / 2): t = t + 1
    If dx = -1 And st = 0 Then player.x = player.x - (playerSpeed / 2): t = t + 1
    If dx = 1 And st = 0 Then player.x = player.x + (playerSpeed / 2): t = t + 1

    If _KeyDown(ESC) Then End

    If player.x < 0 Then player.x = 0
    If player.x > _Width(map) Then player.x = _Width(map)
    If player.y < 0 Then player.y = 0
    If player.y > _Height(map) Then player.y = _Height(map)

    adjustCamera

    'Draw Head
    For sz = .25 To 10 Step .25
        Circle (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
    Next sz
    'Draw Smile
    Circle (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _Pi, 2 * _Pi, .5
    'Draw Eyes
    Circle (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    Circle (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    'hat
    Line (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
    Line (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
    'Body
    Line (player.x + camera.x - 10, player.y + camera.y + 10)-(player.x + camera.x + 10, player.y + camera.y + 40), _RGB32(155, 0, 0), BF

    If t > 12 Then t = 1
    If t > 0 And t < 6 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 20 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 20 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 10 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 10 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If
    If t > 5 And t < 13 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 30 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 30 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 15 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 15 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If

    _Display
    _Limit 60
Loop

Sub adjustCamera
    If player.x + camera.x > _Width / 2 Or player.x + camera.x < _Width / 2 Then
        camera.x = _Width / 2 - player.x
    End If
    If camera.x > 0 Then camera.x = 0
    If camera.x < -(_Width(map) - _Width) Then camera.x = -(_Width(map) - _Width)

    If player.y + camera.y > _Height / 2 Or player.y + camera.y < _Height / 2 Then
        camera.y = _Height / 2 - player.y
    End If
    If camera.y > 0 Then camera.y = 0
    If camera.y < -(_Height(map) - _Height) Then camera.y = -(_Height(map) - _Height)
End Sub


Sub Clear_MB (var As Integer)
    Do Until Not _MouseButton(var)
        While _MouseInput: Wend
    Loop
End Sub 'Clear_MB

[James D Jarvis]

Glad you found any of my input useful. Looking forward to what you come up with.

[bplus]

Ken if you track on the map where things are you can then do collision detection to tell when the figure runs into something like takes a dip in what I assume to be the perfectly round pool.

James might place his ants on the map and move them independently of the figure and they might even become attracted to the houses. I know all the ants in our area come to our house in the winter.

[SierraKen]

Ken if you track on the map where things are you can then do collision detection to tell when the figure runs into something like takes a dip in what I assume to be the perfectly round pool.

James might place his ants on the map and move them independently of the figure and they might even become attracted to the houses. I know all the ants in our area come to our house in the winter.

Yes, but even easier I think would be using the POINT command. So we'll see.  Thanks.

[SierraKen]

Here is another update. This one puts random colors on all the buildings (except the roofs, windows, and doors). I also made the lakes random shapes. Plus now if you run into a building, you are randomly warped a little bit away from the building. B+ I did use the arrayed variables on the houses instead of POINT. So in the future we can make certain houses do certain things, as well as the lakes and cave and anything else we want to add. Oh plus I added in the Title Bar your X and Y coordinates (which are actually player.x and player.y). When you are warped, the Title Bar says to click the mouse to continue. It says it also when you click the mouse to stop. After you click it the notify goes away and you start walking again.  

Code: (Select All)

'Scrolling Map Example by SierraKen - August 10, 2022
'This is a demonstration scrolling map I made to use with games someday.

'Thank you to Felippe, James D. Jarvis, mdijkens, Petr, and B+ for the help and inspiration!

Cls
Print "                       Random Large Map Maker"
Print
Print "                            by SierraKen"
Print: Print
Print
Print "     This is an example to make something with a moving background."
Print "     Use the mouse to move and Esc to quit."
Print "     Press the left mouse button to stop and start moving again."
Print: Print
Print "               Click the Screen With Your Mouse To Start."

Do
    While _MouseInput: Wend
    mouseLeftButton = _MouseButton(1)
    If mouseLeftButton Then
        Clear_MB 1
        GoTo begin:
    End If
Loop

begin:
Randomize Timer
Screen _NewImage(800, 600, 32)

Type object
    x As Single
    y As Single
End Type

Dim Shared player As object
Dim Shared camera As object
Dim Shared map As Long
Dim playerSpeed As Single
Dim housex(30)
Dim housey(30)
Dim housex2(30)
Dim housey2(30)
Dim lx(30)
Dim ly(30)

_Title "Loading....."

start:
player.x = _Width / 2
player.y = _Height / 2

If map <> 0 Then _FreeImage (map)
map = _NewImage(_Width * 5, _Height * 5, 32)

_Dest map

Cls

'--------------------------------------------------------------------------------------
'Graphics Here

'Grass
Line (0, 0)-(4000, 3000), _RGB32(127, 255, 127), BF

'Texture
For texture = 1 To 200000
    tx = Rnd * 4000
    ty = Rnd * 3000
    Circle (tx, ty), 1, _RGB32(155, 166, 127)
Next texture

'Houses
For h = 1 To 30
    again:
    housex(h) = Rnd * 3500
    housey(h) = Rnd * 2500
    For check = 0 To h - 1
        If housex(check) > housex(h) - 150 And housex(check) < housex(h) + 150 And housey(check) > housey(h) - 225 And housey(check) < housey(h) + 225 Then GoTo again:
    Next check
    housex2(h) = (Rnd * 100) + 50
    housey2(h) = (Rnd * 100) + 50
    'House
    Line (housex(h), housey(h))-(housex(h) + housex2(h), housey(h) + housey2(h)), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255), BF
    'Roof
    For sz = .25 To (housex2(h) / 2) Step .1
        Circle (housex(h) + (housex2(h) / 2), housey(h)), sz, _RGB32(150, 75, 50), 2 * _Pi, _Pi, 1
    Next sz
    Line (housex(h) + (housex2(h) / 2) - 10, housey(h) + (housey2(h) - 20))-(housex(h) + (housex2(h) / 2) + 10, housey(h) + housey2(h)), _RGB32(128, 116, 128), BF
    'Windows
    For w = 0 To housey2(h) - 45 Step 15
        Line (housex(h) + (housex2(h) / 2) - housex2(h) / 4, housey(h) + (housey2(h) - 35 - w))-(housex(h) + (housex2(h) / 2) - ((housex2(h) / 4) + 10), housey(h) + housey2(h) - 25 - w), _RGB32(128, 116, 128), BF
        Line (housex(h) + (housex2(h) / 2) + housex2(h) / 4, housey(h) + (housey2(h) - 35 - w))-(housex(h) + (housex2(h) / 2) + ((housex2(h) / 4) + 10), housey(h) + housey2(h) - 25 - w), _RGB32(128, 116, 128), BF
    Next w

Next h


'Lakes
For rr = 1 To 30
    again2:
    lx(rr) = Rnd * 4000
    ly(rr) = Rnd * 3000
    For check = 0 To 30
        If housex(check) > lx(rr) - 250 And housex(check) < lx(rr) + 250 And housey(check) > ly(rr) - 250 And housey(check) < ly(rr) + 250 Then GoTo again2:
    Next check
    size = Int(Rnd * 150) + 20
    shape = Rnd + .2
    cl = 50
    For sz = size To .25 Step -.25
        cl = cl + .25
        Circle (lx(rr), ly(rr)), sz, _RGB32(0, 0, cl + 50), , , shape
    Next sz
    cl = 0
Next rr


'Cave
again3:
cavex = Rnd * 3800
cavey = (Rnd * 2200) + 300
If chk = 1 Then GoTo again4:
For check = 0 To 30
    If housex(check) > cavex - 400 And housex(check) < cavex + 400 And housey(check) > cavey - 400 And housey(check) < cavey + 400 Then GoTo again3:
Next check
again4:
For check2 = 0 To 30
    If lx(check2) > cavex - 450 And lx(check2) < cavex + 450 And ly(check2) > cavey - 450 And ly(check2) < cavey + 450 Then chk = 1: GoTo again3:
Next check2
chk = 0
For sz = 1 To 100 Step .25
    cl = cl + .25
    Circle (cavex, cavey), sz, _RGB32(220 - cl, 100 - cl, 100 - cl), 2 * _Pi, _Pi, 1
Next sz
cl = 0
For sz = 1 To 30 Step .25
    Circle (cavex, cavey), sz, _RGB32(0, 0, 0), 2 * _Pi, _Pi, 1
Next sz


_Dest 0

_Source map

playerSpeed = 6

Const ESC = 27

_Title "Map Explorer - by SierraKen"

_Dest 0
_Source map

t = 1
Do
    Cls

    _PutImage (camera.x, camera.y), map

    While _MouseInput: Wend
    mousex = _MouseX
    mousey = _MouseY
    mouseLeftButton = _MouseButton(1)

    If mouseLeftButton Then
        Clear_MB 1
        st = st + 1
        If st > 1 Then st = 0
    End If

    dy = 0
    dx = 0
    If mousey < player.y + camera.y - 5 Then dy = -1
    If mousey > player.y + camera.y + 5 Then dy = 1
    If mousex < player.x + camera.x - 5 Then dx = -1
    If mousex > player.x + camera.x + 5 Then dx = 1

    For ch = 1 To 30
        If player.x > housex(ch) And player.x < housex(ch) + housex2(ch) And player.y > housey(ch) - (housex2(ch) / 2) And player.y < housey(ch) + housey2(ch) Then
            location:
            player.x = (player.x) + (Rnd * 150)
            player.y = (player.y) + (Rnd * 150)
            st = 1
            For check = 0 To 30
                If housex(check) > player.x - 250 And housex(check) < player.x + 250 And housey(check) > player.y - 250 And housey(check) < player.y + 250 Then GoTo location:
            Next check
        End If
    Next ch
    more2:
    If dy = -1 And st = 0 Then player.y = player.y - (playerSpeed / 2): t = t + 1
    If dy = 1 And st = 0 Then player.y = player.y + (playerSpeed / 2): t = t + 1
    If dx = -1 And st = 0 Then player.x = player.x - (playerSpeed / 2): t = t + 1
    If dx = 1 And st = 0 Then player.x = player.x + (playerSpeed / 2): t = t + 1
    If st = 0 Then _Title "X = " + Str$(Int(player.x)) + "    Y = " + Str$(Int(player.y))
    If st = 1 Then _Title "X = " + Str$(Int(player.x)) + "    Y = " + Str$(Int(player.y)) + "    Click Mouse To Continue!"
    If _KeyDown(ESC) Then End

    If player.x < 0 Then player.x = 0
    If player.x > _Width(map) Then player.x = _Width(map)
    If player.y < 0 Then player.y = 0
    If player.y > _Height(map) Then player.y = _Height(map)

    adjustCamera

    'Draw Head
    For sz = .25 To 10 Step .25
        Circle (player.x + camera.x, player.y + camera.y), sz, _RGB32(255, 166, 127)
    Next sz
    'Draw Smile
    Circle (player.x + camera.x, player.y + camera.y + 2), 7, _RGB32(255, 0, 0), _Pi, 2 * _Pi, .5
    'Draw Eyes
    Circle (player.x + camera.x - 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    Circle (player.x + camera.x + 4, player.y + camera.y - 2), 1, _RGB32(0, 0, 255)
    'hat
    Line (player.x + camera.x - 10, player.y + camera.y - 10)-(player.x + camera.x + 10, player.y + camera.y - 9), _RGB32(155, 0, 0), BF
    Line (player.x + camera.x - 5, player.y + camera.y - 9)-(player.x + camera.x + 5, player.y + camera.y - 15), _RGB32(155, 0, 0), BF
    'Body
    Line (player.x + camera.x - 10, player.y + camera.y + 10)-(player.x + camera.x + 10, player.y + camera.y + 40), _RGB32(155, 0, 0), BF

    If t > 12 Then t = 1
    If t > 0 And t < 6 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 20 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 20 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 10 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 10 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If
    If t > 5 And t < 13 Then
        'Left Arm
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 - wid2, player.y + camera.y + 10)-(player.x + camera.x - 30 - wid2, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid2
        'Right Arm
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 + wid1, player.y + camera.y + 10)-(player.x + camera.x + 30 + wid1, player.y + camera.y + 30), _RGB32(255, 166, 127)
        Next wid1
        'Left leg
        For wid2 = .1 To 3 Step .1
            Line (player.x + camera.x - 10 + wid2, player.y + camera.y + 40)-(player.x + camera.x - 15 + wid2, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid2
        'Right leg
        For wid1 = .1 To 3 Step .1
            Line (player.x + camera.x + 10 - wid1, player.y + camera.y + 40)-(player.x + camera.x + 15 - wid1, player.y + camera.y + 60), _RGB32(255, 166, 127)
        Next wid1
    End If

    _Display
    _Limit 60
Loop

Sub adjustCamera
    If player.x + camera.x > _Width / 2 Or player.x + camera.x < _Width / 2 Then
        camera.x = _Width / 2 - player.x
    End If
    If camera.x > 0 Then camera.x = 0
    If camera.x < -(_Width(map) - _Width) Then camera.x = -(_Width(map) - _Width)

    If player.y + camera.y > _Height / 2 Or player.y + camera.y < _Height / 2 Then
        camera.y = _Height / 2 - player.y
    End If
    If camera.y > 0 Then camera.y = 0
    If camera.y < -(_Height(map) - _Height) Then camera.y = -(_Height(map) - _Height)
End Sub


Sub Clear_MB (var As Integer)
    Do Until Not _MouseButton(var)
        While _MouseInput: Wend
    Loop
End Sub 'Clear_MB

[vince]

That giant bowling ball next to the houses looks like a real hazard!