2D Parallax Scrolling Example v0.65 build 2020-07-29

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
UEZ
Posts: 612
Joined: May 05, 2017 19:59
Location: Germany

2D Parallax Scrolling Example v0.65 build 2020-07-29

Postby UEZ » Jul 16, 2020 17:20

A small and simple example of a "2D Parallax Scrolling" with 6 layers.

Preview:
Image

2D Parallax Scrolling.bas

Code: Select all

'Coded by UEZ build 2020-07-29
'Images used from https://gamedevelopment.tutsplus.com/tutorials/parallax-scrolling-a-simple-effective-way-to-add-depth-to-a-2d-game--cms-21510
'Thanks to dodicat for the Regulate function

#Include "fbgfx.bi"
#include "file.bi"


Using FB

Type tBitmap_Header Field = 1 '54 bytes
   'BMP Header
   As UShort bfType   'for windows bitmap it must be 19778 (&h4D42) aka "BM" in little-endian format
   As Long bfSize
   As ULong bfReserved
   As ULong bfOffBits
   'DIB Header
   As ULong biSize
   As Long biWidth = 0
   As Long biHeight = 0
   As Ushort biPlanes
   As Ushort biBitCount
   As ULong biCompression
   As ULong biSizeImage
   As Long biXPelsPerMeter
   As Long biYPelsPerMeter
   As ULong biClrUsed
   As ULong biClrImportant
End Type

Function GetBitmapHeaderInfo(filename As String) As tBitmap_Header
   Dim As tBitmap_Header BmpInfo
   If FileExists(filename) = 0 Then Return BmpInfo
   Dim As Integer f
   f = FreeFile
   Open filename For Binary As #f
   Get #f, , BmpInfo
   Close #f
   Return BmpInfo
End Function

Function Regulate(TargetFPS As Long, Byref fps As Long) As Long 'by dodicat
   Static As Double timervalue, _lastsleeptime, t3, frames
   Var t = Timer
   frames += 1
   If (t - t3) >= 1 Then t3 = t : fps = frames : frames = 0
   Var sleeptime =_lastsleeptime + ((1 / TargetFPS) - t + timervalue) * 1000
   If sleeptime < 1 Then sleeptime = 1
   _lastsleeptime = sleeptime
   timervalue = t
   Return sleeptime
End Function

Const iW = 750, iH = 300, iH2 = iH \ 2

Screenres iW, iH, 32, 2, GFX_WINDOWED Or GFX_NO_SWITCH Or GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES
ScreenSet 1, 0

Windowtitle("2D Parallax Scrolling Example v0.65 by UEZ")
Dim As String sText = "2D Parallax Scrolling"

#Ifdef __FB_WIN32__
   'generate font using gdiplus and copy it afterwards to FB image which will be displayed
   #inclib "gdiplus"
   #include once "win/gdiplus-c.bi"
   Dim Shared gdipToken As ULONG_PTR
   Dim Shared GDIp As GdiplusStartupInput
   GDIp.GdiplusVersion = 1
   GdiplusStartup(@gdipToken, @GDIp, NULL)
   Dim As HWND hHWND
   Dim As Any Ptr hBitmap, hGfx, hFont, hFamily, hFormat, hBrush, pImgText
   pImgText = Imagecreate(iW, iH, 0)
   
   Dim As Integer pitch
   Dim pPixData As Any Ptr
   Imageinfo(pImgText, , , , pitch, pPixData)
   
   ScreenControl(GET_WINDOW_HANDLE, Cast(Integer, hHWND))

   GdipCreateBitmapFromScan0(iW, iH, 0, PixelFormat32bppARGB, 0, @hBitmap)
   GdipGetImageGraphicsContext(hBitmap, @hGfx)
   GdipSetSmoothingMode(hGfx, SmoothingModeAntiAlias)
   GdipSetTextRenderingHint(hGfx, TextRenderingHintAntiAliasGridFit)
   If GdipCreateFontFamilyFromName("Algerian", Null, @hFamily) <> 0 Then GdipCreateFontFamilyFromName("Impact", Null, @hFamily)
   GdipCreateStringFormat(0, 0, @hFormat)   
   GdipCreateFont(hFamily, Min(60, iW / 12.5), 0, 3, @hFont)
   GdipSetStringFormatAlign(hFormat, StringAlignmentCenter)
   GdipSetStringFormatLineAlign(hFormat, StringAlignmentCenter)
   GdipCreateSolidFill(&hA0FFFFFF, @hBrush)
   Dim tLayout as RectF = Type((iW - Min(iW, 600)) / 2, (iH - Min(iH, 300)) / 2, Min(iW, 600), Min(iH, 300))
   GdipDrawString(hGfx, sText, -1, hFont, @tLayout, hFormat, hBrush)
   
   #Define PixelSet(_x, _y, colour)    *CPtr(ulong ptr, pPixData + (_y) * pitch + (_x) Shl 2) = (colour)
   
   Dim As Rect tRect = Type(0, 0, iW - 1, iH - 1)
   Dim As BitmapData tBitmapData
   Dim As Uinteger  x, y, RowOffset
   GdipBitmapLockBits(hBitmap, Cast(Any Ptr, @tRect), ImageLockModeWrite, PixelFormat32bppARGB, @tBitmapData)
   For y = 0 To iH - 1
      RowOffset = y * iW
      For x = 0 To iW - 1
         PixelSet(x, y, Cast(ULong Ptr, tBitmapData.Scan0)[RowOffset + x])
      Next     
   Next
   GdipBitmapUnlockBits(hBitmap, @tBitmapData)   
   GdipDisposeImage(hBitmap)
   GdipDeleteBrush(hBrush)
   GdipDeleteFontFamily(hFamily)
   GdipDeleteStringFormat(hFormat)
   GdipDeleteFont(hFont)
   GdipDeleteGraphics(hGfx)
   GdiplusShutdown(gdipToken)
#Endif

Type vec
   As Single x, y, s
   As Ushort w, h
   As Any Ptr img
End Type

Const levels = 6
Dim As Short i, j = 0, px
Dim As vec Parallax(levels - 1)
Dim As String fn
Dim As tBitmap_Header BmpInfo

For i = 0 To Ubound(Parallax)
   fn = "Images/P" & i & ".bmp"
   BmpInfo = GetBitmapHeaderInfo(fn)
   If i > 0 Then  Parallax(i).s = (-1 - ((i - 1) / 3)^(2^1.75) ) / 3
   Parallax(i).x = 0
   Parallax(i).w = BmpInfo.biWidth
   Parallax(i).h = BmpInfo.biHeight
   Parallax(i).img = Imagecreate(Parallax(i).w, Parallax(i).h)
   Bload(fn, Parallax(i).img)
   If Parallax(i).w <> 0 Then j += 1
Next

If j <> levels Then
   For i = 0 To Ubound(Parallax)
      If Parallax(i).img <> 0 Then Imagedestroy(Parallax(i).img)
   Next
   ? "At least one image file is missing. Exiting..."
   Flip
   Sleep
   End
End If

Parallax(0).x = iW / 2 + 80 'half the scrolling speed of 1st image
Parallax(0).y = 0 'half the scrolling speed of 1st image

Parallax(1).s /= 2 'half the scrolling speed of 1st image

'y position of each image
Parallax(1).y = 0
Parallax(2).y = 50
Parallax(3).y = 70
Parallax(4).y = 100
Parallax(5).y = 200

Dim As Ulong iFPS = 0, iPos = (iW - Len(sText) * 8) \ 2

Do
   For j = 1 To Ubound(Parallax)
      For i = -Parallax(j).w To Parallax(j).w Step Parallax(j).w
         px = i + Parallax(j).x
         If px > -Parallax(j).w And px < iW Then Put(px, Parallax(j).y), Parallax(j).img, Alpha ': Draw String (px, Parallax(j).y), Str(j), &hFFFF0000
      Next
      If j = 1 Then Put(Parallax(0).x, Parallax(0).y), Parallax(0).img, Alpha
      
      Parallax(j).x += Parallax(j).s
      If Parallax(j).x < 0 Then Parallax(j).x = Parallax(j).w
      
      If j = Ubound(Parallax) - 1 Then
         #Ifdef __Fb_win32__
            Put (0, 0), pImgText, Alpha
         #Else
            Draw String (iPos, iH2 + 8), sText & " by UEZ", &hA0FFFFFF
         #Endif
      End If
   Next
   Flip

   Sleep(Regulate(60, iFPS), 1)
Loop Until Len(Inkey())

For i = 0 To Ubound(Parallax)
   Imagedestroy(Parallax(i).img)
Next

#Ifdef __Fb_win32__
   Imagedestroy(pImgText)
#Endif


You must download the needed images to run the code properly.

Download: 2D Parallax Scrolling Images.7z (427 kb)

Extract the archive to the same directory where you saved the code above. After extraction a dir named Images should be created with 6 images in it (P0.bmp, P1.bmp, ..., P5.bmp).

Theoretically it should work also on Linux...

Update 2020-29-09: added moon images -> you need to download the image archive again and update the source code to run it properly!
Last edited by UEZ on Jul 29, 2020 13:16, edited 3 times in total.
Roland Chastain
Posts: 885
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: 2D Parallax Scrolling Example v0.60 build 2020-07-17

Postby Roland Chastain » Jul 18, 2020 2:32

UEZ wrote:Theoretically it should work also on Linux...


Yes, it works. Thank you for sharing.
UEZ
Posts: 612
Joined: May 05, 2017 19:59
Location: Germany

Re: 2D Parallax Scrolling Example v0.60 build 2020-07-17

Postby UEZ » Jul 18, 2020 14:48

Roland Chastain wrote:
UEZ wrote:Theoretically it should work also on Linux...


Yes, it works. Thank you for sharing.

Thanks for testing. :-)
dodicat
Posts: 6641
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 2D Parallax Scrolling Example v0.60 build 2020-07-17

Postby dodicat » Jul 18, 2020 16:30

Thanks UEZ.
Yesterday I got connected via fibre, your bitmaps arrived here intact in no time at all.
You code runs well.
UEZ
Posts: 612
Joined: May 05, 2017 19:59
Location: Germany

Re: 2D Parallax Scrolling Example v0.60 build 2020-07-17

Postby UEZ » Jul 18, 2020 18:12

dodicat wrote:Thanks UEZ.
Yesterday I got connected via fibre, your bitmaps arrived here intact in no time at all.
You code runs well.


Thank you, too, dodicat.

What is your internet speed now with fiber? At the moment here in our town there are construction works to lay fiber cables to each residential buildings. I need to pay for the connect to my house myself if I want. Currently I'm at 100 mbps VDSL which is quite fast. Faster means usually more expensive. Let's see what the connection to my house will cost...
Last edited by UEZ on Jul 18, 2020 20:59, edited 1 time in total.
dodicat
Posts: 6641
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 2D Parallax Scrolling Example v0.60 build 2020-07-17

Postby dodicat » Jul 18, 2020 20:54

A quick test gave 28 Mbps.
It is faster than it was previously, I have a different modem now.
It is only fibre up to several hundred yards away, as far as I know. The last leg is copper wire.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests