PDA

View Full Version : Collision Test



peter
16-10-2012, 13:42
Hi,

A little bit collision.


Uses "ui"


DWord hdc,hwin
hwin=Canvas_Window("Collision Test",1,1,640,480)
Canvas_Attach(hwin,0,%TRUE)
Canvas_Font("georgia",18,%CANVAS_FONTSTYLE_BOLD)


Single px1,py1,px2,py2
py1=200:px2=640:py2=200

While IsWindow(hwin)
Canvas_Clear(0)


Canvas_Circle(px1,py1,20,1,Rgb(255,0,0))
Triangle(px2,py2-40,60,80,0,255,0)


If Collision(px1,py1,px2,py2,30,30)=1 Then
SetText(240,16,"BUMMS!",Rgb(255,255,255),0)
End If


px1 +=1: If px1 >=640 Then px1= -32
px2 -=1: If px2 <=-64 Then px2= 660


Canvas_Redraw
If GetAsyncKeyState(27) Then Exit While
Wend
Canvas_Window End


Sub SetText(x,y As Long, txt As String, xkol,ykol As Long)
Canvas_Color(xkol,ykol)
Canvas_SetPos(x,y)
Canvas_Print(txt)
End Sub

Function Collision(x1,y1,x2,y2,r1,r2 As Single) As Long
If Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) < r1+r2 Then
Return 1
End If
End Function


Sub Triangle(x1,y1,x2,y2,r,g,b As Long)
Canvas_Line( (x1,y1),(x1+x2,y1+y2),Rgb(r,g,b) )
Canvas_Line( (x1,y1),(x1-x2,y1+y2),Rgb(r,g,b) )
Canvas_Line( (x1-x2,y1+y2),(x1+x2,y1+y2),Rgb(r,g,b) )
End Sub

peter
16-10-2012, 14:01
And here is a mouse-click test.


Uses "ui"


DWord hdc,hwin,hwnd
hwin=Canvas_Window("Mouse",1,1,320,240)
Canvas_Attach(hwin,0,%TRUE)
Canvas_Font("georgia",14,%CANVAS_FONTSTYLE_BOLD)


Long mx,my,x,y,c,clicMe,xMouse,yMouse


While IsWindow(hwin)
Canvas_Clear(Rgb(0,0,205))


SetText(0, 0,"Button " & clicMe,Rgb(255,255,255),Rgb(0,0,205))
SetText(0,22,"xMouse " & xMouse,Rgb(255,255, 22),Rgb(0,0,205))
SetText(0,44,"yMouse " & yMouse,Rgb(255,205, 44),Rgb(0,0,205))


For my=1 To 240 Step 16
For mx=1 To 320 Step 16
Canvas_Box(mx,my,16,16,0,Rgb(25,205,25))
Next
Next

c= Canvas_Window Click hwin To X, Y
If c >0 Then clicMe=c
If x >0 Then xMouse=x/16
If y >0 Then yMouse=y/16


Canvas_Redraw
If GetAsyncKeyState(27) Then Exit While
Sleep 10
Wend
Canvas_Window End


Sub SetText(x,y As Long, txt As String, xkol,ykol As Long)
Canvas_Color(xkol,ykol)
Canvas_SetPos(x,y)
Canvas_Print(txt)
End Sub