\ banalyzer \ \ class of device that has some basic analysis functions. Originally \ designed for use for the piece "io" to acquire short term information \ on the behavior of the input. \ \ when the banalyzer recieves an ELEMENT.ON: message, it analyzes the data \ value from the shape (contained in the dimension specified by the \ PUT.DIM: method). The user can modify this bahavior by providing an \ interpreter via the PUT.ON.FUNCTION: method, and calling the ON: method \ from the interpreter. \ \ the ELEMENT.OFF: method defaults to doing nothing, but the user may \ provide an interpreter to modify this behavior. \ \ if the analysis returns a "significant" event, the ALERT: method is \ called. If a recipient object has been assigned (via the PUT.ALERT.OBJECT: \ or PUT.INSTRUMENT: method), then an ELEMENT.ON: message will be sent to \ that object. A user specified function exists (assigned via the \ PUT.ALERT.FUNCTION: method) this overrides the behavior of the ALERT: \ message. The user specified functions should be in the following form: \ \ alert.func ( data addr -- ) \ \ Where the address ("addr") is the address of the banalyzer. \ \ \ methods: \ \ ON: ( n -- , add values to buffer ) \ OFF: ( n -- , this isn't automatically called by ELEMENT.OFF: ) \ \ ALERT: ( -- , execute user cfa or call raw.alert: ) \ RAW.ALERT: ( -- , send element.on: to recipient object ) \ \ PUT.ALERT.FUNCTION: ( cfa -- , word executed when ALERT: is called ) \ PUT.ALERT.OBJ: ( addr -- , object to which the ELEMENT.ON: is sent ) \ \ PUT.DIM: ( dim# -- , dimension to be analyzed ) \ \ GET.AVERAGE: ( -- ave , returns average value ) \ GET.DEVIATION: ( -- dev , deviation from average ) \ \ DELTA.ON: ( -- , use difference of consecutive values ) \ DELTA.OFF: ( -- , use straight input values ) \ \ ABS.ON: ( -- , ignore polarity of input ) \ ABS.OFF: ( -- , keep input polarity intact ) \ \ RESET.MASKS: ( -- , reset low and high masks ) \ PUT.LOW.MASK: ( n -- ) \ PUT.HIGH.MASK: ( n -- ) \ \ RESET.TOLERANCE: ( -- ) \ PUT.TOLERANCE: ( n -- , point at which an ALERT: method is called ) \ GET.TOLERANCE: ( -- n ) \ \ \ Code: Han-earl Park \ Copyright 2000 Buster & Friends C-ALTO Labs \ (Den Haag, October 1997 - \ (Valencia, March 1999 - \ (Southampton, October 2000 - \ \ MOD: HeP 10/12/97 Started latest implementation. \ MOD: HeP 02/04/98 Removed average of deviation. \ MOD: HeP 03/09/98 "General purpose" version for use outside the piece "io". \ MOD: HeP 03/19/98 Added the user specified input function. \ Use exec.stack? instead of ?execute with all functions. \ MOD: HeP 03/23/98 Adding "delta" and "absolute" modes for input processing. \ Change user input function stack diagram from \ (data -- data flag) to (data addr -- data flag). \ MOD: HeP 03/26/98 Added PUT.DATA: and GET.DATA: methods. \ MOD: HeP 03/05/99 Reviving code for use with current projects. \ Get rid of the alert "ident". \ MOD: HeP 10/01/99 Trash put.data: and get.data: \ Change spelling from "banalyser" to "banalyzer" \ MOD: HeP 11/15/99 Subclass of ob.device, not of ob.array. \ MOD: HeP 01/25/00 Started reimplementing class to conform to the device \ class specification. \ The input.function is replaced by the device class's \ on and off functions. \ Update comments to reflect current design. \ MOD: HeP 01/26/00 The ALERT: message replaces the forth word BAN.DO.ALERT \ MOD: HeP 01/27/00 Recipient object now recieves ELEMENT.ON: with the \ current element# and the address of the analyzed \ (i.e. input) shape. \ MOD: HeP 03/18/00 Replace the messy conditionals used to increment the \ internal pointers with a simple mod operation. \ Remove the redundant iv-blyzr-first? variable. \ MOD: HeP 03/20/00 Change name of ADD: methods to ON: and add an OFF: stub. \ Check if object is opened in the ON: method. \ MOD: HeP 04/05/00 Remove erronious use of the on function as a input filter \ function! \ MOD: HeP 10/02/00 Fix the badly specified use of FREE: and RAW.CLOSE: that \ involved recursive(?) calling from one to the other! \ MOD: HeP 10/16/00 Add RAW.ALERT: method that sends the element.on: to the \ recipient object. This _can_ be called from the user \ specified alert function. \ MOD: HeP 10/18/00 No longer reports an (anoying) error in ELEMENT.OFF: if \ an off function is not assigned. \ Add RAW.ON: method that should ease subclassing, but does \ complicate th design. \ MOD: HeP 10/31/00 Temporary fix for delta mode operation. \ MOD: HeP 11/01/00 Implement RAW.OFF: and OFF: although these are not \ automatically called by the ELEMENT.OFF: method. \ MOD: HeP 11/09/00 Add GET.ALERT.FUNCTION: method. \ MOD: HeP 11/11/00 Check if opened in the ELEMENT.ON: and ELEMENT.OFF: \ methods, but not in ON: and OFF: methods. \ \ ToDo: Clean up this code! Esp. the function of these instance variables \ (i.e. iv-blyzr-many, iv-blyzr-cells, etc). include? task-device myt:device anew task-banalyzer 8 value banalyzer_max_cells method ON: method OFF: method RAW.ON: method RAW.OFF: method ALERT: method RAW.ALERT: method PUT.ALERT.OBJ: method PUT.ALERT.FUNCTION: method GET.ALERT.FUNCTION: method PUT.DIM: method RESET.TOLERANCE: method PUT.TOLERANCE: method GET.TOLERANCE: method RESET.MASKS: method PUT.LOW.MASK: method PUT.HIGH.MASK: method DELTA.ON: method DELTA.OFF: method ABS.ON: method ABS.OFF: method GET.AVERAGE: method GET.DEVIATION: :class OB.BANALYZER iv-blyzr-many ;m :m RESET: ( -- ) self REFRESH: [] \ 0 iv=> iv-blyzr-current 0 iv=> iv-blyzr-many 0 iv=> iv-blyzr-average 0 iv=> iv-blyzr-deviation ;m :m RESET.MASKS: ( -- , reset low and high masks ) false iv=> iv-blyzr-mask-set? \ $ 7FFFFFFF iv=> iv-blyzr-mask-hi \ very big number $ 80000000 iv=> iv-blyzr-mask-lo \ very small number ;m :m RESET.TOLERANCE: ( -- ) $ 7FFFFFFF iv=> iv-blyzr-tolerance \ pretty large number ;m :m DEFAULT: ( -- ) reset: self reset.masks: self reset.tolerance: self \ false iv=> iv-blyzr-delta false iv=> iv-blyzr-abs \ true iv=> iv-blyzr-use-on? false iv=> iv-blyzr-use-off? ;m :m INIT: ( -- ) init: super \ init: iv-blyzr-data-array \ 0 iv=> iv-blyzr-alert-cfa 0 iv=> iv-blyzr-alert-obj ;m \ internal memory :m NEW: ( n -- ) dup banalyzer_max_cells > IF " new:" " allocating a large number of cells may slow down this object" er_warning ob.report.error THEN dup new: iv-blyzr-data-array iv=> iv-blyzr-cells \ reset: self ;m :m SET.MANY: ( n -- ) iv=> iv-blyzr-many ;m :m MANY: ( -- n ) iv-blyzr-many ;m \ open and close :m RAW.OPEN: ( -- ) iv-blyzr-many IF iv-blyzr-many new: self ELSE banalyzer_max_cells new: self THEN ;m :m RAW.CLOSE: ( -- ) free: iv-blyzr-data-array ;m \ input settings :m PUT.DIM: ( dim# -- , dimension to be analyzed ) dup 0>= IF iv=> iv-blyzr-dim# ELSE drop " put.dim:" " dimension number cannot be a negative value" er_warning ob.report.error THEN ;m :m PUT.HIGH.MASK: ( n -- ) iv=> iv-blyzr-mask-hi ;m :m PUT.LOW.MASK: ( n -- ) iv=> iv-blyzr-mask-lo ;m :m DELTA.ON: ( -- , use difference of consecutive values ) true iv=> iv-blyzr-delta ;m :m DELTA.OFF: ( -- , use straight input values ) false iv=> iv-blyzr-delta ;m :m ABS.ON: ( -- , ignore polarity of input ) true iv=> iv-blyzr-abs ;m :m ABS.OFF: ( -- , keep input polarity intact ) false iv=> iv-blyzr-abs ;m \ alert :m PUT.TOLERANCE: ( n -- , point at which an ALERT: method is called ) iv=> iv-blyzr-tolerance ;m :m GET.TOLERANCE: ( -- n ) iv-blyzr-tolerance ;m :m PUT.ALERT.OBJ: ( addr -- , object to which the ELEMENT.ON: is sent ) iv=> iv-blyzr-alert-obj ;m :m PUT.ALERT.FUNCTION: ( cfa -- , word executed when ALERT: is called ) iv=> iv-blyzr-alert-cfa ;m :m GET.ALERT.FUNCTION: ( -- cfa ) iv-blyzr-alert-cfa ;m :m RAW.ALERT: ( -- , send element.on: to recipient object ) iv-blyzr-alert-obj IF iv-blyzr-elm# iv-blyzr-shape \ -- elm# shape iv-blyzr-alert-obj element.on: [] THEN ;m :m ALERT: ( -- , execute user cfa or call raw.alert: ) iv-blyzr-alert-cfa IF iv-blyzr-deviation self \ -- data addr iv-blyzr-alert-cfa -2 exec.stack? ELSE self raw.alert: [] THEN ;m \ analysis : BLYZR.CALC.AVERAGE ( -- n , calculate and return average ) 0 iv-blyzr-many 0 DO i at: iv-blyzr-data-array + LOOP iv-blyzr-many / ; : BLYZR.INCR.POINTER ( -- , incr pointer to current cell if necessary ) iv-blyzr-current 1+ iv-blyzr-cells mod iv=> iv-blyzr-current \ increment pointer \ iv-blyzr-cells iv-blyzr-many > IF 1 iv+> iv-blyzr-many THEN ; : BLYZR.ADD.ELEMENT ( n -- , add value to circular memory ) iv-blyzr-current to: iv-blyzr-data-array ; : BLYZR.PROCESS.INPUT ( n -- n flag , process raw input data ) iv-blyzr-mask-set? IF iv-blyzr-mask-lo iv-blyzr-mask-hi clipto \ apply the masks THEN \ iv-blyzr-delta \ "delta" mode? IF dup iv-blyzr-prev-value - \ -- n Æn swap iv=> iv-blyzr-prev-value \ -- Æn , store for next time true \ -- Æn flag \ \ *** This following does not work because iv-blyzr-many is not *** \ *** incremented if no more processing occurs! We need to clearup *** \ *** the function of these instance variables (i.e. iv-blyzr-many, *** \ *** iv-blyzr-cells, etc). *** \ \ iv-blyzr-many \ IF \ dup iv-blyzr-prev-value - \ -- n Æn \ swap iv=> iv-blyzr-prev-value \ -- Æn , store for next time \ true \ -- Æn flag \ ELSE \ dup iv=> iv-blyzr-prev-value \ -- n , store for next time \ false \ -- n flag , no more processing \ THEN \ ELSE true \ continue with processing data THEN \ IF iv-blyzr-abs \ "absolute" mode? IF abs THEN true \ -- n flag ELSE false \ -- n flag THEN ; :m RAW.ON: ( n -- ) dup blyzr.add.element \ blyzr.calc.average dup iv=> iv-blyzr-average - iv=> iv-blyzr-deviation \ iv-blyzr-deviation ABS iv-blyzr-tolerance > IF self ALERT: [] \ late bound! THEN \ blyzr.incr.pointer ;m :m RAW.OFF: ( n -- ) raw.on: self ;m :m ON: ( n -- , add values to buffer ) blyzr.process.input \ -- n flag IF self RAW.ON: [] ELSE drop THEN ;m :m OFF: ( n -- , this isn't automatically called by ELEMENT.OFF: ) blyzr.process.input \ -- n flag IF self RAW.OFF: [] ELSE drop THEN ;m \ element on and off :m ELEMENT.ON: ( elm# sh -- ) iv-dev-#opened IF 2dup iv=> iv-blyzr-shape iv=> iv-blyzr-elm# \ iv-dev-on-cfa IF self iv-dev-on-cfa -3 exec.stack? ELSE iv-blyzr-dim# swap ed.at: [] ON: self \ run analysis THEN ELSE 2drop THEN ;m :m ELEMENT.OFF: ( elm# sh -- ) iv-dev-#opened IF 2dup iv=> iv-blyzr-shape iv=> iv-blyzr-elm# \ iv-dev-off-cfa IF self iv-dev-off-cfa -3 exec.stack? ELSE 2drop \ default behavior does nothing THEN ELSE 2drop THEN ;m \ stats :m GET: ( -- n , aquire most recent value ) iv-blyzr-current at: iv-blyzr-data-array ;m :m GET.AVERAGE: ( -- ave , returns average value ) iv-blyzr-average ;m :m GET.DEVIATION: ( -- dev , deviation from average ) iv-blyzr-deviation ;m \ print :m PRINT: ( -- ) print: super \ iv-dev-#opened IF many: iv-blyzr-data-array 0 DO ." cell#" i 3 .r i at: iv-blyzr-data-array 8 .r cr LOOP THEN \ ." Input data:" cr space ." Dimension# = " iv-blyzr-dim# 8 .r cr iv-blyzr-mask-set? IF space ." Low mask = " iv-blyzr-mask-lo 8 .r cr space ." Hi mask = " iv-blyzr-mask-hi 8 .r cr ELSE space ." Data masks disabled!" cr THEN space ." DELTA mode = " iv-blyzr-delta IF ." ON" ELSE ." OFF" THEN cr space ." ABSolute mode = " iv-blyzr-abs IF ." ON" ELSE ." OFF" THEN cr ." ALERT message:" cr space ." Tolerance = " iv-blyzr-tolerance 8 .r cr space ." Recipient = " iv-blyzr-alert-obj ob.name cr space ." ALERT function = " iv-blyzr-alert-cfa cfa. cr ." Stats: " cr space ." Average = " iv-blyzr-average 8 .r cr space ." Deviation = " iv-blyzr-deviation 8 .r cr ;m ;class \ test false .IF ob.banalyzer test-blyzer : BRT.ON.VECTOR ( note# vel -- ) ; : BRT.ALERT.FUNC ( data addr -- ) cr tab ." *** ALERT! from: " ob.name ." data = " . ." ***" cr cr ; : BRT.INIT ( -- ) mp.reset \ 'c brt.alert.func put.alert.function: test-blyzer 32 put.tolerance: test-blyzer open: test-blyzer \ print: test-blyzer ; : BRT.TERM ( -- ) close: test-blyzer ; if.forgotten brt.term : BLYZER.TEST ( -- ) brt.init \ cr cr ." Hit any (qwerty) key to quit..." cr cr \ BEGIN key \ dup cr ." Character = " emit cr \ dup on: test-blyzer print: test-blyzer \ dup ascii q = swap ascii Q = OR UNTIL \ brt.term ; cr ." Enter BLYZER.TEST to test the banalyzer class." cr cr .THEN