Sorry your browser is not supported!

Function _Configure_Zones
   Restore ZoneData
   For Z = 1 To 22
      Read ItemNumber
      Read Zones(Z).Level
      Read Zones(Z).Active_Player_1
      Read Zones(Z).Active_Player_2
      Read Zones(Z).Type$
      Read Zones(Z).X1
      Read Zones(Z).Y1
      Read Zones(Z).X2
      Read Zones(Z).Y2
      Read Zones(Z).Sprite
   Next Z

   ZoneData:
   Data 1, 1, True, True, "Wall", 0, 216, 15, 338, 1101
   Data 2, 1, True, True, "Wall", 624, 269, 639, 338, 1102
   Data 3, 1, True, True, "Wall", 58, 90, 59, 139, 1103
   Data 4, 1, True, True, "Floor", 0, 152, 415, 153, 1201
   Data 5, 1, True, True, "Floor", 496, 145, 640, 146, 1202
   Data 6, 1, True, True, "Floor", 400, 241, 640, 242, 1203
   Data 7, 1, True, True, "Floor", 0, 340, 640, 341, 1204
   Data 8, 1, True, True, "Ladder", 288, 156, 338, 283, 1301
   Data 9, 2, True, True, "Wall", 0, 268, 15, 339, 1101
   Data 10, 2, True, True, "Wall", 608, 172, 623, 239, 1102
   Data 11, 2, True, True, "Wall", 608, 268, 623, 339, 1103
   Data 12, 2, True, True, "Floor", 308, 220, 331, 221, 1104
   Data 13, 2, True, True, "Floor", 0, 144, 159, 145, 1201
   Data 14, 2, True, True, "Floor", 224, 152, 415, 153, 1202
   Data 15, 2, True, True, "Floor", 480, 144, 640, 145, 1203
   Data 16, 2, True, True, "Floor", 0, 240, 255, 241, 1204
   Data 17, 2, True, True, "Floor", 384, 240, 640, 241, 1205
   Data 18, 2, True, True, "Floor", 0, 340, 303, 341, 1206
   Data 19, 2, True, True, "Floor", 336, 340, 640, 341, 1207
   Data 20, 2, True, True, "Floor", 304, 340, 335, 341, 1208
   Data 21, 2, True, True, "Ladder",304, 156, 335, 172, 1301
   Data 22, 2, True, True, "Ladder",304, 232, 335, 284, 1302
EndFunction

rem setup display
set display mode 640,480,16
sync on : sync rate 60

load_media()

rem declare global variables
global worldx
global worldy
global playerx
global playery
global leftmovevalue
global rightmovevalue
global xoffset
global yoffset
global playerup
global playerdown
global playerright
global playerleft

rem setup variables
worldx = 0
worldy = -65
playerx = 10
playery = 322
leftmovevalue = 1
rightmovevalue = 1
playerup = 0
playerdown = 0
playerright = 0
playerleft = 0

do

   cls

   movement()

   place_images()

   get_walls()

   show_walls()

   print_statistics()

   sync

loop


`----------------------------------------------------------------------------------------------------------------------------


function load_media()

   load image "gulv1.png",1,1
   load image "player.png",2,1
   load image "playercollision.png",3,1
   load bitmap "solid.png",1
   set current bitmap 0

endfunction

function place_images()

   rem background image
   sprite 1,worldx,worldy,1
   offset sprite 1,xoffset,yoffset

   rem player image
   sprite 2,playerx,playery,2

   sprite 3,playerx-18,playery,3
   set sprite 3,0,1

endfunction

function movement()

   if leftkey() = 1
      playerleft = 1
      playerright = 0
         else
      playerleft = 0
   endif

   if rightkey() = 1
      playerright = 1
      playerleft = 0
         else
      playerright = 0
   endif

   if playerleft = 1
         dec xoffset,1
         dec playerx,leftmovevalue
   endif

   if playerright = 1
         inc xoffset,1
         inc playerx,rightmovevalue
   endif

   if xoffset > 506 then xoffset = 506
   if xoffset < 0 then xoffset = 0
   if yoffset > -3 then yoffset = -3
   if yoffset < - 77 then yoffset = -77


   if playerright = 1 and xoffset => 506
      rightmovevalue = 2
         else
      rightmovevalue = 1
   endif

   if playerleft = 1 and xoffset = 0
      leftmovevalue = 2
         else
      leftmovevalue = 1
   endif

   if playerx =< 0 then playerx = 0
   if playerx >= 630 then playerx = 630

endfunction

function print_statistics()

   set cursor 5,50
   print "X offset: ", xoffset
   set cursor 5,60
   print "Y offset: ", yoffset
   set cursor 5,70
   print "FPS: ", Screen FPS()
   set cursor 5,80
   print "Player X: " , playerx
   set cursor 5,90
   print "Player Y: " , playery

endfunction

function get_walls()

   set current bitmap 1
   get image 1001,0,0,1,541
   get image 1002,1145,0,1146,541

endfunction

function show_walls()

   sprite 1001,0,-65,1001
   sprite 1002,1145,-65,1002

endfunction


`---------------------------------------------------------------------------------------------------------------------------

REM 2d pixel perfect collision function by Freddix

   Function FCT_Sprite_Pixel_Collision(_sprite1,_sprite2,_mode)
  _PIXEL=-1 : _CHECK=1
  _memblock1=1 : _memblock2=2
  Rem Check only if both sprites exists . . .
  if sprite exist(_sprite1)=1 and sprite exist(_sprite2)=1
    Rem Get Sprite #1 datas . . .
    xp1=sprite x(_sprite1) : yp1=sprite y(_sprite1)
    xs1=sprite width(_sprite1) : ys1=sprite height(_sprite1)
    Rem Get Sprite #2 datas . . .
    xp2=sprite x(_sprite2) : yp2=sprite y(_sprite2)
    xs2=sprite width(_sprite2) : ys2=sprite height(_sprite2)

set cursor 0,64
print xp1," ",yp1," ",xs1," ",ys1
print xp2," ",yp2," ",xs2," ",ys2

    Rem Now Collisions will be detected only if Sprite 1 and Sprite 2 are 1 overlaped
    if xp2>(xp1+xs1) or xp2<(xp1-xs2) then _CHECK=0
    if yp2>(yp1+ys1) or yp2<(yp1-ys2) then _CHECK=0
    Rem If sprites are overlaped then we make collision . ..
    if _CHECK=1
      Print "Calculate if collision exist . . ."
      _PIXEL=0
      Rem Create 2 memblock in order to read sprites datas . . .
      Make Memblock from image _memblock1,sprite image(_sprite1)
      Make Memblock from image _memblock2,sprite image(_sprite2)
      _dp1=memblock dword(_memblock1,8) : _pixsize1=_dp1/8
      _dp2=memblock dword(_memblock2,8) : _pixsize2=_dp2/8
      Rem We check for the box to read in both sprites . . .
      if xp2>xp1
        xstart1=xp2-xp1 : xstart2=0 : xchecksize=xs1-xstart1
       else
        xstart2=xp1-xp2 : xstart1=0 : xchecksize=xs2-xstart2
       endif
      if yp2>yp1
        ystart1=yp2-yp1 : ystart2=0 : ychecksize=ys1-ystart1
       else
        ystart2=yp1-yp2 : ystart1=0 : ychecksize=ys2-ystart2
       endif
      Rem Now we make a loop to check all pixels . . .
      for yloop=0 to ychecksize
        for xloop=0 to xchecksize
          _pix1=0 : _pix2=0
          xpos=xloop+xstart1 : ypos=yloop+ystart1
          if xpos>-1 and xpos<xs1
            if ypos>-1 and ypos<ys1
              _Adress=12+(ypos*xs1*_pixsize1)+(xpos*_pixsize1)
              if _Adress>-1 and _Adress<(get memblock size(_memblock1)-_pixsize1)
                if _dp1=16 then _pix1=memblock word(_memblock1,_Adress)
                if _dp1=32 then _pix1=memblock dword(_memblock1,_Adress)
               endif
             Endif
           Endif
          xpos=xloop+xstart2 : ypos=yloop+ystart2
          if xpos>-1 and xpos<xs2
            if ypos>-1 and ypos<ys2
              _Adress=12+(ypos*xs2*_pixsize2)+(xpos*_pixsize2)
              if _Adress>-1 and _Adress<(get memblock size(_memblock2)-_pixsize2)
                if _dp2=16 then _pix2=memblock word(_memblock2,_Adress)
                if _dp2=32 then _pix2=memblock dword(_memblock2,_Adress)
               endif
             Endif
           Endif

          if _pix1<>0 and _pix2<>0 then _PIXEL=_PIXEL+1
          if _PIXEL>0 and _MODE=0
            xloop=xchecksize : yloop=ychecksize
           Endif
         next xloop
       next yloop
      Delete memblock _memblock1
      Delete memblock _memblock2
     Endif
   Endif
 EndFunction _PIXEL
Rem