It is currently Sat Jul 04, 2020 9:15 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: Infinite scrolling ?
PostPosted: Thu Aug 06, 2015 7:52 am 
Offline
Enthusiast
Enthusiast

Joined: Wed Sep 18, 2013 11:54 am
Posts: 400
Location: France
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 ? :)


Top
 Profile  
Reply with quote  
 Post subject: Re: Infinite scrolling ?
PostPosted: Tue Aug 11, 2015 10:47 am 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 19, 2011 10:06 am
Posts: 853
Location: Denmark
Code:
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

_________________
“Tell me and I forget. Teach me and I remember. Involve me and I learn.”
— Benjamin Franklin
Current configurations: Windows 10, Intel 6800K, GeForce Gtx 1060, 32 gb ram.


Top
 Profile  
Reply with quote  
 Post subject: Re: Infinite scrolling ?
PostPosted: Tue Aug 11, 2015 11:14 am 
Offline
Enthusiast
Enthusiast

Joined: Wed Sep 18, 2013 11:54 am
Posts: 400
Location: France
Thanks, I'll try that :)


Top
 Profile  
Reply with quote  
 Post subject: Re: Infinite scrolling ?
PostPosted: Sat Aug 15, 2015 8:47 pm 
Offline
Enthusiast
Enthusiast

Joined: Wed Nov 09, 2011 8:58 am
Posts: 603
@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)

_________________
My new project: A simple HTML/CSS UI engine for PB desktop apps
viewtopic.php?f=7&t=74582


Top
 Profile  
Reply with quote  
 Post subject: Re: Infinite scrolling ?
PostPosted: Sun Aug 16, 2015 10:16 am 
Offline
Enthusiast
Enthusiast

Joined: Wed Nov 09, 2011 8:58 am
Posts: 603
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)


A minor bug, perhaps related:
Many of the stars that are initially displayed disappear as soon as the scrolling begins.

_________________
My new project: A simple HTML/CSS UI engine for PB desktop apps
viewtopic.php?f=7&t=74582


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 6 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye