[mr.DIMAS]

Graphics3D 1024,768,32,2 
SetBuffer BackBuffer() 
CreateWorld() 
Global movepiv 
Global centpiv 
Global campiv 
Global camera 
Global mic 
Global speed# 
Global deltaT 
Global userTime 
Global newTime 
Global wLog 
Global f_key=17 
Global b_key=31 
Global l_key=30 
Global r_key=32 
Global CubSelect = 0
Global Ramkax1, Ramkay1,Ramkax2, Ramkay2 
Global pick,cub 
Global ox#,oy#,cx#,cy#,tx#,ty# 
Const  playertype=1,poltype=2 
CreatePlayer(0,3,0) 
cub=CreateCube() 
ScaleEntity cub,2,4,2 
;CameraProject(camera,EntityX(cub),EntityY(cub),EntityZ(cub))  
 
Repeat  
 If MouseX()<5 Then TranslateEntity camera,-0.5,0,0 
 If MouseX()>1000 Then TranslateEntity camera,0.5,0,0 
 If MouseY()<5 Then TranslateEntity camera,0,0,0.5 
 If MouseY()>766 Then TranslateEntity camera,0,0,-0.5  
 
 
 dvigok() 
 
 PositionEntity cub,EntityX#(movepiv,1),EntityY#(movepiv,1),EntityZ#(movepiv,1) 
 RotateEntity cub,0,EntityYaw(movepiv,1),0 
 
        ;mouselook(camera)                
 UpdateWorld() 
 RenderWorld() 
 Ramka()   
 If sel=1 Then  
        If MouseHit(2) Then  
            PositionEntity centpiv,PickedX#(),PickedY#()+2,PickedZ#()   
        EndIf       
 EndIf 
 
 Flip() 
 
Until KeyHit(1)=1 
End 
Function CreateWorld() 
 wtex=CreateTexture(256,256) 
 SetBuffer TextureBuffer(wtex) 
 Color 10,100,10 
 Rect  15,15,226,226 
 SetBuffer BackBuffer() 
 ScaleTexture wtex,10,10 
 plane=CreatePlane() 
 EntityTexture plane,wtex 
 EntityType plane,poltype 
 EntityPickMode plane,2,1 
 FreeTexture wtex 
End Function 
Function CreatePlayer(x#=0,y#=0,z#=0) 
 movepiv=CreatePivot()  
 PositionEntity movepiv,x#,y#+4,z#  
 EntityRadius movepiv,3,4.5  
 EntityType movepiv,playertype  
 centpiv=CreatePivot()  
 PositionEntity centpiv,x#+4,y#+2,z#+4   
 camera=CreateCamera()  
 PositionEntity camera,0,100,-70  
 TurnEntity camera,45,0,0,1  
 CameraClsColor camera,10,10,150  
 mic=CreateListener(camera,0.05,0.05,0.08)  
 Collisions playertype,poltype,2,3  
End Function 
Function dvigok() 
        ;PositionEntity campiv,EntityX#(movepiv,1),EntityY#(movepiv,1),EntityZ#(movepiv,1)  
 If KeyHit(60) Then wLog=Not wLog WireFrame wLog  
 If userTime=0 userTime=MilliSecs()  
        newTime=MilliSecs()   
        deltaT=newTime-userTime  
        userTime=newTime  
        speed#=0.04*deltaT 
 
        If KeyDown(f_key) Then  
   TranslateEntity camera,0,0,speed#  
        Else  
   If KeyDown(b_key) Then TranslateEntity camera,0,0,-speed# 
        EndIf  
        If KeyDown(l_key) Then  
   TranslateEntity camera,-speed#,0,0  
        Else 
   If KeyDown(r_key) Then TranslateEntity camera,speed#,0,0  
        EndIf 
 
 
        pick=CameraPick(camera,MouseX(),MouseY())  
 
  If CubSelect = 1 Then 
   If MouseHit(2)=1 Then  
    PositionEntity centpiv,PickedX#(),PickedY#()+2,PickedZ#()   
   EndIf  
  End If 
 
        If EntityDistance(movepiv,centpiv)>3 Then  
   PointEntity movepiv,centpiv  
   MoveEntity movepiv,0,0,1  
        EndIf  
        TranslateEntity movepiv,0,-1,0  
 
End Function 
Function Ramka()  
    If MouseDown(1) 
        cx#=MouseX() 
        cy#=MouseY() 
 
        If ox>cx Then minx=cx:maxx=ox Else minx=ox:maxx=cx 
        If oy>cy Then miny=cy:maxy=oy Else miny=oy:maxy=cy 
 
        Rect minx,miny,maxx-minx,maxy-miny,0 
 
  CameraProject(camera,EntityX(cub),EntityY(cub),EntityZ(cub)) 
 
  If ProjectedX()>minx And ProjectedX()<maxx And ProjectedY()>miny And ProjectedY()<maxy Then 
   Sel = Not sel
   CubSelect = 1
  End If 
 
  If sel=1 Then  
   EntityColor cub,255,255,0 
  Else 
   EntityColor cub,0,0,0 
   CubSelect = 0
  EndIf  
 
 Else 
        ox#=MouseX() 
        oy#=MouseY() 
    EndIf 
 
 Oval MouseX()-3,MouseY()-3,5,5,0        
End Function 


робит

зы. код чрезвычайно убог