UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: programaths on January 23, 2021, 09:50:07 AM

Title: Simple platformer with slopes
Post by: programaths on January 23, 2021, 09:50:07 AM
This code does the following:


It answers the following:

The code is copy-paste friendly. That means you can run it without having to make changes.
All sprites are procedural.

[pbcode]
; PROJECT : SimpleLevel
; AUTHOR  : Programaths
; CREATED : 1/22/2021
; EDITED  : 1/23/2021
; ---------------------------------------------------------------------
MyWorld=NewWorld()
MyCamera=NewCamera()
CameraCls MyCamera,on
CameraClsColour MyCamera,RGB(0,0,0)

level1:
data 20,15
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
data 1,0,0,0,0,0,2,3,0,0,0,0,0,0,0,0,0,0,0,1
data 1,1,1,1,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,1
data 1,0,0,0,0,0,0,0,0,0,1,0,2,3,0,0,2,0,0,1
data 1,0,0,0,0,0,0,0,0,0,1,0,5,4,0,2,4,0,0,1
data 1,0,1,1,1,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1
data 1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,1,0,1
data 1,0,1,0,1,1,1,1,1,1,1,0,6,7,0,0,0,0,0,1
data 1,0,1,0,0,1,0,0,0,0,0,0,9,8,0,0,0,0,1,1
data 1,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,9,1
data 1,0,1,0,0,1,0,0,0,6,7,0,0,0,2,3,0,0,0,1
data 1,0,1,0,1,1,0,0,0,9,8,0,0,0,5,4,0,0,0,1
data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1


MyMap = NewMap(1)
MapDebug MyMap,off
TileWidth=64
TileHeight=64
NumberOfTiles = 10
CreateMapGFX MyMap,TileWidth,TileHeight,NumberOfTiles,RGB(0,0,0)
currentTileImage=NewImage(TileWidth,TileHeight)

; The blocks definition
RenderToImage currentTileImage

; A square block
cls
BoxC 0,0,TileWidth,TileHeight,1,$ffffaa
LightImage currentTileImage,16,16,200,1.0
GetMapBlk MyMap,1,0,0

; A 45° slope down left /|
cls
TriC 0,TileHeight,TileWidth,TileHeight,TileWidth,0,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,2,0,0

; A 45° slope down right |\
cls
TriC 0,0,TileWidth,TileHeight,0,TileHeight,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,3,0,0

; A 45° slope up right |/
cls
TriC 0,0,TileWidth,0,0,TileHeight,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,4,0,0

; A 45° slope up left \|
cls
TriC 0,0,TileWidth,0,TileWidth,TileHeight,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,5,0,0

; A 45° half slope down left /|
cls
TriC 0,TileHeight,TileWidth,TileHeight,TileWidth,TileHeight/2,$ffffaa
LightImage currentTileImage,32,16,200,1.0
GetMapBlk MyMap,6,0,0

; A 45° half slope down right |\
cls
TriC 0,TileHeight,TileWidth,TileHeight,0,TileHeight/2,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,7,0,0

; A 45° half slope up right |/
cls
TriC 0,0,TileWidth,0,0,TileHeight/2,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,8,0,0

; A 45° half slope up left \|
cls
TriC 0,0,TileWidth,0,TileWidth,TileHeight/2,$ffffaa
LightImage currentTileImage,32,32,200,1.0
GetMapBlk MyMap,9,0,0

deleteImage currentTileImage

hs#=0.0
vs#=0.0
grounded=false

restore level1

local w=ReadData()
local h=ReadData()

currentTileImage=NewImage(64,64)
RenderToImage currentTileImage
boxC 0,0,64,64,1,$ffffaa
LightImage currentTileImage,10,10,255,0.5
background=NewImage((w+2)*64,(h+2)*64)
RenderToImage background
GridImage currentTileImage,0,0,h+2,w+2,1

deleteImage currentTileImage

MyLevel=NewLevel(MyMap,w,h)
LevelTransparent MyMap,MyLevel,0

RenderToScreen

CaptureToWorld MyWorld

ballImg=CreateBallImage(64)
spr = NewSprite(150,150,ballImg)
AutoCenterSpriteHandle spr,true
SpriteCollisionMode spr, 4
SpriteCollisionWorld spr, MyWorld
SpriteCollisionRadius spr,24
SpriteCollision 1,on
SpriteCollisionClass 1,1

for i=0 to h-1
   for j=0 to w-1
      PokeLevelTile MyMap,MyLevel,j,i,readData()
   next j
next i

createWordLines(MyMap,MyLevel)
PartitionWorld MyWorld, 32

drawgfximmediate

do

   CaptureToScene
   ClsScene

   CaptureDepth 4
   drawImage background, GetSpriteX(spr)*0.9-GetScreenWidth()/2,GetSpriteY(spr)*0.9-GetScreenHeight()/2,0

   CaptureDepth 3
   DrawMap MyMap,MyLevel,0,0

   if grounded and SpaceKey()
      grounded=false
       vs#=-2.0
   endif
   
   If DownKey() Then vs#+=0.1
   If LeftKey() Then hs#-=0.1
   If RightKey() Then hs#+=0.1

   hs# = 0.9*hs#

   hs#=clipRange#(hs#,-4.0,4.0)

   vs#=vs#+0.01
   vs#=clipRange#(vs#,-4.0,4.0)

   MoveSprite spr,hs#,vs#

   if GetSpriteWorldImpact(spr)
      CaptureDepth 1

      cpFound = GetWorldClosestPoint(MyWorld,GetSpriteX(spr),GetSpriteY(spr),GetSpriteX(spr)-22,GetSpriteY(spr)-24,GetSpriteX(spr)+22,GetSpriteY(spr)+24)
   
      if cpFound
         ix#=GetIntersectX#(0)
         iy#=GetIntersectY#(0)
      
         circleC ix#,iy#,8,1,$ff0000
      
         if (Range(ix#,GetSpriteX(spr)-20,GetSpriteX(spr)+20)) ;and iy#>GetSpriteY(spr)
            vs#=vs#*0.1
            hs#=hs#+GetNormalX#(0)*0.1
            if vs#<0.1
               vs#=0
            endif
         
            if iy#>GetSpriteY(spr) then grounded=true
         endif
      endif   
   endif

   CaptureDepth 2

   drawAllSprites

   PositionCamera MyCamera,GetSpriteX(spr)-GetScreenWidth()/2,GetSpriteY(spr)-GetScreenHeight()/2
   DrawCamera MyCamera

   sync

loop

waitkey

function createWordLines(map,level)
   local w=GetLevelWidth(map,level)
   local h=GetLevelHeight(map,level)
   local tw=GetMapBlockWidth(map)
   local th=GetMapBlockHeight(map)
   
   for i=0 to h-1
      for j=0 to w-1
         topEmpty = false
         leftEmpty = false
         rightEmpty = false
         downEmpty = false
         if i>0 then topEmpty=PeekLevelTile(map,level,j,i-1)=0
         if i<h-1 then downEmpty=PeekLevelTile(map,level,j,i+1)=0
         if j>0 then leftEmpty=PeekLevelTile(map,level,j-1,i)=0
         if j<w-1 then rightEmpty=PeekLevelTile(map,level,j+1,i)=0
         if PeekLevelTile(map,level,j,i)=1
            if topEmpty
               line (j+1)*tw,i*th,(j)*tw,i*th
            endif
            if downEmpty
               line (j)*tw,(i+1)*th,(j+1)*tw,(i+1)*th
            endif
            if leftEmpty
               line j*tw,i*th,j*tw,(i+1)*th
            endif
            if rightEmpty
               line (j+1)*tw,(i+1)*th,(j+1)*tw,(i)*th
            endif   
         endif
         ; 45° up right /|
         if PeekLevelTile(map,level,j,i)=2
            line (j+1)*tw,(i)*th,(j)*tw,(i+1)*th
         endif
         ; 45° down right |\
         if PeekLevelTile(map,level,j,i)=3
            line (j+1)*tw,(i+1)*th,(j)*tw,(i)*th
         endif   
         ; 45° down right \|
         if PeekLevelTile(map,level,j,i)=4
            line (j)*tw,(i+1)*th,(j+1)*tw,(i)*th
         endif
         ; 45° up right |/
         if PeekLevelTile(map,level,j,i)=5
            line (j)*tw,(i)*th,(j+1)*tw,(i+1)*th
         endif
         ; 45° half up right /|
         if PeekLevelTile(map,level,j,i)=6
            line (j+1)*tw,(i+0.5)*th,(j)*tw,(i+1)*th
         endif
         ; 45° half down right |\
         if PeekLevelTile(map,level,j,i)=7
            line (j+1)*tw,(i+1)*th,(j)*tw,(i+0.5)*th
         endif   
         ; 45° half down right \|
         if PeekLevelTile(map,level,j,i)=8
            line (j)*tw,(i+0.5)*th,(j+1)*tw,(i)*th
         endif
         ; 45° half up right |/
         if PeekLevelTile(map,level,j,i)=9
            line (j)*tw,(i)*th,(j+1)*tw,(i+0.5)*th
         endif            
      next j
   next i
endfunction

Function CreateBallImage(Size)
  ThisImage=NewImage(size,size)
  Colour=RGB(128+Rnd(127),128+Rnd(127),128+Rnd(127))
  RenderPhongImage ThisIMage,size/2,size/2,Colour,200,255.0/(size/2)
EndFunction ThisImage
[/pbcode]
Title: Re: Simple platformer with slopes
Post by: kevin on January 23, 2021, 10:59:17 PM

Excellent...  nice use of various virtually unknown commands too






Title: Re: Simple platformer with slopes
Post by: stevmjon on January 24, 2021, 07:43:44 PM
nice demo. a good one for beginners to learn from.