Rem DBC Programming Challenge - Side Scroller
Rem Demo Using Tiles & Arrays (c) TDK_Man Nov 2009
 
Gosub Setup
Gosub Create_Tiles
Gosub Generate_Message
Gosub Build_Screen
 
Do
  If LeftKey() Then Gosub Scroll_Left
  If RightKey() Then Gosub Scroll_Right
  If SpaceKey() Then Gosub Enter_Message
  Sync
Loop
End
 
Scroll_Left:
  If XTileOffset > 0
    Set Current Bitmap 1
    Dec XPixelOffset,ScrollSpeed
    If XPixelOffset < 0
      XPixelOffset=16
      Dec XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return
 
Scroll_Right:
  If XTileOffset < ScrnTileWidth
    Set Current Bitmap 1
    Inc XPixelOffset,ScrollSpeed
    If XPixelOffset >= 16
      XPixelOffset=0
      Inc XTileOffset
      For Nx=0 To 50
        For Ny=0 To 37
          Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
        Next Nx
      Next Ny
    Endif
    Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
    Set Current Bitmap 0
    Paste Image 1000,0,0
    Text 5,5," FPS: "+Str$(Screen FPS())+"  "
  Endif
Return
 
Build_Screen:
  Create Bitmap 1,1024,768
  For Nx=0 To 49
    For Ny=0 To 37
      Paste Image Tiles(NX+XTileOffset,NY),Nx*16,Ny*16
    Next Nx
  Next Ny
  Sync
  Get Image 1000,XPixelOffset,0,806+XPixelOffset,576
  Set Current Bitmap 0
  Paste Image 1000,0,0
  Set Text Font "Tahoma"
  Ink RGB(255,255,255),RGB(0,0,255)
Return
 
Create_Tiles:
  Create Bitmap 1,800,600
  Rem Create 19 different random shaded tiles...
  For N=1 To 19
    CLS RGB(255,255,255)
    Ink RGB(0,0,0),0: Box 1,1,15,15
    C=Rnd(55)+200
    Ink RGB(C,C,255),0: Box 1,1,14,14
    Get Image N,0,0,16,16: Rem Store tiles in images 1 to 20
  Next N
  Rem and 1 blue one...
  CLS RGB(255,255,255)
  Ink RGB(0,0,0),0: Box 1,1,15,15
  Ink RGB(0,0,128),0: Box 1,1,14,14
  Get Image 20,0,0,16,16
  Set Current Bitmap 0
  Delete Bitmap 1
Return
 
Generate_Message:
  Rem Place Random Tiles Into The Tiles Array. For This Example, We'll  Limit The Landscape
  Rem To Being 10,000 Tiles Wide...
  Create Bitmap 1,800,600
  CLS 0
  For LandscapeX = 0 To ScrnTileWidth-1
    For LandscapeY = 0 To 37
      Tiles(LandscapeX,LandscapeY)=Rnd(18)+1
    Next LandscapeY
  Next LandscapeX
  Rem Now Replace Random Tiles With Dark Blue Tiles For Message...
  CLS 0: Ink RGB(255,255,255),0
  Text 0,0,T$
  For Ny=0 To Text Height(T$)
    For Nx=0 To Text Width(T$)
      PixCol = Point(Nx,Ny)
      If PixCol <> 0
        Tiles(Nx,Ny+11)=20
      Endif
    Next Nx
  Next Ny
  Sync
  Set Current Bitmap 0
  Delete Bitmap 1
Return
 
Enter_Message:
  Set Current Bitmap 0
  Delete Bitmap 1
  CLS 0: Sync
  Print "User Message:": Print
  Print "Please enter the message you wish to have as the background scrolling message..."
  Input ">: ";T$
  CLS: Sync
  Center Text 400,200,"Please wait while arrays are initiialised (time taken depends on message length)..."
  Gosub Generate_Message
  Gosub Build_Screen
Return
 
Setup:
  Set Display Mode 800,600,16
  Sync On: Sync Rate 0: CLS
  Hide Mouse
  Randomize Timer()
  Dim Tiles(49999,37): Rem Max horizontal tiles 50000, 38 Vertical
  XTileOffset=0
  XPixelOffset=0
  ScrollSpeed=1
  ScrnTileWidth=10000: Rem Limit number of tiles across on this level to 10,000
  T$=" Welcome To TDK's Side Scrolling DBC Challenge Entry!..."
  Center Text 400,200,"Please wait while arrays are initiialised (approx 20 seconds)..."
  Center Text 400,240,"When Running, Use Cursor Left/Right To Scroll - Space Bar To Edit Scroll Message"
  Set Text Opaque
Return