Map Explorer
#21
@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
Reply


Messages In This Thread
Map Explorer - by SierraKen - 08-10-2022, 12:22 AM
RE: Map Explorer - by mdijkens - 08-10-2022, 01:56 PM
RE: Map Explorer - by Petr - 08-10-2022, 02:54 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 02:55 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 03:03 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 04:17 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 04:25 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 06:38 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 06:41 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 06:50 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 04:37 PM
RE: Map Explorer - by Petr - 08-10-2022, 04:56 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 05:24 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 05:28 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 07:22 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 07:37 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 08:13 PM
RE: Map Explorer - by bplus - 08-10-2022, 08:29 PM
RE: Map Explorer - by bplus - 08-10-2022, 08:32 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 08:44 PM
RE: Map Explorer - by SierraKen - 08-10-2022, 11:17 PM
RE: Map Explorer - by James D Jarvis - 08-10-2022, 11:57 PM
RE: Map Explorer - by James D Jarvis - 08-11-2022, 12:19 AM
RE: Map Explorer - by bplus - 08-11-2022, 01:41 AM
RE: Map Explorer - by SierraKen - 08-11-2022, 05:44 AM
RE: Map Explorer - by James D Jarvis - 08-11-2022, 01:26 PM
RE: Map Explorer - by bplus - 08-11-2022, 03:19 PM
RE: Map Explorer - by SierraKen - 08-11-2022, 05:07 PM
RE: Map Explorer - by SierraKen - 08-11-2022, 11:59 PM
RE: Map Explorer - by vince - 08-12-2022, 06:33 AM
RE: Map Explorer - by SierraKen - 08-12-2022, 07:39 PM
RE: Map Explorer - by James D Jarvis - 08-12-2022, 02:37 PM
RE: Map Explorer - by SierraKen - 08-12-2022, 07:41 PM
RE: Map Explorer - by James D Jarvis - 08-12-2022, 11:39 PM



Users browsing this thread: 13 Guest(s)