08-10-2022, 02:54 PM
Hi Sierra Ken. I took the liberty of modifying your program so that you don't have to save or delete anything from your hard drive. The reason why the graphics are generated so slowly is the use of the slow PAINT command and also the small step in some loops. Just an information, the same thing as DEL does the KILL command, so you don't need to use SHELL (it's not needed at all in the mentioned modification anyway).
Code: (Select All)
'Scrolling Map Example by SierraKen - August 9, 2022
Cls
Print " Random Large Map Maker"
Print: Print
Print " by SierraKen"
Print: Print
Print "This will create a large explorer-map.bmp file (currently around 30 mb in size)."
Print "After it loads the randomly made map picture, it will delete it off your"
Print "computer. Then you can use the arrow keys to walk around the map."
Print
Print "This is just an example to make something with a moving background."
Print "At first it will show a very large map graphic, just wait until around"
Print "20 seconds when it finishes the loading and calculation."
Print "The countdown timer will be in the topic bar above."
Print
Print "Currently the map only has randomly placed houses, but feel free to add anything"
Print "you wish. I placed notes in the QB64 code."
Print: Print
Input "Press Enter to start."; a$
Cls
Randomize Timer
Type object
x As Single
y As Single
End Type
Const keyUP = 18432
Const keyDOWN = 20480
Const keyLEFT = 19200
Const keyRIGHT = 19712
Const Esc = 27
Dim Shared player As object
Dim Shared camera As object
Dim Shared map As Long
Dim Shared map2 As Long
Dim playerSpeed As Single
Dim housex(30)
Dim housey(30)
Dim rx(250)
Dim ry(250)
start:
_Limit 2000
playerSpeed = 5
'------------------------------------------------------------------------------------------------------------
'Creates large "explorer-map.bmp" file to work off of. It will delete it after it is done loading and calculating.
'The Title Bar will show you how long of time it will take to load and calculate, which is around 20 seconds.
map2& = _NewImage(3000, 3000, 32)
'Screen map2&
_Dest map2&
_Source map2&
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Feel free to add any graphics between these 2 lines:
For h = 1 To 30
' _Limit 2000
again:
housex(h) = Rnd * 2500
housey(h) = Rnd * 2500
For check = 0 To h - 1
' _Limit 2000
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
' _Limit 2000
again2:
rx(r) = Rnd * 3000
ry(r) = Rnd * 3000
For check = 0 To 30
' _Limit 2000
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 (2999, 2999), _RGB32(127, 172, 127), _RGB32(255, 255, 255)
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'SaveImage map2&, "explorer-map" 'The 20 second wait time is in the modified BMP SaveImage SUB.
'------------------------------------------------------------------------------------------------------------
'map2& = 0
'Cls
_Title "Map Explorer - by SierraKen"
Screen _NewImage(800, 600, 32)
player.x = _Width / 2
player.y = _Height / 2
'map = _LoadImage("explorer-map.bmp", 32)
'_Dest map
'_Dest 0
'_Source 0
'Shell _DontWait _Hide "DEL explorer-map.bmp" 'Deletes big "explorer-map.bmp" file that it creates first, which is around 30 MB.
' KILL statement can do the same as DEL
t = 1
Do
Cls
_PutImage (camera.x, camera.y), map2& 'upgraded
If _KeyDown(keyUP) Then player.y = player.y - playerSpeed: t = t + 1
If _KeyDown(keyDOWN) Then player.y = player.y + playerSpeed: t = t + 1
If _KeyDown(keyLEFT) Then player.x = player.x - playerSpeed: t = t + 1
If _KeyDown(keyRIGHT) Then player.x = player.x + playerSpeed: t = t + 1
If _KeyDown(Esc) Then
Screen 0
_FreeImage map2&
System
End If
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(map2&) - _Width) Then camera.x = -(_Width(map2&) - _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(map2&) - _Height) Then camera.y = -(_Height(map2&) - _Height)
End Sub
' next is not need
Sub SaveImage (image As Long, filename As String)
bytesperpixel& = _PixelSize(image&)
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
x& = _Width(image&)
y& = _Height(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
If bytesperpixel& = 1 Then
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PaletteColor(c&, image&) ' color attribute to read.
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
Next
End If
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
lastsource& = _Source
_Source image&
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
timeleft = 3000 'Mod by SierraKen
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
r$ = ""
timeleft = timeleft - 1 'Mod by SierraKen for giant map maker.
timeleft2 = timeleft / 100 'Mod by SierraKen to make an easier countdown in the topic bar.
_Title "Calculating Map Time Left: " + Str$(timeleft2) 'Mod by SierraKen for giant map maker.
For px& = 0 To x& - 1
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
Next px&
d$ = d$ + r$ + padder$
Next py&
_Source lastsource&
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
b$ = b$ + d$ ' total file data bytes to create file
Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
f& = FreeFile
Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
Open filename$ + ext$ For Binary As #f&
Put #f&, , b$
Close #f&
End Sub