REBOL [ Title: "actions-parser" Author: "Oldes, Gabriele Santilli" email: oliva.david@seznam.cz Purpose: {To compile actions in the Rebol/Flash dialect} Note: {I really have to thanks to Gabriele Santilli because without his expression-parser script I would not know how to parse the expressions at all} comment: {This is not final version, a lot of things must be done yet.} ] actions-parser: make object! [ with-depth: 0 ;used to check if we are inside the WITH block v: v2: v3: none ;help variables pop?: true i: 0 ;recursion counter res: none arg: none slash: to-lit-word first [/] dslash: to-lit-word "//" rShift: to-lit-word ">>" UrShift: to-lit-word ">>>" _bigger: to-lit-word ">" _less: to-lit-word "<" _noteql: to-lit-word "<>" _lesseql: to-lit-word "<=" _biggeql: to-lit-word ">=" lShift: ['left 'shift] ;to-lit-word "<<" localVar?: false arrays: make block! 20 recursion-buffer: make block! 20 ;used to store variables during recursion classes: make block! 6 ;used to store class constructors which needs to be processed during showFrame function path-prefix: make string! 10 ;in class compilation I need to closed all path values into context of the class store-actions: func[][ if not empty? action-push-buff [ form-push/compact/nobuff action-push-buff ] insert action-bin-buff copy action-bin clear action-bin ] ;get-method-args: func[obj member /local m-cont][ ; m-cont: select defined-objects obj ; select either none? m-cont [defined-methods][m-cont] member ;] get-local-const: func[prim-val /local tmp][ tmp: select local-constants prim-val prim-val: compose either none? tmp [ tmp: to word! prim-val [form-push (tmp) ins-act #{1C}] ][ [form-push (tmp)]] ] process-path: func[path /as-method /local p x c parts tmp buff buffe prop last-member meth][ tmp: parse/all join path-prefix path "./" buff: make block! 50 buffe: make block! 2 parts: length? tmp c: none if parse last tmp [copy x [to "++" (c: #{50}) | to "--" (c: #{51})] 2 skip end][ pop?: false change back tail tmp x prop: select swf5properties to word! x insert buffe compose either none? prop [ [ins-act (join c either parts = 1 [#{1D}][#{4F}])] ][ [ins-act (join c either parts = 1 [#{23}][#{4F}])] ] ] prop: select swf5properties last-member: to word! first tmp insert buff compose either none? prop [ [form-push (first tmp) ins-act #{1C}] ;getVar ][ [form-push "" form-push (prop) ins-act #{22}]];getProperty p: 1 foreach member next tmp [ p: p + 1 error? try [member: (to integer! member) - 1] insert tail buff compose [ form-push (either all [string? member member/1 = #":"] [ compose [(next member) ins-act #{1C}] ][member]) ins-act (either (p = parts) and as-method [#{52}][#{4E}]) ] last-member: member ] ;print ["1:" mold buff] ; probe c if not none? c [ insert tail remove/part back back (insert back back tail buff buff) 2 buffe ] ;print ["F:" mold buff] return buff ] removepop: func[{ this strange function removes the pop tag if present on the end of action-bin and is used only for evaluation support in function calls} ][ if all [not empty? action-bin (last action-bin) = 23] [remove back tail action-bin] ] set-variable: func[][ compose [ins-act (either localVar? [#{3C}][#{1D}])] ] process-set-path: func[ res /local tmp parts j prop buff last-member w sws ][ if binary? current-set-word [ insert res reduce ['ins-act current-set-word] ;insert tail res [ins-act #{1D}] return res ] w: 0 sws: length? current-set-word foreach sw current-set-word [ w: w + 1 tmp: parse/all sw "." either swf-version < 5 [ either found? f: find/reverse tail sw #"." [ sw: copy/part sw (index? f) - 1 replace/all sw "." "/" ][ sw: ""] either prop: select swf5properties to word! last tmp [ insert res compose [form-push (sw) form-push (prop)] append res [ins-act #{23}] ;setProp ][ ;insert tail sw join ":" last tmp ;why there was the join?! insert tail sw last tmp insert res compose [form-push (sw)] append res [ins-act #{1D}] ;set-var ] ][ member: to word! first tmp parts: length? tmp j: 1 either j = parts [ ;simple word ;print [w sws] prop: select swf5properties to word! last tmp if w < sws [insert tail res [ins-act #{87010000}]] ;StoreValueInRegister either none? prop [ insert res compose [form-push (to string! member)] append res set-variable ;setVar ][ either with-depth > 0 [ insert res compose [form-push (to string! member)] append res set-variable ;setVar ][ insert res compose [form-push "" form-push (prop)] append res [ins-act #{23}] ;setProp ] ] if w < sws [insert tail res [form-push #{0400}]] ][ buff: make block! 50 insert buff compose [form-push (to string! member) ins-act #{1C}] ;getVar last-member: member if w < sws [insert tail res [ins-act #{87010000}]] foreach member next tmp [ member: to word! member j: j + 1 prop: select swf5properties member either j = parts [ ;the last part insert tail buff compose [form-push (to string! member)] insert res buff insert tail res [ins-act #{4F}];setMember if w < sws [insert tail res [form-push #{0400}]] ][ insert tail buff compose either none? prop [ ;meth: get-method-args last-member member ;either none? meth [ [form-push (to string! member) ins-act #{4E}];getMember ;][ ; [form-push (to string! member) ins-act #{52}];CallMethod ;] ][ [form-push (to string! prop) ins-act #{22}] ];getProperty last-member: member ] ] ] ] ] localVar?: false return res ] process-either: func[b1 b2 /local tmp][ store-actions compile-actions b1 store-actions compile-actions b2 insert action-bin tmp: rejoin [ first action-bin-buff #{990200} int-to-ui16 length? action-bin ;jump tag ] remove action-bin-buff insert action-bin rejoin [ first action-bin-buff #{129D0200} int-to-ui16 length? tmp ] remove action-bin-buff ] process-if: func[b /jump ofs][ pop?: false store-actions compile-actions b if jump [ form-act-tag #{99} int-to-ui16 ofs ] insert action-bin rejoin [ first action-bin-buff #{129D0200} int-to-ui16 length? action-bin ] remove action-bin-buff pop?: true ] process-switch: func[value cases /default dcase /local bytes buff store-buff][ bytes: 0 buff: make binary! 1000 store-buff: func[][ bytes: bytes + length? action-bin insert buff copy action-bin clear action-bin ] store-actions cases: head reverse cases either default [ compile-actions dcase store-buff ][ pop?: false compile-actions compose [(value) = (second cases)] pop?: true process-if first cases store-buff remove/part cases 2 ] parse/all cases [ some [ set case block! copy val [to block! | to end] ( insert val compose [(value) = ] pop?: false compile-actions val pop?: true process-if/jump case bytes store-buff ) ] ] insert action-bin rejoin [ first action-bin-buff buff ] remove action-bin-buff ] process-while: func[v v2 /local i][ i: length? action-bin compile-actions v2 pop?: false compile-actions v pop?: true i: i - (length? action-bin) - 5 form-act-tag #{9D} int-to-sb16 i ] process-for: func[word start end bump body /local i][ pop?: false form-push word compile-actions start ins-act #{1D} i: length? action-bin pop?: true compile-actions body pop?: false either swf-version > 4 [ form-push reduce [word word] ins-act #{1C87010000} compile-actions bump ins-act #{471D} either (first bump) < 0 [ compile-actions end form-push #{0400} ][ form-push #{0400} compile-actions end] ins-act #{48} i: i - (length? action-bin) - 5 form-act-tag #{9D} int-to-sb16 i form-push reduce [word #{0400}] ins-act #{1D} ][ form-push reduce [word word] ins-act #{1C} compile-actions bump ins-act #{0A1D} either (first bump) < 0 [ form-push word ins-act #{1C} compile-actions end ins-act #{0F12} ][ compile-actions end form-push word ins-act #{1C0F12}] i: i - (length? action-bin) - 5 form-act-tag #{9D} int-to-sb16 i form-push reduce [word word] ins-act #{1C} compile-actions bump ins-act #{0B1D} ] pop?: true ] process-foreach: func[words data body /local i][ either swf-version > 4 [ if not block? words [words: to block! words] form-push #{04000401} ;stores register values in stack foreach word words [ form-push word ins-act #{41} ;word is local ] do process-path join to string! data ".length" ;gets length of the data array ins-act #{8701000017} ;store this value in register 1 form-push 0 ;counter ins-act #{8701000117} i: length? action-bin ;start loop cycle foreach word words [ form-push word do process-path data form-push #{0401} ins-act #{4E1D} ;sets the 'word form-push #{0401} ins-act #{50} ins-act #{8701000117} ;increment counter ] compile-actions body form-push #{0401} form-push #{0400} ins-act #{48} i: i - (length? action-bin) - 5 form-act-tag #{9D} int-to-sb16 i ;next cycle ins-act #{87010001178701000017} ;restores register values ][ make-warning! "FOREACH is available only since SWF5 version!" ] ] process-setvar: func[v][ pop?: false store-actions compile-actions v insert set-word-buff copy action-bin action-bin: first action-bin-buff remove action-bin-buff pop?: true ] process-func: func[ "Defines a function with given spec and body" spec "Block with arg words" body "The body block of the function" /local pars locals name params functag p swtype ][ parse spec [copy pars [to /local | to end] copy locals to end] if none? pars [pars: copy []] locals: copy either none? locals [[]][next locals] swtype: either none? set-word [ #{17} ;pop - function is not defined to any word ][ ;print "--" ;probe set-word name: first pop-set-word ;probe set-word either find name "." [ name: parse name "." form-push/nobuff first name ins-act #{1C} name: next name forall name [ either 1 < (length? name) [ form-push/nobuff first name ins-act #{4E} ][ form-push/nobuff first name ] ] #{4F} ;setMember - func is defined to some member ][ form-push/nobuff name either localVar? [#{3C}][#{1D}] ;local/global definition to some word ] ] store-actions foreach local locals [ form-push local ins-act #{41} ] compile-actions body params: make binary! 100 p: length? pars foreach param pars [ insert tail params join param #{00} ] insert params int-to-ui16 p functag: rejoin [ #{00} ;to binary! name #{00} params int-to-ui16 length? action-bin ] insert action-bin rejoin [ first action-bin-buff #{9B} int-to-ui16 length? functag functag ] ins-act swtype ;pop,setMember, definelocal or setVariable ;insert declared-funcs reduce [to-word name p] remove action-bin-buff ] process-with: func[v v2][ with-depth: with-depth + 1 pop?: false compile-actions v pop?: true store-actions compile-actions v2 insert action-bin rejoin [ first action-bin-buff form-act-tag/get #{94} int-to-ui16 length? action-bin ] remove action-bin-buff with-depth: with-depth - 1 ] process-tellTarget: func[v v2][ pop?: false compile-actions v pop?: true ins-act #{20} compile-actions v2 form-act-tag #{8B} #{00} ] process-args: func[v2][ pop?: false forall v2 [ switch/default type?/word v2/1 [ paren! [compile-actions to block! v2/1] word! [do process-path v2/1] ][form-push v2/1] ] pop?: true ] process-FS: func[name args "Creates FSCommand 'name with 'args"][ form-push "FSCommand:" pop?: false compile-actions name ins-act #{21} ;string ADD compile-actions args form-act-tag #{9A} #{00} pop?: true ] process-constantPool: func[ v /local addcp tmp][ if swf-version > 4 [ clear ConstantPool tmp: make string! 50 addcp: func[c /br][ c: either br [parse c "."][join copy [] c] forall c [ if not found? find ConstantPool c/1 [ append ConstantPool c/1 append tmp join #"^@" c/1 ] ] ] parse v [ some [ copy v2 [word! | path!] (addcp/br mold first v2) | copy v2 [url! | email!] (addcp mold first v2) | set v2 string! (addcp v2) | any-type! ] ] form-act-tag #{88} rejoin [int-to-ui8 length? ConstantPool tmp #"^@"] ] ] ;------------------------------------------------------------------- expr-val: expr-op: none flip?: false ;to handle correct <= and >= expression: [ term (expr-val: term-val) any [ [ '+ (expr-op: compose [ins-act (either swf-version > 4 [#{47}][#{0A}])]) | '- (expr-op: [ins-act #{0B}]) | ['add | '.] (expr-op: [ins-act #{21}]) ;ActionStringAdd | _bigger (expr-op: compose [ins-act (either swf-version > 5 [#{67}][#{0F12}])]) | _less (expr-op: either swf-version > 4 [ [ins-act #{48}]][[ins-act #{0F}]]) | ['= | '==] (expr-op: either swf-version > 4 [ [ins-act #{49}]][[ins-act #{0E}]]) ;ActionEquals | _lesseql ( flip?: true expr-op: compose [ins-act ( switch/default swf-version [ 6 [flip?: false #{6712}] 5 [#{4812}] ][#{0F12}]) ]) | _biggeql ( expr-op: compose [ins-act (either swf-version > 4 [#{4812}][#{0F12}])]) | ['!= | _noteql] (expr-op: either swf-version > 4 [ [ins-act #{4912}]][[ins-act #{0E12}]]) | '=== (expr-op: [ins-act #{66}]) ;Strict equality | '!== (expr-op: [ins-act #{6612}]) ;Strict inequality ] term ( expr-val: compose either flip? [ flip?: false [(term-val)(expr-val)(expr-op)] ][ [(expr-val)(term-val)(expr-op)]] ) ] ] term-val: term-op: none term: [ pow (term-val: power-val) any [ [ '* (term-op: [ins-act #{0C}]) | slash (term-op: [ins-act #{0D}]) ;Divide | dslash (term-op: [ins-act #{3F}]) ;Modulo | rShift (term-op: [ins-act #{64}]) ;RShift | UrShift (term-op: [ins-act #{65}]);UnsignedRShift | lShift (term-op: [ins-act #{63}]) ;lShift | '| (term-op: [ins-act #{61}]) ;bitwise OR | ['|| | 'or] (term-op: [ins-act #{11}]);OR | ['& | 'band] (term-op: [ins-act #{60}]) ;bitwise AND | 'and (term-op: [ins-act #{10}]) ;AND ] pow (term-val: compose [(term-val)(power-val)(term-op)]) ] ] power-val: none pow: [ unary (power-val: unary-val) ; opt ['^ unary (power-val: compose [power (power-val) (unary-val)])] ] unary-val: pre-uop: post-uop: none unary: [ opt [ 'random (post-uop: [ins-act #{30}] ) | ['not | '!] (post-uop: [ins-act #{12}]) | 'eval (post-uop: [ins-act #{1C}] ) | 'return (post-uop: [ins-act #{3E}]) | 'delete (post-uop: [ins-act #{3A}]) | 'typeOf (post-uop: [ins-act #{44}]) | 'to-integer (post-uop: [ins-act #{18}]) | 'to-number (post-uop: [ins-act #{4A}]) | 'to-string (post-uop: [ins-act #{4B}]) | 'to-char (post-uop: [ins-act #{33}]) | 'to-mbchar (post-uop: [ins-act #{37}]) | 'to-ord (post-uop: [ins-act #{32}]) | 'to-mbord (post-uop: [ins-act #{36}]) | 'length? (post-uop: [ins-act #{14}]) | 'mblength? (post-uop: [ins-act #{31}]) | 'TargetPath (post-uop: [ins-act #{45}]) ] primary ;opt ['! (post-uop: 'factorial)] ( unary-val: compose [ (pre-uop) (prim-val) (post-uop)] post-uop: pre-uop: [] ) ] prim-val: prim-val-args: args: prim-val-type: none ; WARNING: uses recursion for parens. primary: [ set prim-val 'GetTime (prim-val: [ins-act #{34}]) | 'GetVersion (prim-val: [form-push "/:$version" ins-act #{1C}]) | 'comment string! | 'rebol set prim-val block! ( prim-val: compose [form-push (prim-val)] ) | 'rejoin set args block! ( prim-val: make block! 2 * length? args forall args [ insert tail prim-val compose/deep [pop?: false compile-actions [( args/1)]] if 1 < index? args [ insert tail prim-val reduce ['ins-act #{21}] ] ] ) | set prim-val issue! (prim-val: compose [form-push (prim-val)]) | 'true (prim-val: [form-push true]) | 'false (prim-val: [form-push false]) | ['none | 'null] (prim-val: [form-push #{02}]) | 'undefined (prim-val: [form-push #{03}]) | 'newline (prim-val: [form-push "^/"]) | [set prim-val word! | copy prim-val path!] copy args opt paren! ( ;print ["PRIMVAL:" mold prim-val mold args] if block? prim-val [ prim-val: mold first prim-val replace/all prim-val "/" "." prim-val: to word! prim-val ] ;prim-val-args: none ;select declared-funcs prim-val either none? args [ ;print " it's a member or func" prim-val-args: 0 prim-val: process-path prim-val ][ ;print " it's a method or func" prim-val-args: 0 args: to block! first args prim-val: either found? find mold prim-val #"." [ ;it IS method process-path/as-method prim-val ][ ;it's just a FUNCTION! compose [form-push (mold prim-val) ins-act #{3D}] ] insert prim-val compose/deep either empty? args [ [form-push 0] ][ tmp: make block! 10 parse/all args [ some [ set arg lit-word! ( insert tmp get-local-const arg ) | 'false (insert tmp compose [form-push #{0500}]) | 'true (insert tmp compose [form-push #{0501}]) | set arg word! (insert tmp process-path arg) | copy arg path! (insert tmp process-path mold first arg) | copy arg paren! ( insert tmp reduce ['compile-actions (to block! first arg) 'removepop] ) | set arg any-type! (insert tmp compose [form-push (arg)]) ] ] ;print ["TMP:" mold tmp "ARGS:" mold args] [(tmp) form-push (length? args)] ] ;probe prim-val ] ) copy args prim-val-args skip ( ;it was a function if not none? args [ ;this is just a quick hack! tmp: make block! 10 parse/all args [ some [ set arg lit-word! ( insert tmp get-local-const arg ) | set arg word! ( process-path arg insert tmp compose [form-push (arg) ins-act #{1C}] ) | set arg any-type! (insert tmp compose [form-push (arg)]) ] ] prim-val: compose/deep [ (tmp) form-push/compact [(length? args) (prim-val)] ins-act #{3D} ] ] ) | set prim-val [number! | string!] ( prim-val: compose [form-push (prim-val)] ) | set prim-val lit-word! ( ;this type I use for accessing local constants ; (now for key-values => for examle: 'down = 40) prim-val: get-local-const prim-val ) | set prim-val paren! (prim-val: translate to block! :prim-val) ] ;remove set-word-buff translate: func [expr [block!] /local res recursion] [ ; to allow recursive calling, we need to preserve our state i: i + 1 recursion: reduce [ :expr-val :expr-op :term-val :term-op :power-val :unary-val :pre-uop :post-uop :prim-val ] post-uop: pre-uop: [] ;MAIN PARSING RULES!!! parse expr [ any [ copy v some [set-word!] ( if all [swf-version < 5 1 <> length? v][ make-warning! "Setting more then one variable at once is available sice Flash 5!" ] forall v [change v to string! to word! v/1] insert/only set-word-buff head v ) | 'var (localVar?: true) | 'GotoFrame set v integer! ( ins-act join #{810200} int-to-ui16 v ) | 'GetURL set v string! set v2 string! (form-act-tag #{83} rejoin [#{} v #"^@" v2 #"^@"]) | 'NextFrame (ins-act #{04}) | 'PreviousFrame (ins-act #{05}) | 'Play (ins-act #{06}) | 'Stop (ins-act #{07}) | 'ToggleQuality (ins-act #{08}) | 'StopSounds (ins-act #{09}) | 'WaitForFrame set v integer! set v2 integer! ( ins-act rejoin [ #{8A0300} int-to-ui16 v ;frame to wait for int-to-ui8 v2 ;Number of actions to skip if frame is not loaded ] ) | 'SetTarget set v [string! | refinement! | path! ] ( form-act-tag #{8B} either string? v [v][mold v] ) | 'tellTarget copy v to block! set v2 block! (process-tellTarget v v2) | 'GoToLabel set v string! (form-act-tag #{8C} v) ;here is the end of the SWF3 action spec... the rest is for SWF4 | 'FSCommand set v block! ( use [fc][ fc: func[a b][form-act-tag #{83} rejoin [#{} "FSCommand:" a #"^@" b #"^@"]] parse v [ any [ 'exec set v2 string! (fc 'exec v2) | 'showmenu set v2 ['true | 'false] (fc 'showmenu v2) | 'fullscreen set v2 ['true | 'false] (fc 'fullscreen v2) | 'allowScale set v2 ['true | 'false] (fc 'allowScale v2) | 'quit (fc 'quit "") | set v2 string! set v3 string! (fc v2 v3) | copy v2 any-type! copy v3 any-type! ( ;probe reduce[mold v2 mold v3] process-FS v2 v3) | any-type! ] to end ] ] ) | ['GotoFrame2 | 'goto opt ['frame] ] set v [integer! | word!] ( if word? v [v: select names-ids-table v] if not none? v [ form-act-tag #{96} rejoin [#{00} v #{00}] ] ) opt ['and] set v any 'play ( ;Go to frame, stack-based. form-act-tag #{9F} either none? v [#{00}][#{01}] ) | 'LoadMovie set v [string! | url! | file! | word!] opt ['to | 'into] set v2 [string! | word! | path!] (v3: 'none) opt [opt ['method] set v3 ['post | 'get]] ( either word? v [do process-path v][ form-push v ] either word? v2 [do process-path v2][ form-push v2 ] form-act-tag #{9A} select [none #{40} post #{82} get #{81}] v3 ) | 'LoadVariables set v [string! | url! | file! | word!] opt ['to | 'into] set v2 [string! | word! | path!] (v3: 'none) opt [opt ['method] set v3 ['post | 'get]] ( either word? v [do process-path v][ form-push v ] either word? v2 [do process-path v2][ form-push v2 ] form-act-tag #{9A} select [none #{C0} post #{C2} get #{C1}] v3 ) | 'GetProperty set v any [string!] set v2 some [word! | lit-word!] ( ;v = target, v2 = prop.name use [tmp][ if not none? tmp: select [ currentframe 4 ] v2 [ form-push reduce [ either none? v [""][v] tmp ] ins-act #{22} ] ] ) | 'SetProperties set v [string! | word!] set v2 block! ( use [tmp name][ name: copy form v foreach [prop value] v2 [ if not none? tmp: select [ rotate #{0100002041} x #{0100000000} y #{010000803F} scaleX #{0100000040} scaleY #{0100004040} Alpha #{010000C040} Visibility #{010000E040} Name #{0100005041} ;HighQuality #{0100008041} ] prop [ form-push name form-act-tag #{96} tmp ;form-push value compile-actions to block! value removepop ins-act #{23} ] ] ] ) | 'StartDrag set v any [string! | integer! | file!] set v2 any [block! | word! | lit-word!] ( if none? v [v: make string! ""] v2: to block! v2 use [a b][ form-push reduce [ either parse v2 [thru 'rect set a pair! set b pair! to end][ form-push reduce [a/x a/y b/x b/y] 1 ][0] ;Constrain to rectangle either found? find v2 'lockcenter [1][0] ;lockcenter to string! v ;target ] ] ins-act #{27} ) | 'StopDrag (ins-act #{28}) | 'Push set v [ string! (ins-act rejoin [#{9600} v #{00}]) | number! (ins-act rejoin [#{9601 } v #{00}]) ] | 'if copy v to block! set v2 block! (v3: none) opt ['else copy v3 thru block!] ( pop?: false compile-actions v pop?: true either none? v3 [ process-if v2 ][ process-either v2 v3] ) | 'either copy v to block! set v2 block! set v3 block! ( pop?: false compile-actions v pop?: true process-either v2 v3 ) | 'switch copy v to block! set v2 block! ( process-switch v v2 ) | 'switch/default copy v to block! set v2 block! set v3 block! ( process-switch/default v v2 v3 ) | 'while set v block! set v2 block! (process-while v v2) | 'loop set v number! set v2 block! ( loop v [ compile-actions v2 ] ) | 'for set v word! copy v2 [number! | word! | paren!] copy v3 [number! | word! | paren!] copy v4 [number! | word! | paren!] set v5 block! (process-for v v2 v3 v4 v5) | 'foreach set v [word! | block!] set v2 [word! | path!] set v3 block! ( process-foreach v v2 v3 ) ;and some functions for SWF5... | 'ConstantPool set v block! ( process-constantPool v ) | 'with copy v to block! set v2 block! (process-with v v2) | 'func set v block! set v2 block! (process-func v v2) | set v block! ( make-object 'Array head reverse v ) | ['make | 'new] [ 'date! set v [block! | date!] ( buff: make binary! 50 args: make block! 3 either date? v [ if not none? t: v/time [ insert args reduce [ t/hour - 1 t/minute - 1 t/second - 1 ] ] insert tail args reduce [v/year v/month - 1 v/day] ][ args: head reverse v ] ;probe args make-object 'date args ) | 'block! set v block! ( if not none? set-word [ make-object 'Array head reverse v ] ) | 'object! set v block! ( if not none? set-word [ make-object/define none v ] ) | set v word! (v2: none) opt [set v2 block! | copy v2 [paren! | word! | string!] | none] ( use [tmp][ if none? v2 [v2: []] tmp: none? set-word make-object v head reverse v2 if tmp [ins-act #{17}] ] ) ] | 'set [ set v block! opt '= (process-setvar v) | 'color set v word! opt ['to] set v2 tuple! ( form-act-tag #{96} rejoin [ #{07} head reverse to binary! v2 #{00070100000000} v #{00} ] ins-act #{1C} form-act-tag #{96} #{0073657452474200} ins-act #{5217} ) ] | 'poke copy v [word! | paren!] copy v2 any-type! copy v3 any-type! ( pop?: false compile-actions v compile-actions v2 compile-actions v3 pop?: true ins-act #{4F} ;setMember ) | 'Mouse [ 'hide (ins-act #{961000060000000000000000004D6F757365001C9606000068696465005217}) | 'show (ins-act #{961000060000000000000000004D6F757365001C9606000073686F77005217}) ] | 'class copy v [word!] set v2 block! ( print "class is not implemented yet!" print [form v mold v2] insert tail classes reduce [to-string v v2] ) | expression ( ;print ["expr:" i] i: i - 1 res: expr-val set [ expr-val expr-op term-val term-op power-val unary-val pre-uop post-uop prim-val ] recursion if i <= 0 [ either not none? set-word [ either binary? set-word [ insert tail action-bin set-word remove set-word-buff insert tail res set-variable ][ process-set-path res remove set-word-buff ] do res i: i + 1 ][ ;probe res either all [pop? #{3E} <> last res][ insert tail res [ins-act #{17}] do res i: i + 1 ][ do res pop?: true] ] ] ) | val: any-type! (make-warning! val) ] ;end any ];end parse res ] set 'compile-actions func [expr [block!] /no-push-end /local ] [ ;print ["compile:" mold expr self/i] insert/only recursion-buffer reduce [localVar? self/i self/pop? copy set-word-buff] localVar?: false self/i: 0 clear set-word-buff ;reset variables expr: self/translate expr set [localVar? i pop? set-word-buff] first recursion-buffer ;restore variables remove recursion-buffer ;print ["action-push-buff:" mold action-push-buff self/i] if all [ not empty? action-push-buff not no-push-end ] [ ;print "Konec?" form-push/compact/nobuff action-push-buff clear action-push-buff ] ] ]