1 ! Copyright (c) 2012 Anonymous
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays calendar colors.constants kernel
4 locals math math.constants math.functions math.rectangles
5 math.vectors opengl sequences system timers ui ui.gadgets ui.render ;
6 IN: rosetta-code.animate-pendulum
8 ! http://rosettacode.org/wiki/Animate_a_pendulum
10 ! One good way of making an animation is by simulating a
11 ! physical system and illustrating the variables in that system
12 ! using a dynamically changing graphical display. The classic such
13 ! physical system is a simple gravity pendulum.
15 ! For this task, create a simple physical model of a pendulum
22 : current-time ( -- time ) nano-count -9 10^ * ;
24 : T0 ( -- T0 ) 2 pi l g / sqrt * * ;
25 : omega0 ( -- omega0 ) 2 pi * T0 / ;
26 : theta ( -- theta ) current-time omega0 * cos theta0 * ;
28 : relative-xy ( theta l -- xy )
29 [ [ sin ] [ cos ] bi ]
30 [ [ * ] curry ] bi* bi@ 2array ;
31 : theta-to-xy ( origin theta l -- xy ) relative-xy v+ ;
33 TUPLE: pendulum-gadget < gadget alarm ;
35 : O ( gadget -- origin ) rect-bounds [ drop ] [ first 2 / ] bi* 0 2array ;
36 : window-l ( gadget -- l ) rect-bounds [ drop ] [ second ] bi* ;
37 : gadget-xy ( gadget -- xy ) [ O ] [ drop theta ] [ window-l ] tri theta-to-xy ;
39 M: pendulum-gadget draw-gadget*
41 [ O ] [ gadget-xy ] bi gl-line ;
43 M: pendulum-gadget graft* ( gadget -- )
46 dup [ relayout-1 ] curry
47 20 milliseconds every >>alarm drop
50 M: pendulum-gadget ungraft*
51 [ alarm>> stop-timer ] [ call-next-method ] bi ;
53 : <pendulum-gadget> ( -- gadget )
55 { 500 500 } >>pref-dim ;
57 : pendulum-main ( -- )
58 [ <pendulum-gadget> "pendulum" open-window ] with-ui ;