extra/rosetta-code/active-object/active-object.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar kernel math math.constants
   4 math.functions prettyprint system threads timers ;
   5 IN: rosetta-code.active-object
   6
   7 ! http://rosettacode.org/wiki/Active_object
   8
   9 ! In object-oriented programming an object is active when its
  10 ! state depends on clock. Usually an active object encapsulates a
  11 ! task that updates the object's state. To the outer world the
  12 ! object looks like a normal object with methods that can be
  13 ! called from outside. Implementation of such methods must have a
  14 ! certain synchronization mechanism with the encapsulated task in
  15 ! order to prevent object's state corruption.
  16
  17 ! A typical instance of an active object is an animation widget.
  18 ! The widget state changes with the time, while as an object it
  19 ! has all properties of a normal widget.
  20
  21 ! The task
  22
  23 ! Implement an active integrator object. The object has an input
  24 ! and output. The input can be set using the method Input. The
  25 ! input is a function of time. The output can be queried using the
  26 ! method Output. The object integrates its input over the time and
  27 ! the result becomes the object's output. So if the input is K(t)
  28 ! and the output is S, the object state S is changed to S + (K(t1)
  29 ! + K(t0)) * (t1 - t0) / 2, i.e. it integrates K using the trapeze
  30 ! method. Initially K is constant 0 and S is 0.
  31
  32 ! In order to test the object:
  33 ! * set its input to sin (2π f t), where the frequency f=0.5Hz.
  34 !   The phase is irrelevant.
  35 ! * wait 2s
  36 ! * set the input to constant 0
  37 ! * wait 0.5s
  38
  39 ! Verify that now the object's output is approximately 0 (the
  40 ! sine has the period of 2s). The accuracy of the result will
  41 ! depend on the OS scheduler time slicing and the accuracy of the
  42 ! clock.
  43
  44 TUPLE: active-object timer function state previous-time ;
  45
  46 : apply-stack-effect ( quot -- quot' )
  47     [ call( x -- x ) ] curry ; inline
  48
  49 : nano-to-seconds ( -- seconds ) nano-count 9 10^ / ;
  50
  51 : object-times ( active-object -- t1 t2 )
  52     [ previous-time>> ]
  53     [ nano-to-seconds [ >>previous-time drop ] keep ] bi ;
  54
  55 :: adding-function ( t1 t2 active-object -- function )
  56     t2 t1 active-object function>> apply-stack-effect bi@ +
  57     t2 t1 - * 2 / [ + ] curry ;
  58
  59 : integrate ( active-object -- )
  60     [ object-times ]
  61     [ adding-function ]
  62     [ swap apply-stack-effect change-state drop ] tri ;
  63
  64 : <active-object> ( -- object )
  65     active-object new
  66     0 >>state
  67     nano-to-seconds >>previous-time
  68     [ drop 0 ] >>function
  69     dup [ integrate ] curry 1 nanoseconds every >>timer ;
  70
  71 : destroy ( active-object -- ) timer>> stop-timer ;
  72
  73 : input ( object quot -- object ) >>function ;
  74
  75 : output ( object -- val ) state>> ;
  76
  77 : active-test ( -- )
  78     <active-object>
  79     [ 2 pi 0.5 * * * sin ] input
  80     2 seconds sleep
  81     [ drop 0 ] input
  82     0.5 seconds sleep
  83     [ output . ] [ destroy ] bi ;
  84
  85 MAIN: active-test