Map Explorer
#17
I tossed some ants in it just to see what would happen. My ant draw graphics clearly  don't account for the camera change yet.    Just sharing for the fun.   The ant footprints and deadants only work in the top corner, and I have no clue where the red ants are. 

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.
'plus some ants i threw in, they really aren't working right yet

Cls
Print "                     Random Large Map Maker"
Print  "             with ants"
Print: Print
Print "                         by SierraKen"
Print "and infesteded by James D. Jarvis"
Print: Print
Print
Print "This is just an example to make something with a moving background."
Print "Use the arrow keys to move and Esc to quit."
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 " AND i threw some sloppy code for ants in it"
Print: Print
Input "Press Enter to start."; a$
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 Shared ant$, ax(100), ay(100), am(100), aa(100), ascl(100), aklr(100), ah(100), asp(100), af(100)
Dim Shared rax(100), ray(100), ram(100), raa(100), rascl(100), raklr(100), rah(100), rasp(100), raf(100)
Dim Shared rac

_Title "Loading....."

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

map = _NewImage(_Width * 5, _Height * 5, 32)
maxax = _Width * 5
maxay = _Height * 5
_Dest map

Cls , _RGB32(0, 200, 0)
_Limit 2000

'--------------------------------------------------------------------------------------
'Graphics Here
For p = 1 To 6
    px = Rnd * 3500
    py = Rnd * 3500
    Circle (px, py), Int(40 + Rnd * 40), _RGB32(255, 255, 255)
    Paint (px, py), _RGB32(100, 255, 255)
Next p


For h = 1 To 30
    again:
    housex(h) = Rnd * 3500
    housey(h) = Rnd * 3500
    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
    tt = 0
    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

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
Cls
_PutImage (camera.x, camera.y), map


_Title "Map Explorer - by SierraKen"

_Dest 0
_Source map
Cls
ant$ = "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2bm-3,+0e5g5f5h5u5d10u6dg5e5h5"
For a = 1 To 100
    ax(a) = 0 - Int(Rnd * 20)
    ay(a) = Int(Rnd * 300) + 100
    am(a) = Int(Rnd * 3) + 2
    aa(a) = Int(Rnd * 10) - Int(Rnd * 10)
    ascl(a) = Int(Rnd * 6) + 3
    aklr(a) = Int(Rnd * 10)
    ah(a) = Int(Rnd * 10) + ascl(a) * 2
    asp(a) = ascl(a) - 2
    af(a) = 0
    ' rax(a) = 800 + Int(Rnd * 20)
    ' ray(a) = Int(Rnd * 300) + 100
    ' ram(a) = Int(Rnd * 3) + 2
    ' raa(a) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
    ' rascl(a) = Int(Rnd * 6) + 3
    ' raklr(a) = 178 - Int(Rnd * 4)
    ' rah(a) = Int(Rnd * 10) + rascl(a) * 2
    ' rasp(a) = rascl(a) - 2
    ' raf(a) = 0

    rax(a) = 0
    ray(a) = 0
    ram(a) = 0
    raa(a) = 180 + Int(Rnd * 10) - Int(Rnd * 10)
    rascl(a) = 0
    raklr(a) = Int(200 + Rnd * 10)
    rah(a) = 0
    rasp(a) = 0
    raf(a) = 0



Next a
ro = _Pi / 180
rac = 0

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

t = 1
Do
    Cls

    _PutImage (camera.x, camera.y), map
    'input handlign edited by me
    If _KeyDown(keyUP) Then
        player.y = player.y - playerSpeed: t = t + 1
        If player.y < 0 Then player.y = 0
    Else If _KeyDown(keyDOWN) Then
            player.y = player.y + playerSpeed: t = t + 1
            If player.y > _Height(map) Then player.y = _Height(map)
        Else If _KeyDown(keyLEFT) Then
                player.x = player.x - playerSpeed: t = t + 1
                If player.x < 0 Then player.x = 0
            Else If _KeyDown(keyRIGHT) Then
                    player.x = player.x + playerSpeed: t = t + 1
                    If player.y > _Height(map) Then player.y = _Height(map)
                Else If _KeyDown(ESC) Then
                        End
    End If: End If: End If: End If: End If

    ants:


    For a = 1 To 100
        If Rnd * 6 > 4 Then
            If af(a) < 1 Then
                ax(a) = ax(a) + asp(a) * Sin((aa(a) + 90) * ro)
                ay(a) = ay(a) + asp(a) * Cos((aa(a) + 90) * ro)
            End If
            If a <= rac And raf(a) < 1 Then
                rax(a) = rax(a) + rasp(a) * Sin((raa(a) + 90) * ro)
                ray(a) = ray(a) + rasp(a) * Cos((raa(a) + 90) * ro)
            End If
            If a <= rac Then af(a) = af(a) - 1
            If a <= rac Then raf(a) = raf(a) - 1
            If ax(a) < -20 Or ax(a) > 850 Then
                ax(a) = 0 - (Int(Rnd * 10) + 5)
                ay(a) = Int(Rnd * maxay) + 100
                aa(a) = 0
                ascl(a) = Int(Rnd * 6) + 3
            End If
            If ay(a) < -10 Or ay(a) > 650 Then
                ay(a) = Int(Rnd * maxay) + 100
                ax(a) = 0 - (Int(Rnd * 10) + 5)
                aa(a) = 0
                ascl(a) = Int(Rnd * 6) + 3
            End If


            If a <= rac And rax(a) < -20 Or rax(a) > 850 Then
                rax(a) = maxax + 10 - (Int(Rnd * 10) + 5)
                ray(a) = Int(Rnd * maxay) + 100
                raa(a) = 180
                rascl(a) = Int(Rnd * 6) + 3
            End If
            If a <= rac And ray(a) < -10 Or ray(a) > 650 Then
                ray(a) = Int(Rnd * maxay) + 100
                rax(a) = maxax + 10 - (Int(Rnd * 10) + 5)
                raa(a) = 180
                rascl(a) = Int(Rnd * 6) + 3
            End If




        End If
        dant aa(a), aklr(a), ascl(a), ax(a), ay(a)
        dant raa(a), raklr(a), rascl(a), rax(a), ray(a)

        dc = Int(Rnd * 20) + 1
        Select Case dc
            Case 1 TO 3
                aa(a) = aa(a) - (Int(Rnd * 6) + 2)
            Case 4 TO 17
            Case 18 TO 20
                aa(a) = aa(a) + (Int(Rnd * 6) + 2)
        End Select
        _Source b&
        If Point(ax(a) + ascl(a) * 4, ay(a)) = _RGB32(100, 255, 255) And Point(ax(a) + ascl(a) * 4, ay(a)) = _RGB32(100, 255, 255) Then
            aa(a) = Int(aa(a) + 30)
            ah(a) = ah(a) - 1
        Else
            If Rnd * 20 > 18.5 Then
                _Dest map
                PSet (ax(a), ay(a)), _RGB32(200, 200, 200)
                _Dest 0
            End If
        End If

        dc = Int(Rnd * 20) + 1
        Select Case dc
            Case 1 TO 3
                raa(a) = raa(a) - (Int(Rnd * 6) + 2)
            Case 4 TO 17
            Case 18 TO 20
                raa(a) = raa(a) + (Int(Rnd * 6) + 2)
        End Select
        _Source b&
        If Point(rax(a) + rascl(a) * 4, ray(a)) = _RGB32(100, 255, 255) And Point(rax(a) + rascl(a) * 4, ray(a)) = _RGB32(100, 255, 255) Then
            raa(a) = Int(raa(a) + 30)
            rah(a) = rah(a) - 1
        Else
            If Rnd * 20 > 18.5 Then
                _Dest map
                PSet (rax(a), ray(a)), 4
                _Dest 0
            End If
        End If
        For n = 1 To 100
            bxx = ax(n) + ascl(n) * 2 * Sin((aa(n) + 90) * ro)
            byy = ay(n) + ascl(n) * 2 * Cos((aa(n) + 90) * ro)
            If Int(bxx / 4) = Int((rax(a) + 3) / 4) And Int(byy / 4) = Int((ray(a) + 3) / 4) Then

                ah(n) = ah(n) - Int(1 + Rnd * rascl(a))
                rah(a) = rah(a) - Int(1 + Rnd * ascl(n))
                aa(n) = aa(n) + Int(30 + Rnd * 20)
                raa(a) = raa(a) - Int(30 + Rnd * 20)
                rasp(a) = 0
                asp(n) = 0
                ' Circle ((ax(n) + rax(a)) / 2, (ay(n) + ray(a) / 2)), ascl(n) + rascl(a), 115
                _Dest map
                PSet (rax(a), ray(a))
                Draw "ta" + Str$(Int(Rnd * 360)) + "c" + Str$(Int(4 + Rnd * 4)) + "r4"
                _Dest 0
                If raf(a) < 1 Then raf(a) = 12
                If af(n) < 1 Then af(n) = 12
            End If
        Next n
        For n = 1 To 100
            bxx = rax(n) + rascl(n) * 2 * Sin((raa(n) + 90) * ro)
            byy = ray(n) + rascl(n) * 2 * Cos((raa(n) + 90) * ro)

            If Int((ax(a) + 3) / 4) = Int(bxx / 4) And Int((ay(a) + 3) / 4) = Int(byy / 4) Then
                ah(a) = ah(a) - Int(1 + Rnd * rascl(n))
                rah(n) = rah(n) - Int(1 + Rnd * ascl(a))
                aa(a) = aa(a) + Int(30 + Rnd * 20)
                raa(n) = raa(n) - Int(30 + Rnd * 20)
                asp(a) = 0
                rasp(n) = 0
                Circle ((ax(a) + rax(n)) / 2, (ay(a) + ray(n) / 2)), ascl(a) + rascl(n), 115
                _Dest map
                PSet (ax(a), ay(a))
                Draw "ta" + Str$(Int(Rnd * 360)) + "c" + Str$(_RGB32(200, 200, 200)) + "r4"
                _Dest 0
                If raf(a) < 1 Then raf(n) = 12
                If af(a) < 1 Then af(a) = 12

            End If
        Next n
        asp(a) = asp(a) + Int(Rnd * 2)
        If asp(a) > ascl(a) * 1.5 Then asp(a) = ascl(a)
        rasp(a) = rasp(a) + Int(Rnd * 2)
        If rasp(a) > rascl(a) * 1.5 Then rasp(a) = rascl(a)
        If ah(a) < 1 Then
            _Dest map
            PSet (ax(a), ay(a))
            Draw "s" + Str$(ascl(a) - 1)
            Draw "ta" + Str$(aa(a)) + "c" + Str$(_rgb32(200,200,200)) + "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2"
            _Dest 0
            ay(a) = Int(Rnd * maxay)
            ax(a) = 0 - (Int(Rnd * 10) + 5)
            aa(a) = 0
            ascl(a) = Int(Rnd * 6) + 3
            ah(a) = Int(Rnd * 10) + ascl(a) * 2
        End If
        If a <= rac And rah(a) < 1 Then
            _Dest map
            PSet (rax(a), ray(a))
            Draw "s" + Str$(rascl(a) - 1)
            Draw "ta" + Str$(raa(a)) + "c" + Str$(_rgb32(200,200,200)) + "m+4,-2m+4,+2m-4,+2m-4,-2br8r5m+2,-2m+1,+2m-1,+2m-2,-2"
            _Dest 0
            ray(a) = Int(Rnd * maxay)
            rax(a) = maxax + 10 - (Int(Rnd * 10) + 5)
            raa(a) = 180
            rascl(a) = Int(Rnd * 6) + 3
            rah(a) = Int(Rnd * 10) + rascl(a) * 2
        End If

    Next





    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 dant (ang, klr, scl, x, y)

    Draw "s" + Str$(scl)
    PSet (x, y)
    Draw "c" + Str$(_RGB32(klr, 10, 10)) + "ta" + Str$(ang) + ant$
End Sub
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)