Hello,
I'd like to do a simple thing : scroll a grid infinitely (using a Screen). The idea would be to wrap around the grid itself, but I don't know how to do that in PB. Would it be better to create the grid as multiple lines, or a single sprite, or multiple sprites ? I'm pretty sure there are examples of that somewhere, but I cannot find them.
Any ideas ?
Infinite scrolling ?
Re: Infinite scrolling ?
Code: Select all
EnableExplicit
InitSprite()
InitKeyboard()
Enumeration
#info
#frame
EndEnumeration
Structure _bgs
id.i
x.i
y.i
EndStructure
Structure POINTF
x.f
y.f
EndStructure
Declare.i DoInfo()
Global Dim bg._bgs(8), zcount.i, ycount.i, xcount.i, pcount.i, color.i, Radi.i, pos.POINTF, Speed.f, ev.i, ret.i
OpenWindow(0, 0, 0, 800, 600, "Scroll - Escape key to exit / Arrow keys to scroll", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, 800, 600, #False, 0, 0, #PB_Screen_WaitSynchronization)
For xcount = 0 To 8
bg(xcount)\id = CreateSprite(#PB_Any, 800, 600)
StartDrawing(SpriteOutput(bg(xcount)\id))
DrawingMode(#PB_2DDrawing_AlphaBlend)
For pcount = 0 To 200
Circle(Random(797, 5), Random(597, 5), 1, RGBA(Random(255,10), Random(255,10), Random(255,10), 160))
Next pcount
For zcount = 0 To 800 Step 50
LineXY(zcount, 0, zcount, 600, $CEF8EA1C)
Next zcount
For zcount = 0 To 600 Step 50
LineXY(0, zcount, 800, zcount, $CEF8EA1C)
Next zcount
StopDrawing()
TransparentSpriteColor(bg(xcount)\id, 0)
Next xcount
bg(0)\x = -800 : bg(0)\y = -600
bg(1)\x = 0 : bg(1)\y = -600
bg(2)\x = 800 : bg(2)\y = -600
bg(3)\x = -800 : bg(3)\y = 0
bg(4)\x = 0 : bg(4)\y = 0
bg(5)\x = 800 : bg(5)\y = 0
bg(6)\x = -800 : bg(6)\y = 600
bg(7)\x = 0 : bg(7)\y = 600
bg(8)\x = 800 : bg(8)\y = 600
Speed = 4 : pos\x = 0 : pos\y = 0
CreateSprite(#info, 200, 20)
StartDrawing(SpriteOutput(#info))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(100 - TextWidth("Sector: 0, 0")/2, 1, "Sector: 0, 0",$CEABA21A)
StopDrawing()
TransparentSpriteColor(#info, 0)
CreateSprite(#frame, 50, 50)
StartDrawing(SpriteOutput(#frame))
LineXY(25, 0, 25, 15, $19EAEE)
LineXY(25, 35, 25, 50, $19EAEE)
LineXY(0, 25, 15, 25, $19EAEE)
LineXY(35, 25, 50, 25, $19EAEE)
StopDrawing()
TransparentSpriteColor(#frame, 0)
Repeat
ClearScreen(0)
Repeat
ev = WindowEvent()
Until ev = 0
ExamineKeyboard()
For xcount = 0 To 8
With bg(xcount)
If KeyboardPushed(#PB_Key_Right)
\x + Speed
pos\x + 0.01
If \x >= 800
\x - 1600
EndIf
ElseIf KeyboardPushed(#PB_Key_Left)
\x - Speed
pos\x - 0.01
If \x < -800
\x + 1600
EndIf
EndIf
If KeyboardPushed(#PB_Key_Up)
\y - Speed
pos\y - 0.01
If \y <= -600
\y + 1200
EndIf
ElseIf KeyboardPushed(#PB_Key_Down)
\y + Speed
pos\y + 0.01
If \y >= 600
\y - 1200
EndIf
EndIf
EndWith
Next xcount
For xcount = 0 To 8
DisplayTransparentSprite(bg(xcount)\id, bg(xcount)\x, bg(xcount)\y)
Next xcount
ret = doInfo()
DisplayTransparentSprite(#info, 400 - SpriteWidth(#info)/2, 580)
DisplayTransparentSprite(#frame, ScreenWidth()/2 - 25, ScreenHeight()/2 - 25)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Procedure.i DoInfo()
Static x.i, y.i
If x = pos\x And y = pos\y
ProcedureReturn #True
EndIf
x = pos\x : y = pos\y
FreeSprite(#info)
CreateSprite(#info, 200, 20)
StartDrawing(SpriteOutput(#info))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(100 - TextWidth("Sector: " + Str(pos\x) + "," + Str(pos\y))/2, 1, "Sector: " + Str(pos\x) + "," + Str(pos\y) , $CEABA21A)
StopDrawing()
TransparentSpriteColor(#info,0)
ProcedureReturn #True
EndProcedure
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Re: Infinite scrolling ?
Thanks, I'll try that
Re: Infinite scrolling ?
@DK_PETER: very nice code, but the stars are flickering/flashing every few seconds for me (when i keep an arrow key pressed)
(edited 16/08/2015)
(edited 16/08/2015)
Re: Infinite scrolling ?
A minor bug, perhaps related:firace wrote:@DK_PETER: very nice code, but the stars are flickering/flashing every few seconds for me (when i keep an arrow key pressed)
(edited 16/08/2015)
Many of the stars that are initially displayed disappear as soon as the scrolling begins.