Strict

Graphics 640,480,0,75

'spieler
Global playerx=320 'x/y = punkt links oben
Global playery=440
Global playersize=20

'tilemap
Global tilesize=40
Global map[16,12]

'tilemapdaten
#map
DefData 0,0,0,0,0,0,0,0,0,0,4,5,0,0,4,1
DefData 0,1,1,0,0,0,1,1,0,0,0,0,0,0,0,4
DefData 0,1,1,0,0,1,0,0,1,0,0,0,2,1,3,0
DefData 0,0,0,0,0,1,0,0,1,0,0,0,1,0,1,0
DefData 0,0,0,0,0,0,1,1,0,0,0,0,4,1,5,2
DefData 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
DefData 1,3,0,0,0,0,2,3,0,0,5,4,0,0,0,0
DefData 1,5,0,0,0,0,4,5,0,0,3,2,0,0,1,0
DefData 5,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DefData 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DefData 0,2,0,0,3,0,0,0,0,0,0,4,0,0,5,0
DefData 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

'tilemap einlesen
RestoreData map
For Local j=0 To 11
   For Local i=0 To 15
      ReadData map[i,j]
   Next
Next

'test
Global ms1,ms2

'hauptschleife
Repeat
      ms1=MilliSecs()
   
   f_player()
   f_drawmap()
   
      ms2=MilliSecs()-ms1
      DrawText ms2,10,10
   
   Flip
   Cls
Until KeyHit(key_escape) Or AppTerminate()

'spieler
Function f_player()
   'steuerung
   playerx=MouseX()-playersize
   playery=MouseY()-playersize
   
   If MouseDown(1) And playersize<100 playersize:+1
   If MouseDown(2) And playersize>10 playersize:-1
   
   'kollisionsabfrage
   For Local j=0 To 11
      For Local i=0 To 15
         If map[i,j]>0
            If f_collision(playerx,playery,playersize,i*tilesize,j*tilesize,tilesize,map[i,j]) SetColor 255,0,0
         EndIf
      Next
   Next
   
   'anzeigen
   DrawRect playerx,playery,playersize,playersize
   SetColor 0,255,0
End Function

'tilemap anzeigen
Function f_drawmap()
   For Local j=0 To 11
      For Local i=0 To 15
         If map[i,j]=1 f_rect(i*tilesize,j*tilesize,tilesize)
         If map[i,j]=2 f_tri1(i*tilesize,j*tilesize,tilesize)
         If map[i,j]=3 f_tri2(i*tilesize,j*tilesize,tilesize)
         If map[i,j]=4 f_tri3(i*tilesize,j*tilesize,tilesize)
         If map[i,j]=5 f_tri4(i*tilesize,j*tilesize,tilesize)
      Next
   Next
End Function

'kollisionsfunktion
Function f_collision(x1,y1,s1,x2,y2,s2,tile)
   'quadrat
   If x1>x2+s2 Return
   If x1+s1<x2 Return
   If y1>y2+s2 Return
   If y1+s1<y2 Return
   
   'dreieck
   If tile=2
      If Abs(x2-(x1+s1)) + Abs(y2-(y1+s1)) < tilesize Return
   EndIf
   
   If tile=3
      If Abs((x2+s2)-x1) + Abs(y2-(y1+s1)) < tilesize Return
   EndIf
   
   If tile=4
      If Abs(x2-(x1+s1)) + Abs((y2+s2)-y1) < tilesize Return
   EndIf
   
   If tile=5
      If Abs((x2+s2)-x1) + Abs((y2+s2)-y1) < tilesize Return
   EndIf
   
   Return 1
End Function

'tiles
Function f_rect(x,y,size)
   DrawLine x,y,x+size,y               '0000     1
   DrawLine x,y+size,x+size,y+size         '0000
   DrawLine x,y,x,y+size               '0000
   DrawLine x+size,y,x+size,y+size         '0000
End Function

Function f_tri1(x,y,size)               '   0     2
   DrawLine x+size,y+size,x+size,y         '  00
   DrawLine x+size,y+size,x,y+size         ' 000
   DrawLine x+size,y,x,y+size            '0000
End Function

Function f_tri2(x,y,size)               '0        3
   DrawLine x,y,x,y+size               '00
   DrawLine x,y+size,x+size,y+size         '000
   DrawLine x,y,x+size,y+size            '0000
End Function

Function f_tri3(x,y,size)               '0000     4
   DrawLine x,y,x+size,y               ' 000
   DrawLine x+size,y,x+size,y+size         '  00
   DrawLine x,y,x+size,y+size            '   0
End Function

Function f_tri4(x,y,size)               '0000     5
   DrawLine x,y,x+size,y               '000
   DrawLine x,y,x,y+size               '00
   DrawLine x,y+size,x+size,y            '0
End Function