REBOL [ Title: "Eat" Date: 6-Jul-2002 Version: 1.0.3 File: %eat.r Author: {Italian Connection (Gabriele Santilli - Romano Paolo Tenca)} Purpose: "Experimental Event filtering --- speeds up view!" History: [ 1.0.3 6-Jul-2002 "added some tests" 1.0.2 6-Jul-2002 "added eat-deleted" 1.0.1 5-Jul-2002 "clear bug corrected" ] Email: %rotenca--libero--it library: [ level: 'advanced platform: none type: 'module domain: 'VID tested-under: none support: none license: none see-also: none ] ] context [ ;the words of this context are the event/type to compress no-queue: context [] wake-event: func [event /local no-btn] bind [ either not pop-face [ do event empty? screen-face/pane ][ either any [ pop-face = event/face within? event/offset win-offset? pop-face pop-face/size ][ no-btn: false if block? get in pop-face 'pane [ no-btn: foreach item pop-face/pane [ if get in item 'action [ break/return false ] true ] ] if any [ all [event/type = 'up no-btn] event/type = 'close ][ hide-popup ] do event ][ if pop-face/action [ if not find [move time] event/type [ hide-popup ] do event ] ] none? find pop-list pop-face ] ] in system/view 'self awake: func [port no-queue /local event events lasttype] [ events: copy [] while [event: pick port 1] [ either all [ in no-queue event/type lasttype = event/type ][ change back tail events event ][ lasttype: event/type insert tail events event ] ] foreach event events [ if wake-event event [return true] ] false ] system/ports/wait-list/1/awake: func [port][ awake port no-queue ] to-ob: func [blk [block!]][ blk: copy blk forall blk [change blk to-set-word first blk] context insert blk none ] default: [move key offset scroll-line scroll-page] free: true set 'eat func [ /forever for [block!] /only blk [block!] ][ either forever [ no-queue: to-ob for ][ if not only [ blk: default ] if all [free not empty? blk][ free: false awake system/view/event-port to-ob blk free: true ] ] ] free-delete: true set 'eat-delete func [ /forever for [block!] /only blk [block!] /local tmp ][ if free-delete [ free-delete: false if not only [ blk: default ] until [ tmp: pick system/view/event-port 1 any [ not tmp not find blk tmp/type ] ] if tmp [wake-event tmp] free-delete: true ] ] ] print { Example: to compress all the events of type 'offset and 'move: eat/forever [offset move] to remove all events compression: eat/forever [] to compress only once (at the end of a VID action for example) the events of type [move key offset scroll-line scroll-page]: eat to compress only once the events of type 'move 'scroll-line 'scroll-page: eat/only [move scroll-line scroll-page] to delete incoming events (at the end of a VID action for example) of type [move key offset scroll-line scroll-page]: eat-delete to delete incoming events of type 'move 'scroll-line 'scroll-page: eat-delete/only [move scroll-line scroll-page] } e: ne: ed: 1 delay: 500000 lyb: [ area 200x50 wrap "Try to move the slider up and down keeping the left button pressed and see the difference" button no-wrap "Test Inform" [inform ly2] button no-wrap "Test Alert" [alert "OK OK"] toggle "forever off" "forever on" effects [[][colorize 255.0.0]] [either value [eat/forever [move offset]][eat/forever []]] guide text white "Standard" slider [print ["standard n." ne] ne: ne + 1 loop delay []] return pad 25x0 return text white "Eated" slider [print ["eated n." e] e: e + 1 loop delay [] eat/only [move]] return pad 25x0 return text white "Eated-deleted" slider [print ["eated-deleted n." ed] ed: ed + 1 loop delay [] eat-delete/only [move]] ] ly2: layout copy/deep lyb view layout lyb halt