+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Map Explorer (/showthread.php?tid=755)
RE: Map Explorer - James D Jarvis - 08-12-2022
Pillars and Pyramids, Don't know if they fit the theme but they were fun to add in just to see what they looked like.
I moved the lakes to the top of the feature rendering then inserted this block between the lakes and the houses.
Code: (Select All)
Dim pillarx(30), pillary(30), pillarh(30), pillarwid(30)
Dim pyramidx(6), pyramidy(6), pyramidh(6)
'pillars
pc = Int(11 + Rnd * 20)
For p = 1 To pc
pillarx(p) = 100 + Rnd * 3300
pillary(p) = 100 + Rnd * 2300
pillarwid(p) = 4 + Int(Rnd * 20)
pillarh(p) = pillarwid(p) + Int(Rnd * (6 * pillarwid(p)))
pr = 30 + Rnd * 200: pg = 30 + Rnd * 200: pb = 30 + Rnd * 200
For px = pillarx(p) - pillarwid(p) To pillarx(p) + pillarwid(p)
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(pr, pg, pb)
Next
If Rnd * 6 > 2.5 Then
For px = pillarx(p) - (pillarwid(p) + pillarwid(p) / 5) To pillarx(p) + pillarwid(p) + pillarwid(p) / 5
Line (px, pillary(p) - pillarwid(p) / 3)-(px, pillary(p)), _RGB32(pr, pg, pb)
Next
End If
If Rnd * 6 < 4.8 Then
For px = pillarx(p) - (pillarwid(p) + pillarwid(p) / 5) To pillarx(p) + pillarwid(p) + pillarwid(p) / 5
Line (px, pillary(p) + pillarh(p))-(px, pillary(p) + pillarh(p) + pillarwid(p) / 3), _RGB32(pr, pg, pb)
Next
End If
For px = pillarx(p) + 1 To pillarx(p) - (pillarx(wid) - 1) Step -1
tpr = pr - n / 3: tpg = pg - n / 3: tpb = pb - n / 3
If tpr < 2 Then tpr = 2
If tpg < 2 Then tpg = 2
If tpb < 2 Then tpb = 2
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(tpr, tpg, tpb)
Next
tpr = pr + 40: tpg = pg + 40: tpb = pb + 40
If tpr > 254 Then tpr = 254
If tpg > 254 Then tpg = 254
If tpb > 254 Then tpb = 254
pcl = 3 + pillarwid(p) / 6
For px = pillarx(p) - pillarwid(p) To pillarx(p) + pillarwid(p) Step pcl
tpr = tpr + 2: tpg = tpg + 2: tpb = tpb + 2
If tpr > 254 Then tpr = 254
If tpg > 254 Then tpg = 254
If tpb > 254 Then tpb = 254
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(tpr, tpg, tpb)
Next
Next
'pyramids
pc = Int(1 + Rnd * 4)
For p = 1 To pc
pyramidx(p) = 100 + Rnd * 3300
pyramidy(p) = 100 + Rnd * 2300
pyramidh(p) = Int(Rnd * 120) + 60
pr = Rnd * 255: pg = Rnd * 255: pb = Rnd * 255
For n = 0 To pyramidh(p)
Line (pyramidx(p) - n, pyramidy(p) + n)-(pyramidx(p) + n, pyramidy(p) + n), _RGB32(pr, pg, pb), BF
tpr = pr - n / 2: tpg = pg = n / 2: tpb = pb - n / 3
If tpr < 2 Then tpr = 2
If tpg < 2 Then tpg = 2
If tpb < 2 Then tpb = 2
Line (pyramidx(p) - (n - 1), pyramidy(p) + n)-(pyramidx(p), pyramidy(p) + n), _RGB32(tpr, tpg, tpb), BF
Next n
Next pRE: Map Explorer - SierraKen - 08-12-2022
(08-12-2022, 06:33 AM)vince Wrote: That giant bowling ball next to the houses looks like a real hazard!
LOL Vince, you probably saw the cave, which kinda looks like half of a bowling ball stuck in the ground. Or you saw a lake.
RE: Map Explorer - SierraKen - 08-12-2022
James, thank you!!! They go pretty good with it. I did have to add some check loops for the variables so most of them won't overlap on other ones. Some still might overlap on each other, I didn't make that 100%. But the checks mostly work. I keep the houses on the top of the code because the rest of the objects checks the houses so they won't go on them. I also reduced the houses from 30 to 20. This is coming out pretty good!
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)
Dim pillarx(30), pillary(30), pillarh(30), pillarwid(30)
Dim pyramidx(6), pyramidy(6), pyramidh(6)
_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 20
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 rr - 1
If lx(check) > lx(rr) - 250 And lx(check) < lx(rr) + 250 And ly(check) > ly(rr) - 250 And ly(check) < ly(rr) + 250 Then GoTo again2:
Next check
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 20
If housex(check) > cavex - 550 And housex(check) < cavex + 550 And housey(check) > cavey - 550 And housey(check) < cavey + 550 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
'pillars
pc = Int(11 + Rnd * 20)
For p = 1 To pc
checkpillars:
pillarx(p) = 100 + Rnd * 3300
pillary(p) = 100 + Rnd * 2300
For check = 0 To 20
If housex(check) > pillarx(p) - 250 And housex(check) < pillarx(p) + 250 And housey(check) > pillary(p) - 250 And housey(check) < pillary(p) + 250 Then GoTo checkpillars:
Next check
For check = 0 To 30
If lx(check) > pillarx(p) - 250 And lx(check) < pillarx(p) + 250 And ly(check) > pillary(p) - 250 And ly(check) < pillary(p) + 250 Then GoTo checkpillars:
Next check
pillarwid(p) = 4 + Int(Rnd * 20)
pillarh(p) = pillarwid(p) + Int(Rnd * (6 * pillarwid(p)))
pr = 30 + Rnd * 200: pg = 30 + Rnd * 200: pb = 30 + Rnd * 200
For px = pillarx(p) - pillarwid(p) To pillarx(p) + pillarwid(p)
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(pr, pg, pb)
Next
If Rnd * 6 > 2.5 Then
For px = pillarx(p) - (pillarwid(p) + pillarwid(p) / 5) To pillarx(p) + pillarwid(p) + pillarwid(p) / 5
Line (px, pillary(p) - pillarwid(p) / 3)-(px, pillary(p)), _RGB32(pr, pg, pb)
Next
End If
If Rnd * 6 < 4.8 Then
For px = pillarx(p) - (pillarwid(p) + pillarwid(p) / 5) To pillarx(p) + pillarwid(p) + pillarwid(p) / 5
Line (px, pillary(p) + pillarh(p))-(px, pillary(p) + pillarh(p) + pillarwid(p) / 3), _RGB32(pr, pg, pb)
Next
End If
For px = pillarx(p) + 1 To pillarx(p) - (pillarx(wid) - 1) Step -1
tpr = pr - n / 3: tpg = pg - n / 3: tpb = pb - n / 3
If tpr < 2 Then tpr = 2
If tpg < 2 Then tpg = 2
If tpb < 2 Then tpb = 2
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(tpr, tpg, tpb)
Next
tpr = pr + 40: tpg = pg + 40: tpb = pb + 40
If tpr > 254 Then tpr = 254
If tpg > 254 Then tpg = 254
If tpb > 254 Then tpb = 254
pcl = 3 + pillarwid(p) / 6
For px = pillarx(p) - pillarwid(p) To pillarx(p) + pillarwid(p) Step pcl
tpr = tpr + 2: tpg = tpg + 2: tpb = tpb + 2
If tpr > 254 Then tpr = 254
If tpg > 254 Then tpg = 254
If tpb > 254 Then tpb = 254
Line (px, pillary(p))-(px, pillary(p) + pillarh(p)), _RGB32(tpr, tpg, tpb)
Next
Next
'pyramids
pc2 = Int(1 + Rnd * 4)
For p = 1 To pc2
checkpyramids:
pyramidx(p) = 100 + Rnd * 3300
pyramidy(p) = 100 + Rnd * 2300
For check = 0 To 20
If housex(check) > pyramidx(p) - 250 And housex(check) < pyramidx(p) + 250 And housey(check) > pyramidy(p) - 250 And housey(check) < pyramidy(p) + 250 Then GoTo checkpyramids:
Next check
For check = 0 To pc
If pillarx(check) > pyramidx(p) - 250 And pillarx(check) < pyramidx(p) + 250 And pillary(check) > pyramidy(p) - 250 And pillary(check) < pyramidy(p) + 250 Then GoTo checkpyramids:
Next check
For check = 0 To 30
If lx(check) > pyramidx(p) - 250 And lx(check) < pyramidx(p) + 250 And ly(check) > pyramidy(p) - 250 And ly(check) < pyramidy(p) + 250 Then GoTo checkpyramids:
Next check
pyramidh(p) = Int(Rnd * 120) + 60
pr = Rnd * 255: pg = Rnd * 255: pb = Rnd * 255
For n = 0 To pyramidh(p)
Line (pyramidx(p) - n, pyramidy(p) + n)-(pyramidx(p) + n, pyramidy(p) + n), _RGB32(pr, pg, pb), BF
tpr = pr - n / 2: tpg = pg = n / 2: tpb = pb - n / 3
If tpr < 2 Then tpr = 2
If tpg < 2 Then tpg = 2
If tpb < 2 Then tpb = 2
Line (pyramidx(p) - (n - 1), pyramidy(p) + n)-(pyramidx(p), pyramidy(p) + n), _RGB32(tpr, tpg, tpb), BF
Next n
Next p
_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_MBRE: Map Explorer - James D Jarvis - 08-12-2022
I'd noticed some sort of method for overlapping the houses but hadn't dug into it. Glad you liked my contributions and figured out how to get some use out of them.