14.03.2012, 22:21
|
#232
|
Бывалый
Регистрация: 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)
|
|