http://forums.purebasic.com/english/vie ... hp?t=20028
Vraiment sympa la démo
Code : Tout sélectionner
; Exercise 7
; Animation of a two link planar arm with rotary joints
; Copyright © 2006 Serge Visser en Jos de Jong
; Written with the programming language PureBasic
; create program constants
; window and gadget constants
#winmain = 1
#winpaint = 2
#timerID = 3
#start = 4
#t1_scroll = 5
#t2_scroll = 6
#t1_text = 7
#t2_text = 8
; fonts and other constants
#font_Verdana = 10
#font_Verdana_big = 11
#refreshinterval = 50 ;millisecs
#scroll_max = 40
; animating states:
#FollowBorder = 1
#GoToStartpoint = 2
#Finished = 3
;(#False is the initial state for animating)
; create global variables and declare functions
Declare CreateAnimation()
Declare UpdateScrollBar()
Global x0.f, y0.f
Global x1.f, y1.f
Global x2.f, y2.f
Global L1.f, L2.f
Global theta1.f, theta2.f ;angle of the links
Global theta1_ref.f, theta2_ref.f ;position of the scrollbars
Global pi.f
Global delta.f
Global animT12
Global animXY
Global animcount
Global animpos
Global animating
Dim animT12.f(1000,1)
Dim animXY.f(1000,1)
; set initial values for the variables
pi = 4*ATan(1)
x0 = 300
y0 = 300
L1 = 150
L2 = L1/2
theta1 = 0.2*pi
theta2 = 0.25*pi
theta1_ref = theta1
theta2_ref = theta2
delta = 0.02*pi
animating = #False
; create some colors used for the graphics
Global black :black = RGB(0,0,0)
Global red :red = RGB(255,0,0)
Global white :white = RGB(255,255,255)
Global brown :brown = RGB(128,64,0)
Global pink :pink = RGB(255,128,192)
Global purple :purple = RGB(128,0,128)
Global green :green = RGB(0,255,0)
Global darkgreen :darkgreen = RGB(0,128,0)
Procedure CreateWindow()
; create the mainwindow with gadgets and 2D directX window
OpenWindow(#winmain, 100, 100, 600, 500, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget, "Two-link Animation")
CreateGadgetList(WindowID())
ButtonGadget(#start,10,10, 120,35, "&Start Animation")
; create a scrollbar for theta1
TextGadget(#t1_text, 160, 5, 150, 20, "Theta1")
ScrollBarGadget(#t1_scroll, 160, 25,150, 20, 0, #scroll_max, 1)
SetGadgetState(#t1_scroll, Int(#scroll_max * theta1/pi))
; create a scrollbar for theta2
TextGadget(#t2_text, 320, 5, 150, 20, "Theta2")
ScrollBarGadget(#t2_scroll, 320, 25,150, 20, 0, #scroll_max, 1)
SetGadgetState(#t2_scroll, Int(#scroll_max * (theta2+0.5*pi)/(1.5*pi)))
; create a directX screen in the main window
If InitSprite()=0
MessageRequester("Error","Can't open DirectX",0)
End ;stop the program
EndIf
OpenWindowedScreen(WindowID(), 0, 55, 600, 445, 0, 0, 0)
CreateAnimation()
LoadFont(#font_Verdana, "Verdana", 10, 0)
LoadFont(#font_Verdana_big, "Verdana", 13, #PB_Font_Bold)
; clear the screen
ClearScreen(255,255,255)
EndProcedure
Procedure CreateAnimation()
; create the data needed to do the animation.
; the positions for the arm are saved in a matrix with two columns:
; first column contains theta1 for each moment,
; second column contains theta2 for each moment
t1.f = 0
t2.f = 0.5*pi
animcount=0
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t2 = t2+delta
Until t2 >= 1*Pi
t2 = pi
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t1 = t1+delta
Until t1 >= 1*Pi
t1 = pi
t2 = pi
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t2 = t2-delta
Until t2 <=0
t1=pi
t2=0
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t1 = t1-delta
Until t1 <=0
t1=0
t2=0
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t2 = t2-delta
Until t2 <= -0.5*pi
t1=0
t2=-0.5*pi
Repeat
animcount = animcount + 1
animT12(animcount, 0) = t1
animT12(animcount, 1) = t2
animXY(animcount,0) = x0 + L1*Cos(-t1) + L2*Cos(-t1-t2)
animXY(animcount,1) = y0 + L1*Sin(-t1) + L2*Sin(-t1-t2)
t1 = t1+delta
Until t1 >= 0.32*pi
EndProcedure
Procedure PlayAnimation()
; play the stored animation
animpos = 0
animating = #GoToStartpoint
animfinished = #False
theta1_ref = animT12(animpos+1,0)
theta2_ref = animT12(animpos+1,1)
; disable the scrollbars
DisableGadget(#t1_scroll, 1)
DisableGadget(#t2_scroll, 1)
DisableGadget(#t1_text, 1)
DisableGadget(#t2_text, 1)
EndProcedure
Procedure StopAnimation()
; stop the animation
animating = #Finished
; enable the scrollbars
DisableGadget(#t1_scroll, 0)
DisableGadget(#t2_scroll, 0)
DisableGadget(#t1_text, 0)
DisableGadget(#t2_text, 0)
EndProcedure
Procedure PaintLink(x.f, y.f, theta.f, length.f)
; paint a link with a joint using primitive graphics (yes thats fun! :)
#armwidth = 5
#jointradius = 8
#jointradiusinner = 5
bottom1x.f = x+#armwidth*Cos(theta+0.5*Pi)
bottom1y.f = y+#armwidth*Sin(theta+0.5*Pi)
bottom2x.f = x+#armwidth*Cos(theta-0.5*Pi)
bottom2y.f = y+#armwidth*Sin(theta-0.5*Pi)
top1x.f = bottom1x.f + length*Cos(theta)
top1y.f = bottom1y.f + length*Sin(theta)
top2x.f = bottom2x.f + length*Cos(theta)
top2y.f = bottom2y.f + length*Sin(theta)
LineXY(x, y, x+length*Cos(theta), y+length*Sin(theta), black)
Circle(x, y, #jointradius, black)
Circle(x, y, #jointradius-1, white)
Circle(x, y, #jointradiusinner, black)
EndProcedure
Procedure Paint2Link()
; paint the arm on the screen
; paint the base of the arm
w0 = 100
h0 = 50
r = 5
border = 3
FrontColor(0,0,0)
Box(x0-0.5*w0, y0, w0, h0, black)
Box(x0-0.5*w0+border, y0+border, w0-2*border, h0-2*border, red)
; paint the first link and the base joint
PaintLink(x0, y0, -theta1, L1)
; paint the second link
x1 = x0 + L1*Cos(-theta1)
y1 = y0 + L1*Sin(-theta1)
PaintLink(x1, y1, -theta1-theta2, L2)
; paint a joint on the end
x2 = x1 + L2*Cos(-theta1-theta2)
y2 = y1 + L2*Sin(-theta1-theta2)
PaintLink(x2, y2, -theta1-theta2, 0)
EndProcedure
Procedure PaintWorkarea()
; paint the workarea reached so far during the animation
posmax = animpos
If posmax>animcount :posmax = animcount :EndIf
If animating=#Finished :posmax = animcount :EndIf
;paint the border of the workarea
For pos = 2 To posmax
LineXY(animXY(pos-1,0),animXY(pos-1,1), animXY(pos,0),animXY(pos,1), darkgreen)
Next
If animating=#Finished
; after the last animation, fill up the workarea
FillArea(x0, y0-L1, darkgreen, green)
EndIf
EndProcedure
Procedure PaintText()
;paint some text in the window
FrontColor(0,0,0) ;black
DrawingFont(UseFont(#font_Verdana_big))
Locate(10,10)
DrawText("Exercise 7 - Reachable workspace for a two-link planar arm")
FrontColor(92,92,92) ;dark gray
DrawingFont(UseFont(#font_Verdana))
Locate(10,420)
DrawText("Copyright © 2006 Serge Visser en Jos de Jong")
EndProcedure
Procedure UpdateScrollvariables()
pos.f
;update theta1
pos = GetGadgetState(#t1_scroll)
pos = pos/#scroll_max * Pi
theta1_ref = pos
SetGadgetText(#t1_text, "Theta1 = "+StrF(theta1_ref/pi,2) + " * Pi")
;update theta2
pos = GetGadgetState(#t2_scroll)
pos = pos/#scroll_max * (1.5*Pi) - 0.5*Pi
theta2_ref = pos
SetGadgetText(#t2_text, "Theta2 = "+StrF(theta2_ref/pi,2) + " * Pi")
EndProcedure
Procedure UpdateScrollBar()
; update the scrollbar positions with given theta1_ref and theta2_ref
;update theta1
theta1_ref = theta1
SetGadgetState(#t1_scroll, Int(#scroll_max * theta1_ref/pi))
;update theta2
theta2_ref = theta2
SetGadgetState(#t2_scroll, Int(#scroll_max * (theta2_ref+0.5*pi)/(1.5*pi)))
EndProcedure
; Create the window
CreateWindow()
UpdateScrollvariables()
SetTimer_(WindowID(), #timerID, #refreshinterval, 0) ; start a timer
;-Eventhandler
;{
Repeat
WhichEvent = WaitWindowEvent() ;Wait for an Event
WhichWindow = EventWindowID() ;Number of Window which fires the event
WhichGadget = EventGadgetID() ;Is an Gadget used ?
WhichEventType = EventType() ;The event type
If WhichWindow = #winmain
Select WhichEvent
Case #PB_EventGadget
Select WhichGadget
Case #start
; if user pressed the button "start animation" then start the animation
PlayAnimation()
Case #t1_scroll
UpdateScrollvariables()
Case #t2_scroll
UpdateScrollvariables()
EndSelect
Case #PB_Event_CloseWindow
; quit the program
KillTimer_(WindowID(), #timerID)
End
Case #WM_TIMER
; timer routine
Select EventwParam()
Case #timerID
If animating = #FollowBorder
; go to the next animation position.
; stop the animation if the end is reached
animpos = animpos + 1
If animpos<=animcount
; get new positions for theta1 and theta2
theta1 = animT12(animpos,0)
theta2 = animT12(animpos,1)
Else
; stop the animation if the end of the data is reached
StopAnimation()
UpdateScrollBar()
EndIf
EndIf
If animating = #False Or animating = #GoToStartpoint Or animating = #Finished
;update position for link1
If theta1_ref<>theta1
theta1 = theta1 + delta * Abs(theta1_ref-theta1)/(theta1_ref-theta1)
If Abs(theta1_ref-theta1) < delta
theta1 = theta1_ref
EndIf
EndIf
;update position for link2
If theta2_ref<>theta2
theta2 = theta2 + delta * Abs(theta2_ref-theta2)/(theta2_ref-theta2)
If Abs(theta2_ref-theta2) < delta
theta2 = theta2_ref
EndIf
EndIf
EndIf
If animating = #GoToStartpoint
If theta1_ref=theta1 And theta2_ref=theta2
;startpoint for the animation is reached.
animating = #FollowBorder
EndIf
EndIf
; repaint the arm
ClearScreen(255,255,255) ;empty the paint window
If StartDrawing(ScreenOutput())
PaintText()
If animating=#FollowBorder Or animating=#Finished
PaintWorkarea() ;paint the workarea
EndIf
Paint2Link()
StopDrawing()
EndIf
FlipBuffers()
EndSelect
EndSelect
EndIf
ForEver
;}
