Тема: Vivo
Показать сообщение отдельно
Старый 14.03.2012, 22:21   #232
Nikich
Бывалый
 
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений
(для 275 пользователей)
Ответ: Vivo

А вот и код:

Global rc=CountGfxModes()
Global R1=GfxModeWidth(rc)
Global R2=GfxModeHeight(rc)


Graphics R1,R2
Global fnt1=LoadFont("Arial",24)
SetFont fnt1
SetBuffer BackBuffer()
Dim TileImg(50)
TileImg(0)=LoadImage("ground.bmp")
TileImg(1)=LoadImage("grass.bmp")
Global cx#,cy#,plx#,ply#,tdst,tfps,fps
Global lfps=60
Type tl
Field x,y,z,id
End Type
For i=0 To 1
MaskImage TileImg(i),255,255,255
MidHandle TileImg(i)
Next
Global pl=LoadImage("pl.bmp")
MaskImage pl,255,255,255
MidHandle pl

CreateWorld()


Function CreateWorld()
For i=-50 To 50
For j=-50 To 50
t.tl=New tl
t\x=R1/2+(i-j)*32
t\y=R2/2+(i+j)*16
t\id=Rnd(0,1)
Next
Next
End Function

Function UpdateTiles()
For t.tl=Each tl
tdst=Sqr((t\x-plx)^2+(t\y-ply)^2)
If tdst<Sqr((R1/2)^2+(R2/2)^2)+32 Then
DrawImage TileImg(t\id),t\x,t\y
EndIf
Next
End Function

Function UpdatePlayer()
If KeyDown(17) Then
cy=cy+2.5/lfps*60
EndIf
If KeyDown(31) Then
cy=cy-2.5/lfps*60
EndIf
If KeyDown(30) Then
cx=cx+5/lfps*60
EndIf
If KeyDown(32) Then
cx=cx-5/lfps*60
EndIf
Origin cx,cy
plx=640-cx
ply=512-cy
DrawImage pl,plx,ply
End Function

Function UpdateFPS()
If MilliSecs()-tfps<1000 fps=fps+1
If MilliSecs()-tfps>1000 Then
lfps=fps
tfps=MilliSecs()
fps=0
EndIf
Color 0,0,0
Text -cx,-cy,lfps
End Function

While Not KeyHit(1)


UpdateTiles()
UpdateFPS()
UpdatePlayer()


Flip
Cls
Wend

Напомню, проблема в том, что при создании больше 9000 тайлов начинаются лаги, хотя они даже не рисуются, так что непонятно и почему так происходит.
(Offline)
 
Ответить с цитированием